sw/os8/v3d/sources/system/dectapes/dectape1/LOADER.PA

   1 /OS8 FORTRAN II RELOCATING LOADER V4
   2 /
   3 /
   4 /
   5 /
   6 /
   7 /
   8 /
   9 //
  10 /
  11 /
  12 /
  13 /
  14 /COPYRIGHT (C) 1973, 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/LOADER.07     DECEMBER 5, 1973
  41 /
  42 /
  43 /CHANGES MADE FOR V4    J.K.    1975
  44 /
  45 / .VERSION NUMBER PRINTED ON MAP
  46 / .BIT ZERO OF 17645 IS USED INSTEAD OF THE WHOLE
  47 /       WORD TO INDICATE THAT THE LOADER WAS CHAINED
  48 /       TO FROM SABR
  49 / .CORE ROUTINE STANDARIZED
  50 / .CHECK FOR BATCH CORRECTED
  51 /
  52 /
  53 /FIELD 0, PAGE 0
  54
  55         VERSION=6400    /PRINTS ON MAP
  56         PATCH=01
  57         JSTFLD= 7744
  58         JSTADR= 7745
  59         JSBITS= 7746
  60         MOFILE= 7600
  61         MIFILE= 7617
  62         MPARAM= 7643
  63         DCB=    7760
  64         MSTCDF= 7772
  65         MSTADR= 7775
  66         SHNDLR= 7607
  67         MGET=   7667
  68         MTEMP=  27
  69         OLDT9=  7       /LOCATION OF HANDLER ENTRY OF DEVICE
  70                         /WITH DIRECTORY IN CORE
  71
  72         *0
  73 ZERO,   JMS I XSHNDLR
  74 ONE,    2010
  75         3600
  76         MTEMP+11
  77         HLT
  78 FIVE,   JMP I .+1
  79         7600
  80 XSHNDLR,SHNDLR
  81 X1,     0
  82 X2,     0
  83 X3,     0
  84 X4,     0
  85
  86         *16
  87         NOPUNC
  88         *100
  89         ENPUNC
  90
  91 DFRSTR, CIF 10
  92         JMS I DF200
  93         11              /KICK OUT MONITOR
  94 DFSAVE, 0               /RESTORE CALLING FIELD
  95         JMP I CDZSKP    /AND EXIT
  96
  97 SAVEDF, 0               /COMMON SAVE-FIELD PROCESSOR FOR FORTRAN I/O
  98         DCA CDZSKP      /CALLING ADDRESS
  99         RDF
 100         TAD .+2
 101         DCA DFSAVE      /CALLING FIELD
 102         CDF CIF 0
 103         JMP I SAVEDF
 104 DF200,  200
 105 \f/RUN-TIME SYSTEM PAGE 0 - PROPAGATED TROUGH ALL FIELDS
 106
 107 *33
 108         BNK=00
 109 /
 110 /       COMMON SUBROUTINE CALL LINKAGE ROUTINE
 111 /
 112 LINK,   0
 113 K6201,  CDF     BNK          /SET DATA FIELD TO THIS BANK
 114 K6202,  CIF     00           /SET INSTRUCTION FIELD TO ZERO
 115         JMP I   MLINKP       /EXIT TO MASTER LINKAGE ROUTINE
 116 MLINKP, MLINK
 117 /
 118 /       COMMON SUBROUTINE RETURN LINKAGE ROUTINE
 119 /
 120 RTN,    0
 121         CDF     BNK          /SET DATA FIELD TO THIS BANK
 122         CIF     00           /SET INSTRUCTION FIELD TO ZERO
 123         JMP I   MRTNP        /EXIT TO MASTER RETURN ROUTINE
 124 MRTNP,  MRTN
 125 /
 126 /       CHANGE DATA FIELD TO CURRENT AND SKIP
 127 /
 128 CDFSKP, 0
 129         ISZ     CDFSKP       /INDEX ADDRESS FOR SKIPPING
 130         CDF     BNK          /CHANGE DATA FIELD TO CURRENT BANK
 131         JMP I   CDFSKP       /EXIT
 132 /
 133 /       CHANGE DATA FIELD TO ZERO AND SKIP
 134 /
 135 CDZSKP, 0
 136         ISZ     CDZSKP       /INDEX RETURN ADDRESS FOR SKIPPING
 137         CDF     10           /CHANGE DATA FIELD TO ZERO
 138         JMP I   CDZSKP       /EXIT
 139 /
 140 /       OFF BANK INDIRECT SUBROUTINE
 141 /
 142 OBISUB, 0
 143         CDF     BNK          /SET DATA FIELD TO THIS BANK
 144         CIF     00           /SET INSTRUCTION FIELD TO ZERO
 145         JMP I   MOBIP        /EXIT TO MASTER OFF BANK INDIRECT SUBROUTINE
 146 MOBIP,  MOBI
 147 /
 148 /       OFF PAGE INDIRECT SUBROUTINE
 149 /
 150 OPISUB, 0
 151         CDF     BNK          /SET DATA FIELD TO THIS BANK
 152         CIF     00           /SET INSTRUCTION FIELD TO BANK 0
 153         JMP I   MOPIP        /EXIT TO MASTER OFF PAGE INDIRECT SUBROUTINE
 154 MOPIP,  MOPI
 155 \f/
 156 /       ROUTINE TO HANDLE DUMMY ARGUMENTS
 157 /
 158 DUMSUB, 0
 159         CDF     BNK          /SET DATA FIELD TO THIS BANK
 160         CIF     00           /SET INSTRUCTION FIELD TO BANK 0
 161         JMP I   MDUMP        /EXIT TO MASTER DUMMY ARGUMENT ROUTINE
 162 MDUMP,  MDUM
 163
 164 /       PAGE 0 CELLS FOR FORTRAN EXECUTION TIME I/O
 165 /       CELLS SET UP BY LINKING LOADER - CANNOT GO PAST 77
 166
 167 INHNDL, 0       /PAGE FOR INPUT HANDLER IF /I SWITCH WAS ON
 168 OUHNDL, 0       /PAGE FOR OUTPUT HANDLER IF /O SWITCH WAS ON
 169 ELENGT, 0       /"DESIRED LENGTH" FOR FORTRAN OUTPUT FILES - USUALLY 0
 170
 171         *DF200+1
 172 /OTHER PAGE 0 LOCATIONS
 173
 174 FOPOLD, 0
 175 FINPTR, 0
 176 FICHCT, 0       /MUST BE INIT. TO -1 AT LOOKUP
 177 FINTMP, 0       /MUST BE INIT. TO 10 AT LOOKUP
 178 OHNDLR, 0       /SET BY FENTER - CLEARED BY FCLOSE
 179 IHNDLR, 0       /SET BY FLUKUP - NEVER CLEARED
 180 FOUPTR, 0
 181 FOCHCT, 0
 182 \f       *200
 183 LSTART, JMP I   (LDRZZ1
 184 SSTART, CDF 10
 185         TAD I   (MPARAM+2
 186         SMA CLA
 187         JMP NOTSBR
 188         TAD I   (MPARAM+2
 189         AND     (3777
 190         DCA I   (MPARAM+2
 191         TAD I (MOFILE
 192         SNA CLA
 193         JMP LDRYYY
 194         TAD (MOFILE+11
 195         DCA X1
 196         TAD (MOFILE
 197         DCA SEVEN
 198         TAD (-5
 199         DCA SIX
 200         TAD (TEMP-1
 201         DCA X2
 202 MOVLP1, TAD I SEVEN
 203         CDF 0
 204         DCA I X2
 205         CDF 10
 206         TAD I X1
 207         DCA I SEVEN
 208         ISZ SEVEN
 209         ISZ SIX
 210         JMP MOVLP1
 211         TAD TEMP+1      /GET BLOCK NUMBER WHICH SABR PLACED HERE
 212         DCA I (MIFILE+1
 213         DCA I (MIFILE+2
 214         CLA CLL CMA RAL
 215         AND I (MPARAM
 216         DCA I (MPARAM   /REMOVE /L SWITCH FROM SABR INPUT
 217         CDF 0
 218         CIF 10
 219         CLA IAC
 220         JMS I (200
 221         4               /DELETE
 222         FORTRL          /THE FILE "FORTRL.TM" IF IT EXISTS
 223         0
 224         NOP             /IT DIDN'T EXIST - BIG DEAL
 225         TAD TEMP
 226 LDRYYY, CDF  10
 227         DCA I (MIFILE
 228 NOTSBR, CIF 10
 229         CDF 0
 230         JMS I (200
 231         12              /GET DEVICE NUMBER WITHOUT HANDLER
 232         2424            /TT
 233 TTYNUM, 3100            /Y
 234         1000            /RANDOM NUMBER
 235         JMP LWOWIE      /WHAT - NO TELETYPE???
 236         CIF 10
 237         CLA IAC         /DEVICE "SYS"
 238         JMS I (200
 239         2
 240 PTSLIB, SYSLIB
 241         0               /USELESS LENGTH WORD
 242         CLA SKP
 243         TAD PTSLIB
 244         CDF 10
 245         DCA I (PSYSLB
 246         TAD TTYNUM
 247         DCA I (TTYNO    /STORE AWAY TTY DEVICE NUMBER
 248         JMS I (BATCK
 249 CORO,   TAD     CORSIZ  /GET FLD OF TEST
 250         RTL
 251         RAL
 252         AND     COR70
 253         TAD     COREX   /MASK USEFUL BITS
 254         DCA     .+1
 255 COR1,   CDF
 256         TAD I   CORLOC  /SAVE CURRENT CONTENTS
 257 COR2,   NOP
 258         DCA     COR1
 259         TAD     COR2
 260         DCA I   CORLOC
 261 COR70,  70
 262         TAD I   CORLOC  /TRY TO READ BACK
 263 CORX,   7400
 264         TAD     CORX
 265         TAD     CORV    /TAD    (1400)
 266         SZA CLA
 267         JMP     COREX   /NON-EXISTENT FLD EXIT
 268         TAD     COR1
 269         DCA I   CORLOC  /RESTORE LOC
 270         ISZ     CORSIZ
 271         JMP     CORO
 272 COREX,  CDF 0
 273         TAD     CORSIZ
 274         CIA
 275 FOUNDX, CDF CIF 10
 276         DCA I   (WROVLY /POSTPONE SPREADING FIELD ZERO RESIDENT
 277         TAD (TTYOUT     / THRU FIELDS UNTIL /I,/O AND /H ARE TESTED
 278         DCA I (TYPE
 279         JMP I .+1
 280         LDRXXX
 281 \fSIX,   0
 282 SEVEN,  0
 283
 284 LWOWIE, CDF CIF 10
 285         JMP I (SIOERR
 286 CORLOC, CORX
 287 CORV,   1400
 288 CORSIZ, 1
 289 TEMP,   0;0;0;0
 290         PAGE
 291 \f/FULL LINKAGE ROUTINES FOR RUN-TIME SYSTEM
 292
 293         *400
 294 K77A,   0077            /MUST BE FIRST LOC ON PAGE
 295 /
 296 /       MASTER OFF PAGE INDIRECT ROUTINE
 297 /
 298 MOPI,   DCA     AC      /SAVE AC
 299         TAD I   OPIP    /PICK UP ADDRESS OF PARAMETER
 300         DCA     DUMSUB
 301         TAD I   DUMSUB  /ACTUAL PARAMETER
 302         DCA     7       /TO A TEMP
 303         TAD I   7       /PICK UP FINAL DATA
 304         DCA I   K7      /TO LOCATION 7 IN FROM BANK
 305         RDF             /FROM BANK
 306 ATVX,   TAD     K6202   /MAKE A CIF FROM INSTRUCTION
 307         DCA     ATV     /SAVE IN THIS SEQUENCE
 308         JMP     ATV-1
 309 /
 310 /       MASTER OFF BANK INDIRECT ROUTINE
 311 /
 312 MOBI,   DCA     AC      /SAVE AC
 313         TAD I   OBIP    /ADDRESS OF PARAMETER
 314         DCA     DUMSUB
 315         TAD I   DUMSUB  /ACTUAL COMMON ADDRESS
 316         DCA     7       /SAVE IT
 317         RDF             /FROM BANK
 318         TAD     K6201   /MAKE A CDF FROM INSTRUCTION
 319         DCA     .+3     /PLACE IN THIS SEQUANCE
 320         CDF     10      /CHANGE DATA FIELD TO COMMON
 321         TAD I   7       /ACTUAL DATA
 322         NOP             /BECOMES CDF AND CIF FROM INSTRUCTION
 323         DCA I   K7      /TO LOCATION 7 IN FROM BANK
 324         RDF
 325         CDF 10
 326         JMP     ATVX
 327 \f/      MASTER INDIRECT DUMMY ARGUMENT SUBROUTINE
 328
 329 MDUM,   DCA     AC      /SAVE AC
 330         TAD I   DUMP    /PICK UP ADDRESS OF PAR
 331         DCA     DUMSUB
 332         TAD I   DUMSUB  /PICK UP POINTER TO 2 WORD VECTOR
 333         DCA     DUMTEM  /TO A TEMPORARY
 334         TAD I   DUMTEM  /FIELD DATA IS IN AS A CDF
 335         DCA     ABCRT   /TO THIS SEQUANCE
 336         RDF             /FROM FIELD
 337         TAD     K6202   /MAKE A CIF INSTRUCTION
 338         DCA     ATV     /TO THIS SEQUANCE FOR EXIT
 339         ISZ     DUMTEM  /POINT TO LOCATION IN FIELD
 340         TAD I   DUMTEM  /ACTUAL LOCATION IN UNKNOWN FIELD
 341         DCA I   K7      /TO FROM FIELD LOCATION 7
 342 ABCRT,  NOP             /BECOMES CDF UNKNOWN
 343         ISZ     DUMSUB  /BUMP RETURN ADDRESS
 344 ATV,    NOP             /BECOMES CIF FROM
 345         TAD     AC      /RESTORE AC
 346         JMP I   DUMSUB  /EXIT
 347 AC=     CDZSKP
 348 DUMTEM= OBISUB
 349 OPIP,   OPISUB
 350 OBIP,   OBISUB
 351 DUMP,   DUMSUB
 352 /
 353 /       MASTER LINKAGE ROUTINE
 354 /
 355 MLINK,  DCA     AC      /SAVE AC
 356         RDF
 357         TAD     K6201   /MAKE A CDF
 358         DCA     DUMTEM
 359         TAD I   LINKP   /ADDRESS OF CODE WORD
 360         JMS     RTS1
 361         TAD     DUMTEM  /CDF FROM INSTRUCTION
 362         DCA I   DUMSUB  /TO FIRST WORD OF 2 WORD VECTOR
 363         ISZ     DUMSUB  /POINT TO DISPLACEMENT
 364         TAD     LINK    /ADDRESS OF CODE WORD
 365         IAC             /INCR. TO FIRST ARG
 366         DCA I   DUMSUB  /TO SECOND WORD OF 2 WORD VECTOR
 367         JMP     ATVX-1
 368 /
 369 /       MASTER RETURN ROUTINE
 370 /
 371 MRTN,   DCA     AC      /SAVE AC
 372         TAD I   RTNP    /ADDRESS OF CODE WORD
 373         JMS     RTS1
 374         TAD I   DUMSUB  /FIELD TO RETURN TO AS A CDF INSTRUCTION
 375         TAD     K2
 376         DCA     ATV
 377         ISZ     DUMSUB
 378         TAD I   DUMSUB
 379         DCA     DUMSUB
 380         JMP     ATV
 381 \f/DATA
 382
 383 K100A,  100
 384 K7700A, 7700
 385 LINKP,  LINK
 386 RTNP,   RTN
 387 /
 388 /SUBROUTINE 1
 389 /
 390 RTS1,   0
 391         DCA     LINK
 392         TAD I   LINK    /CODE WORD
 393 K200A,  AND     K77A    /MASK OUT NUMBER OF ARGUMENTS
 394         TAD     K200A   /+DISPLACEMENT
 395         DCA     ABCRT   /GIVES ADDRESS OF BCRT ENTRY
 396         TAD     ABCRT
 397         TAD     K100A   /+DISPLACEMENT
 398         DCA     ATV     /GIVES ADDRESS OF TV DISPLACEMENT
 399         CDF CIF 0       /(TABLES IN FIELD 0!)
 400         TAD I   ABCRT   /TO CDF INSTRUCTION
 401         DCA     RTSCDF  /TO FIRST WORD OF 2 WORD VECTOR
 402         TAD I   ATV     /TO BANK DISPLACEMENT
 403         SNA             /WAS IT LOADED?
 404         JMP     NOTIN   /NO
 405
 406         DCA     DUMSUB  /TO SECOND WORD OF 2 WORD VECTOR
 407 RTSCDF, 0
 408         JMP I   RTS1
 409
 410 NOTIN,  CIF 10
 411         JMS I K7700A
 412 K7,     7
 413         1               /USER ERROR 1 - PROGRAM NOT LOADED
 414 \fFASIGN,        0               /CALLED FROM SABR - DOES ASSIGN AND
 415         DCA     CDFSKP  /EITHER LOOKUP,ENTER OR CLOSE
 416         TAD FASIGN
 417         JMS SAVEDF
 418         CIF 10
 419         JMS I K7700A
 420         10              /CALL USR IN
 421         CIF 10
 422         JMS I K200A
 423         1               /ASSIGN HANDLER
 424 ASDEV,  0;0             /SET UP BY SABR
 425 ASPAGE, 0               /DITTO
 426         JMP ASERR       /ASSIGN FAILURE
 427 ZRONAM, DCA FLUNAM      /ZERO FILENAME FOR LOOKUP
 428         TAD ASDEV+1     /PUT DEVICE NUMBER IN AC
 429         JMP I CDFSKP    /JUMP TO APPROPRIATE ROUTINE
 430
 431         *567            /MUST CROSS PAGE BOUNDARY JUST SO
 432 FLUKUP, CIF 10
 433         JMS I K200A
 434 K2,     2               /LOOKUP FILE
 435 FLUNAM, 0               /REPLACED BY BLOCK NUMBER
 436 FLUCNT, 0               /REPLACED BY LENGTH (UNUSED)
 437 ASERR,  ISZ CDZSKP      /SKIP RETURN IF ERROR
 438         TAD ASPAGE
 439         DCA IHNDLR      /SET UP INPUT HANDLER ENTRY AND FLAG
 440         TAD FLUNAM
 441 FINRXX, DCA FINREC      /***** THIS SHOULD BE AT LOC 600! *****
 442         CLA CMA
 443         DCA FICHCT
 444         TAD FIN10
 445         DCA FINTMP
 446         JMP FRESET      /RESET I/O AND RETURN FROM FASIGN
 447         IFNZRO  FINRXX-600      <FINERR,_ERROR>
 448 \f       /GET A CHARACTER ROUTINE.
 449         /RETURNS TO .+1 IF ERROR, .+2 IF NORMAL
 450         /CHAR IN AC ON OUTPUT
 451         /DOES NOT HANDLE END-OF-FILE VERY WELL
 452
 453 FICHAR, 0
 454         TAD FICHAR
 455         JMS SAVEDF      /SAVE RETURN FIELD AND ADDRESS
 456 FNXTCH, ISZ FICHCT      /BUMP CHAR COUNT
 457         JMP FIGET
 458         JMS I IHNDLR    /IT OVERFLOWED - READ IN A NEW BUFFER
 459 FI200,  200
 460 FINBUF, 1200
 461 FINREC, 0
 462 FI7700, SMA CLA
 463         SKP             /END - OF - FILE ERROR - IGNORE
 464         JMP DFSAVE      /ERROR RETURN
 465         ISZ FINREC
 466         CLA CMA
 467         TAD FINBUF
 468         DCA FINPTR
 469         TAD FI7200
 470         DCA FICHCT      /INITIALIZE FOR NEW RECORD
 471 FIGET,  TAD FINTMP      /GET HIGH-ORDER-BIT BUFFER
 472         SPA             /IS IT FULL?
 473         JMP FITHRD      /YES - OUTPUT COMBINED HIGH-ORDER BITS
 474 FI7200, CLA
 475         ISZ FINPTR
 476         TAD I FINPTR    /GET A LOC FROM THE BUFFER
 477         AND FI7400
 478         RAL CLL
 479         TAD FINTMP      /PUT THE HIGH ORDER BITS ONTO THE HOB BUFFER
 480 FINXX,  RTL
 481         RTL
 482         DCA FINTMP
 483         TAD I FINPTR
 484         JMP DFEXIT      /RETURN WITH SKIP
 485 FITHRD, DCA I FINPTR    /FUDGE THIRD CHAR INTO BUFFER
 486         CLL CML
 487         JMP FINXX       /RESET FINTMP TO 10
 488 \f       /PUT A CHARACTER
 489         /RETURNS TO .+1 IF ERR, .+2 IF NORMAL
 490         /CALLED WITH CHAR IN AC
 491
 492 FOCHAR, 0
 493         DCA FOUTMP      /SAVE CHAR
 494         TAD FOCHAR
 495         JMS SAVEDF      /SAVE CALLING FIELD AND LOC
 496 FOLOOP, ISZ FOUJMP
 497         ISZ FOCHCT      /BUMP CHAR COUNT
 498 FOJMP,  JMP FOUJMP      /TAKE A BRANCH OF THE THREE-WAY JUMP
 499         JMS I OHNDLR
 500         4200
 501 FOUBUF, 1200
 502 FOUREC, 0
 503         JMP DFSAVE      /OUTPUT ERROR
 504         ISZ FOUREC
 505         JMS FOSETP
 506         ISZ FOCCNT      /BUMP FILE LENGTH
 507         ISZ FOOCNT      /ALSO ENTER COUNT
 508         JMP FOLOOP      /NOW GO PUT THE CHAR INTO THE NEW BUFFER
 509         JMP DFSAVE      /ENTER COUNT OVERFLOWED - ERROR RETURN
 510
 511 FOUJMP, JMP .           /THREE-WAY SWITCH
 512         JMP FOUCH1
 513         JMP FOUCH2
 514 FOUCH3, TAD FOUTMP
 515         RTL
 516         RTL
 517         DCA FOUTMP
 518         TAD FOUTMP
 519         AND FI7400
 520         TAD I FOPOLD    /PUT HIGH ORDER BITS OF CHAR3
 521         DCA I FOPOLD    /INTO HIGH ORDER BITS OF CHAR 1
 522         TAD FOUTMP
 523         RTL
 524         RTL
 525         AND FI7400
 526         TAD I FOUPTR    /PUT LOW ORDER BITS OF CHAR 3
 527         DCA I FOUPTR    /INTO HIGH ORDER BITS OF CHAR 2
 528         TAD FOJMP
 529         DCA FOUJMP
 530         ISZ FOUPTR
 531         JMP DFEXIT      /RETURN NORMALLY
 532 FOUCH2, TAD FOUPTR
 533         DCA FOPOLD      /SAVE POINTER TO CHAR 1
 534         ISZ FOUPTR
 535 FOUCH1, TAD FOUTMP
 536         DCA I FOUPTR    /STORE CHAR 1 OR 2
 537 DFEXIT, ISZ CDZSKP      /INCREMENT RETURN ADDR
 538         JMP DFSAVE      /AND GO THERE
 539 \fFOSETP,        0
 540         TAD FO7177
 541         DCA FOCHCT
 542         TAD FOUBUF
 543         DCA FOUPTR
 544         TAD FOJMP
 545         DCA FOUJMP
 546         JMP I FOSETP
 547
 548 FO7177, 7177
 549 FIN10,  10
 550
 551 FENTER, TAD ELENGT      /ELENGT=0 UNLESS SOME KLUDGE SETS IT UP
 552         CIF 10          /FENTER JUMPED TO BY FASIGN
 553         JMS I FI200
 554         3
 555 FOONAM, 0               /FILE NAME IN LOCS 0-3
 556 FOOCNT, 0
 557         ISZ CDZSKP      /FOR ENTER, ERROR RETURN IS SKIP RETURN
 558         TAD FOONAM
 559         DCA FOUREC      /INITIALIZE OUTPUT RECORD #
 560         JMS FOSETP      /SET UP CHARACTER POINTERS
 561         DCA FOONAM      /SET FOONAM FOR NEXT ENTER
 562         TAD I PASPAG
 563         JMP STOHND      /GO TO COMMON CODE WITH "FCLOSE"
 564 PASPAG, ASPAGE
 565
 566 FCLOSE, CIF 10          /JUMPED TO BY FASIGN
 567         JMS I FI200     /CALL I/O MONITOR
 568         4
 569 FOCNAM, 0               /FILE NAME IN 0-3
 570 FOCCNT, 0               /CLOSING LENGTH
 571         ISZ CDZSKP      /ERROR - BUMP RETURN
 572 STOHND, DCA OHNDLR
 573         DCA FOCCNT      /INITIALIZE CLOSING COUNT FOR NEXT FILE
 574 FRESET, CIF 10
 575         JMS I FI200
 576         13              /RESET ALL DEVICE HANDLER ENTRIES
 577         0               /BUT RETAIN ANY OPEN OUTPUT FILES
 578         JMP DFRSTR      /RETURN FROM FASIGN AFTER KICKING MONITOR OUT
 579 FOUTMP= FICHAR
 580 FI7400, 7400
 581         PAGE
 582 \f       *1000
 583 PROPGT, 0               /CALLED FROM FIELD 1 LOADER WHEN 1ST
 584         CDF 10          /CHECKING FOR I/O SWITCHES.
 585         DCA I LTOPCOR   /-# OF CORE FIELDS IN AC
 586         TAD I LTOPCOR
 587         DCA I LFCTR
 588         TAD I LTOPCOR
 589         CDF 0
 590         CMA             /GET # OF HI CORE FIELD
 591 PROPLP, DCA FC
 592         CLA CMA
 593         TAD FC
 594         SNA CLA
 595         JMP FIELD1
 596         TAD FC
 597         JMS CHGBNK
 598         JMS STOBNK
 599         CLA CMA
 600         TAD FC
 601         JMP PROPLP
 602 FIELD1, CLA IAC
 603         JMS CHGBNK
 604         JMS I LSHNDLR
 605         4100
 606         0
 607         MTEMP
 608         JMP I LLWOWIE
 609         JMS I LSHNDLR
 610         4201
 611         400
 612         MTEMP+21        /WRITE OUT RUN-TIME ROUTINES
 613         JMP I LLWOWIE
 614         JMS CHGBNK
 615         TAD L6001
 616         DCA I LJSBITS
 617         TAD L6213
 618         DCA I LJSTFLD
 619         TAD LLRSTRT
 620         DCA I LJSTADR
 621         CDF CIF 10      /PROPGT IS CALLED FROM FIELD  1 ONLY
 622         JMP I PROPGT
 623 FC,     0
 624 \fCHGBNK,        0
 625         CLL RTL
 626         RAL
 627         TAD LCDF
 628         DCA X1
 629         TAD X1
 630         DCA LINK+1
 631         TAD X1
 632         DCA RTN+1
 633         TAD X1
 634         DCA CDFSKP+2
 635         TAD X1
 636         DCA OBISUB+1
 637         TAD X1
 638         DCA OPISUB+1
 639         TAD X1
 640         DCA DUMSUB+1
 641         JMP I CHGBNK
 642
 643 STOBNK, 0
 644         TAD LLINK1
 645         DCA X2
 646         TAD X2
 647         DCA X3
 648         TAD LLINK2
 649         DCA X4
 650         TAD X1
 651         DCA STOCDF
 652 STOLUP, CDF 0
 653         TAD I X2
 654 STOCDF, HLT
 655         DCA I X3
 656         ISZ X4
 657         JMP STOLUP
 658         CDF 0
 659         JMP I STOBNK
 660 SYSLIB, TEXT    /LIB8/
 661         2214    /.RL
 662
 663 LTOPCOR,TOPCOR
 664 LSHNDLR,SHNDLR
 665 LFCTR,  FCTR
 666 LLWOWIE,LWOWIE
 667 L6001,  6001
 668 LJSBITS,JSBITS
 669 LJSTADR,JSTADR
 670 LJSTFLD,JSTFLD
 671 L6213,  6213
 672 LCDF,   CDF
 673 LLINK1, LINK-1
 674 LLINK2, LINK-MDUMP-2
 675 \fLDRZZ1,        CDF     10      /COME HERE IF NOT CHAINED TO
 676         DCA I   LMOFIL
 677         ISZ     LMOFIL
 678         ISZ     LMOCNT
 679         JMP     .-3
 680         CLA CLL CMA RAL /-2
 681         DCA I LDOPRP
 682         CDF     00
 683         JMP I   .+1
 684         LDRYYY
 685 LMOFIL, 7600
 686 LMOCNT, -47
 687 LLRSTRT,LRSTRT
 688 LDOPRP, DOPROP
 689 FORTRL, FILENAME FORTRL.TM
 690         PAGE
 691 \f       *1200           /LINKING LOADER SUBROUTINES FOR /I AND /O OPTIONS
 692 INPENB, 0
 693         ISZ INPFLG
 694         JMP INRTRN      /ALREADY HAVE A /I
 695         JMS TWOPAG      /HAS USER SPECIFIED 2-PG. HNDLRS?
 696         TAD OUPFLG
 697         SPA CLA
 698         JMP INVRGN
 699         TAD K2200
 700         DCA INHNDL
 701         TAD (FINBUF
 702         DCA I (ST1600   /MARK THE INPUT BUFFER IN PAGE 1600
 703         TAD K2377
 704         JMS SETHLA
 705 INRTRN, CDF CIF 10
 706         JMP I INPENB
 707
 708 INVRGN, TAD K1000
 709         DCA INHNDL
 710         TAD K1577
 711         JMP INRTRN-1
 712
 713 OUPENB, 0
 714         ISZ OUPFLG
 715         JMP OURTRN
 716         JMS TWOPAG      /HAS USER SPECIFIED 2 PG. HNDLRS?
 717         TAD INPFLG
 718         SPA CLA
 719         JMP OUVRGN
 720         TAD K2200
 721         DCA OUHNDL
 722         TAD (FOUBUF
 723         DCA I (ST1600   /MARK OUTPUT BUFFER IN 1600
 724         TAD K2377
 725         JMS SETHLA
 726 OURTRN, CDF CIF 10
 727         JMP I OUPENB
 728
 729 OUVRGN, TAD K1000
 730         DCA OUHNDL
 731         TAD K1577
 732         JMP OURTRN-1
 733
 734 INPFLG, -1
 735 OUPFLG, -1
 736 K1000,  1000            /SET TO 1001 FOR 2 PAGE HANDLERS
 737 K2200,  2200            /SET TO 2401 FOR 2 PAGE HANDLERS.
 738 K2377,  2377            /SET TO 2577 FOR 2 PAGE HANDLERS.
 739 K1577,  1577            /SET TO 1777 FOR 2 PAGE HANDLERS.
 740 \f/SUBROUTINE TO CHECK FOR /H SWITCH MEANING USER
 741 /WANTS RUN TIME DEVICE INDEPENDENT I/O TO
 742 /BE ABLE TO USE 2 PAGE DEVICE HANDLERS
 743 /
 744 TWOPAG, 0
 745         CDF     10
 746         TAD I   (MPARAM
 747         AND     (20     /IS /H SWITCH SET?
 748         SNA     CLA
 749         JMP I   TWOPAG  /NO-RETURN (DATA FLD=1)
 750         TAD     (1001   /YES-RESET HANDLR FETCH TO ACCEPT
 751         DCA     K1000   /TWO PAGE HANDLERS
 752         TAD     (2401   /RESET FETCH FOR SECOND HANDLER
 753         DCA     K2200
 754         TAD     (2777
 755         DCA     K2377   /RESET HLA CONSTANT FOR 2 PG HANDLRS
 756         TAD     (1777
 757         DCA     K1577   /RESET 2ND HLA CONSTANT FOR 2 PG
 758         TAD     (2000
 759         DCA I   (K1600  /RESET BUFR. ADDRESS-SEE *LDRXIT*
 760         CDF     00
 761         TAD     (1400
 762         DCA I   (FINBUF /RESET IN AND OUT BUFFER ADDRESSES
 763         TAD     (1400   /TO MAKE ROOM FOR 2 PG HANDLR
 764         DCA I   (FOUBUF
 765         CDF     10
 766         JMP I   TWOPAG  /RETN. DATA FLD=1
 767
 768 SETHLA, 0
 769         DCA I (HLAZ
 770         TAD I (HLAZ
 771         CIA
 772         DCA I (HLAIO
 773         CDF 0
 774         JMP I SETHLA
 775 BATCK,  0
 776         CDF 0
 777         TAD I (7777
 778         AND (70
 779         SNA
 780         JMP I BATCK
 781         CLL RTR
 782         RAR
 783         CMA
 784         DCA     TMPC
 785         TAD I   (7777
 786         RAL
 787         SPA CLA
 788         IAC
 789         TAD     TMPC
 790         JMP I   (FOUNDX
 791 TMPC,   0
 792         PAGE
 793 \f       FIELD 1
 794 /FIELD 1 PAGE 0 EQUIVALENCES - FIT INTO USR CRACKS
 795
 796         DEVHND=20
 797         BANK=21
 798         TM1=22
 799         TM2=23
 800         RECNO=24
 801         OVLYFG=25
 802         CUR=26
 803         WORD=27
 804         HLAPTR=30
 805         HLA=31
 806         RCON=32
 807         COML=33         /HI COMMON LOC, 0 IF NONE
 808         TYPE=34
 809         CSUM=35
 810         NSUB=36
 811
 812         *3600
 813 LRSTRT, DCA I (MIFILE
 814 LDRZZZ, JMS I (IONULL
 815 LDRXXX, TAD (MIFILE
 816         DCA FILPTR
 817         DCA OVLYFG
 818         DCA I (WRBFSW
 819         JMS I (START
 820         JMP IOCHEK      /GO TEST FOR /I, /O ALD /0-7
 821 LDRLP,  DCA BANK
 822         TAD I FILPTR
 823         SNA
 824         JMP GETCD
 825         JMS GETHND
 826         TAD I FILPTR
 827         ISZ FILPTR
 828         DCA RECNO
 829         TAD I (MPARAM
 830         RAR
 831         SZL CLA
 832         JMP I (LBRY
 833         JMS I (LOAD
 834         JMP LDRLP
 835 GETCD,  TAD I (MPARAM+3
 836         SNA
 837         JMP LKATMP
 838         DCA I (LSTADR
 839         TAD I (MPARAM-1
 840         CLL RAL
 841         AND (17
 842         CLL RTL
 843         TAD (CDF CIF 0
 844         DCA I (LSTFLD   /FALL INTO NEXT PAGE
 845 \fLKATMP,        JMS I (WRPGBF
 846         TAD I (MPARAM
 847         AND (40
 848         SZA CLA
 849         JMP BUILD
 850         TAD I (MPARAM-1
 851         SPA CLA
 852         JMP BUILD
 853         JMS MAP
 854 CDCALL, JMS I (200
 855         5
 856         2214
 857         TAD I (MPARAM+1
 858         AND (100
 859         SZA CLA
 860         JMP LDRZZZ
 861 IOCHEK, JMS I (IOTEST
 862         DCA TM1
 863         TAD (MIFILE
 864         DCA FILPTR
 865         TAD I (MPARAM+2
 866         AND (1774
 867         SNA
 868         JMP LDRLP
 869         RAL
 870         ISZ TM1
 871         SNL
 872         JMP .-3
 873         CLA CMA CLL RTL
 874         TAD TM1
 875         JMP LDRLP
 876 FILPTR, 0
 877 MAP,    0
 878         TAD I (MPARAM+1
 879         AND (4410       /"M","P" AND "U" OPTIONS
 880         SNA
 881 MAPRTN, JMP I   MAP
 882         CLL RTR
 883         RTR
 884         AND (200
 885         SZA CLA
 886         CLL CML IAC
 887         CML RAL         /FORM 0 IF /U, 1 IF /P AND 2 IF /M
 888         DCA TM1
 889         JMP I (MAPIO
 890 \fBUILD, TAD (SHNDLR
 891         DCA DEVHND
 892         TAD PSYSLB
 893         SZA
 894         JMS I (LBSRCH
 895         JMS MAP
 896         JMP I (BUILDX
 897 PSYSLB, 0
 898
 899 GETHND, 0
 900         AND (17
 901         DCA I (EASGN
 902         TAD (401
 903         DCA LASGN
 904         TAD I (EASGN
 905         ISZ FILPTR
 906         JMS I (200
 907         1               /ASSIGN
 908 LASGN,  401
 909         JMP I (HNDERR   /BAD HANDLER
 910         TAD LASGN
 911         DCA DEVHND
 912         JMP I GETHND
 913         PAGE
 914 \fBUILDX,        TAD LSTADR
 915         SZA CLA
 916         JMP ALREDY
 917         TAD (MAIN-1
 918         DCA X1
 919         JMS I (SETS1
 920         JMS I (SEARCH
 921         JMP I (ERSTAD
 922         TAD (TVEC-1
 923         TAD I (SYMNUM
 924         DCA TM1
 925         CDF 0
 926         TAD I TM1
 927         SNA
 928         JMP I (ERSTAD
 929         DCA LSTADR
 930         TAD TM1
 931         TAD (7700
 932         DCA TM1
 933         CLA CLL CML RTL         /CHANGE CDF TO CDF CIF
 934         TAD I TM1
 935         DCA LSTFLD
 936 ALREDY, CDF 10
 937         JMS I (WROVLY
 938         TAD (1400
 939         JMS STOINF
 940         DCA OLDT9
 941         TAD (HLA7
 942         DCA TM1
 943         TAD (-10
 944         DCA X3
 945         DCA I X1
 946         DCA X4
 947 BLDLP,  CLA CLL CML RTL
 948         TAD X3
 949         SNA CLA
 950         JMP BFLD1       /TREAT FIELD 1 (COMMON AREA) DIFFERENTLY
 951 BLDLPX, TAD I TM1
 952         AND (7600
 953         SNA
 954         JMP BLDSKP
 955 BLDLPY, TAD (170
 956         CLL CML CMA RTR
 957         RTR
 958         TAD X3
 959         CLL CMA RTL
 960         RAL
 961         DCA I X1
 962         DCA I X1
 963         ISZ X4
 964 BLDSKP, CLA CMA
 965         TAD TM1
 966         DCA TM1
 967         ISZ X3
 968         JMP BLDLP
 969         TAD X4
 970         CIA
 971         DCA I (1400
 972         CIF 0
 973         JMS I (SHNDLR
 974         4210
 975         1200
 976         MTEMP+10
 977         HLT
 978         CDF 0
 979         TAD (JSTFLD-1
 980         JMS STOINF
 981         TAD LSTADR
 982         DCA I (MSTADR
 983         TAD LSTFLD
 984         DCA I (MSTCDF
 985         JMP I (LDRXIT
 986
 987 BFLD1,  TAD COML
 988         SNA             /IS THERE ANY COMMON?
 989         JMP BLDLPX      /NO
 990         CLL CMA
 991         TAD I TM1
 992         SNL CLA         /IS THERE ANY CODE IN FIELD 1?
 993         JMP BLDSKP      /NO
 994         TAD (110        /SAVE FIELD 1 IN TWO SEGMENTS - PAGE 0 AND
 995         DCA I X1        /THE CODE FOLLOWING THE END OF THE COMMON AREA
 996         ISZ X4          /(THIS IS TO ENABLE "CHAIN" TO WORK PROPERLY)
 997         TAD COML
 998         IAC
 999         DCA I X1
1000         TAD COML
1001         CMA
1002         TAD I TM1
1003         AND (7600
1004         JMP BLDLPY
1005 \fCVTREC,        0
1006         TAD     CUR
1007         CLL RTL
1008         RTL
1009         RAL
1010         AND (7
1011         JMP I CVTREC
1012
1013 STOINF, 0
1014         DCA X1
1015         TAD LSTFLD
1016         DCA I X1
1017         TAD LSTADR
1018         DCA I X1
1019         DCA I X1
1020         JMP I STOINF
1021 LSTADR, 0
1022 LSTFLD, 0
1023         PAGE
1024
1025 \fMAPIO, TAD I ML7600
1026         SNA
1027         TAD TTYNO       /TELETYPE IS DEFAULT LISTING DEVICE
1028         JMS I (GETHND
1029         TAD I   ML7604  /PICK UP EXTENSION WORD.
1030         SNA             /NON-ZERO?
1031         TAD     (1520   /NO-SUPPLY '.MP' EXTENSION.
1032         DCA I   ML7604  /YES-LEAVE ALONE
1033         TAD ML7601
1034         DCA MNAME
1035         TAD I (EASGN
1036         TAD (100        /4 SHIFTED LEFT INTO THE "DESIRED LENGTH" POSITION
1037         JMS I (200
1038         3
1039 MNAME,  0
1040 MECNT,  0
1041         JMP I (OUERR
1042         TAD MNAME
1043         DCA ORECNO
1044         JMS OUSETP
1045         DCA MCCNT
1046         TAD (OCHAR
1047         DCA TYPE
1048         TAD TM1
1049         CLL CML RAR
1050         JMP I (MAPX
1051 OCHAR,  0
1052         DCA OUTEMP
1053         ISZ OJMP
1054         ISZ OCHCNT
1055 OJMPE,  JMP OJMP
1056         CIF 0
1057         JMS I DEVHND
1058         4210
1059 OUBUF,  4600
1060 ORECNO, 0
1061         JMP I (OUERR
1062         ISZ ORECNO
1063         ISZ MCCNT
1064         JMS OUSETP
1065         ISZ MECNT
1066         JMP OCHAR+2
1067         JMP I (OUERR
1068 \fOUSETP,        0
1069         TAD (-601
1070         DCA OCHCNT
1071         TAD OUBUF
1072         DCA OUPTR
1073         TAD OJMPE
1074         DCA OJMP
1075         JMP I OUSETP
1076
1077 OJMP,   HLT             /THREE-WAY JUMP FOR CHAR OUTPUT
1078         JMP OCHAR1
1079         JMP OCHAR2
1080 OCHAR3, TAD OJMPE
1081         DCA OJMP
1082         TAD OUTEMP
1083         RTL
1084         RTL
1085         DCA OUTEMP
1086         TAD OUTEMP
1087         AND OU7400
1088         TAD I OUPOLD
1089         DCA I OUPOLD
1090         TAD OUTEMP
1091         RTL
1092         RTL
1093         AND OU7400
1094         TAD I OUPTR
1095         DCA I OUPTR
1096         ISZ OUPTR
1097         JMP OUCOM
1098 OCHAR2, TAD OUPTR
1099         DCA OUPOLD
1100         ISZ OUPTR
1101 OCHAR1, TAD OUTEMP
1102         AND OU377
1103         DCA I OUPTR
1104 OUCOM,  JMP I OCHAR
1105 OCHCNT, 0
1106         OUPOLD=OUSETP
1107 OUTEMP, 0
1108 OU7400, 7400
1109 OUPTR,  0
1110 OU377,  377
1111 \f/CLOSE OUTPUT FILE
1112
1113 OCLOS,  TAD (232
1114         JMS OCHAR
1115         TAD OCHCNT
1116         CMA
1117         SZA CLA
1118         JMP .-4
1119         JMS OCHAR
1120         TAD I (EASGN
1121         JMS I (200
1122         4
1123 ML7601, 7601
1124 MCCNT,  0
1125         JMP I (OUERR
1126         TAD (TTYOUT
1127         DCA TYPE
1128         JMP I (MAPRTN
1129
1130 TTYOUT, 0
1131         6046
1132         6041
1133         JMP .-1
1134 ML7600, 7600
1135         JMP I TTYOUT
1136 TTYNO,  0       /SET TO TTY DEVICE NUMBER BY INITIALIZATION
1137 IONULL, 0
1138         TAD ML7600
1139         DCA I (HLASZA
1140 ML7604, 7604            /POINTER TO FILE EXT. WORD
1141         JMP I IONULL
1142         PAGE
1143 \fLOAD,  0
1144         DCA LREQUR
1145         TAD BANK
1146         TAD (HLAZ
1147         DCA HLAPTR
1148         JMS I (SETRCN   /SET UP HLA AND RCON
1149         TAD RCON
1150         CLL CML
1151         TAD LREQUR
1152         TAD (400
1153         SNL SZA CLA
1154         JMP LFAILD
1155         TAD RECNO
1156         DCA LRECNO
1157         CLA CMA
1158         DCA INCHCT
1159         JMS ICHAR
1160         SNA CLA
1161         JMP .-2
1162         JMP I (MORE
1163
1164 ICHAR,  0
1165         TAD XX7600      /PARITY TTY HACK
1166         KRS
1167         TAD (-7603
1168         SNA CLA
1169         KSF
1170         SKP
1171         JMP I (MGET             /17667=07605
1172         ISZ IJMP
1173         ISZ INCHCT
1174 IJMPE,  JMP IJMP
1175         CIF 0
1176         JMS I DEVHND
1177 INCTLW, 0410
1178 INBUF,  4600
1179 LRECNO, 0
1180         JMP INCKEF
1181 INISZ,  ISZ LRECNO
1182         ISZ LRECNO
1183         TAD IN6377
1184         DCA INCHCT
1185         TAD INBUF
1186         DCA INPTR
1187         TAD IJMPE
1188         DCA IJMP
1189         JMP ICHAR+1
1190 \fIJMP,  HLT             /THREE-WAY JUMP FOR CHAR INPUT
1191         JMP ICHAR1
1192         JMP ICHAR2
1193 ICHAR3, TAD IJMPE
1194         DCA IJMP
1195         TAD I INPTR
1196         ISZ INPTR
1197         AND IN7400
1198         CLL RTR
1199         RTR
1200         TAD INTEMP
1201         RTR
1202         RTR
1203         JMP INCOM
1204 ICHAR2, TAD I INPTR
1205         ISZ INPTR
1206         AND IN7400
1207         DCA INTEMP
1208 ICHAR1, TAD I INPTR
1209 INCOM,  AND IN377
1210         JMP I ICHAR
1211 INCKEF, SMA CLA
1212         JMP LRECNO+2
1213         JMP I (INERR
1214 INPTR,  0
1215 INCHCT, 0
1216 INTEMP, 0
1217 IN7400, 7400
1218 IN377,  377
1219 IN6377, 6377
1220 \fXX7600,
1221 XER2,   7600
1222         TAD EASGN
1223         TAD (DCB-1
1224         DCA TM2
1225         TAD I TM2
1226         SPA CLA
1227         JMP DIRDEV
1228         TAD (2205
1229         JMS I (TTWO
1230         TAD (1417
1231         JMS I (TTWO
1232         TAD (0104
1233         JMS I (TTWO
1234         JMS I (CRLF
1235 DIRDEV, TAD I HLAPTR
1236         ISZ     BANK
1237         CMA
1238         AND     XX7600
1239         JMP LOAD+1
1240 LFAILD, ISZ BANK
1241         JMP LOAD+2
1242 EASGN,  0
1243 LREQUR, 0
1244 LOADOK, JMS I (WRPGBF
1245         JMP I LOAD
1246
1247 SETS1,  0
1248         TAD (S1-1
1249         DCA X2
1250         TAD I X1
1251         DCA I X2
1252         TAD I X1
1253         DCA I X2
1254         TAD I X1
1255         DCA I X2
1256         JMP I SETS1
1257         PAGE
1258 \f/ 4600-5177 USED FOR LOADER MAP OUTPUT BUFFER
1259 /  5200-5577 USED FOR LIBRARY DIRECTORY BUFFER
1260
1261         *5600
1262
1263 /** CAN ONLY USE FIRST HALF OF THIS PAGE - 2ND HALF IS PART OF MST
1264 /** NO LITERALS IN THIS PAGE!
1265
1266 LBRY,   TAD RECNO
1267         JMS LBSRCH
1268         JMP I .+1
1269         GETCD
1270
1271 LBSRCH, 0               /LIBRARY SEARCH ROUTINE
1272         DCA LBREC       /SAVE START BLK OF LIBRARY
1273         CIF 0
1274         JMS I DEVHND    /READ LIBRARY DIRECTORY
1275 LBCTLW, 0210
1276 L5200,  5200
1277 LBREC,  0
1278         JMP I LIOERR
1279         TAD LBCTLW
1280         DCA I LINCTL
1281         TAD L7177
1282         DCA I LIN6377
1283         DCA I LINISZ
1284         TAD L5177
1285         DCA X1          /INITIALIZE FOR SEARCH
1286 LBRYLP, JMS I LSETS1    /GET NEXT DIRECTORY ENTRY
1287         TAD I X1
1288         SNA
1289         JMP I LBSRCH    /END OF DIRECTORY
1290         TAD L5200
1291         DCA LBFPTR
1292         JMS I LSEARCH   /IS IT IN SYMTAB?
1293         JMP LBRYLP      /NO
1294         TAD I LSYMNUM
1295         TAD LTVEC1
1296         DCA TM1
1297         CDF 0
1298         TAD I TM1
1299         CDF 10
1300         SZA CLA         /IS SYMBOL ALREADY DEFINED?
1301         JMP LBRYLP      /YES
1302 LBLDLP, TAD I LBFPTR    /GET MODULE TO LOAD
1303         SNA
1304         JMP LBRYLP-2    /NO MORE MODULES TO LOAD
1305         AND L177
1306         IAC
1307         TAD LBREC
1308         DCA RECNO
1309         DCA BANK
1310         TAD I LBFPTR
1311         AND L7600
1312         JMS I LLOAD     /LOAD LIBRARY MODULE
1313         ISZ LBFPTR
1314         JMP LBLDLP      /GET NEXT MODULE
1315
1316 LBFPTR, 0
1317 LIOERR, INERR
1318 LINCTL, INCTLW
1319 L7177,  7177
1320 LIN6377,        IN6377
1321 L5177,  5177
1322 LSETS1, SETS1
1323 LSEARCH,        SEARCH
1324 L177,   177
1325 L7600,  7600
1326 LLOAD,  LOAD
1327 LSYMNUM,        SYMNUM
1328 LINISZ, INISZ
1329 LTVEC1, TVEC-1
1330         IFZERO  .-5700&4000     <LBRERR,        _ERROR>
1331 \f/MAIN LOADING CODE
1332 /MODIFIED VERSION OF
1333 /PAPER-TAPE LINKING LOADER
1334
1335 /DEFINITIONS
1336
1337 BCRT=   200
1338 TVEC=   300
1339 ORGT=   100             /LOCAL SYMBOL TABLE NOW IN FIELD 0
1340 MST=    6177            /MAIN SYMBOL TABLE
1341
1342 *6200
1343
1344 /START OF PROGRAM - INITIALIZATION
1345
1346 START,  0
1347         TAD     K7600   /SET COUNTER FOR 200
1348         DCA     NSUB
1349         TAD     BCRTA   /POINTER TO BANK TABLE
1350         DCA     X3
1351         CDF 00
1352         DCA I   X3      /CLEAR BANK TABLE & TV TABLE
1353         ISZ     NSUB
1354         JMP     .-2     /NOT DONE
1355         CDF 10
1356         TAD     M10
1357         DCA     NSUB
1358         TAD     HLAZA
1359         DCA     X3
1360         TAD     K777
1361         DCA I   X3      /BANK0 HIGHEST LOADED ADDR. =777
1362         ISZ     NSUB    /NSUB INCREMENTS TO ZERO
1363         JMP     .-2
1364         DCA     COML    /INIT. OLD COMMON AT 0000
1365         JMP I START
1366 \f/REENTRY FOR NEXT ROUTINE TO BE LOADED
1367
1368 MORE,   DCA     LMTC    /CLR LOCAL SYMBOL COUNT
1369         DCA     CSUM    /CLR CHECKSUM
1370         TAD     MORE1A  /SET FOR RETURN TO MORE1 IF LEADER
1371         DCA     EOF
1372 MORE1,  JMS     RWORD
1373         TAD     RC10A   /RESET EOF TO WATCH FOR TRAILER
1374         DCA     EOF
1375         TAD     CODE    /CK FOR HIGH COMMON
1376         TAD     M12
1377         SZA CLA
1378         JMP I   ER5P    /NOT THERE
1379         TAD COML
1380         CIA
1381         CLL CML         /IF NO COMMON EXISTS, OR
1382         TAD WORD        /IF NEW COMMON .LE. OLD IT'S
1383         SNL SZA CLA     /OK, ELSE ERROR
1384         JMP I ER3P
1385         TAD COML
1386         SNA CLA
1387         TAD     WORD    /IF NO PREVIOUS COMMON AND IF
1388         AND     K7600   /THIS PROGRAM HAS COMMON ABOVE 177
1389         SNA             /THEN SET COMMON LIMIT TO LIMIT OF THIS PROG
1390         JMP     GETSW
1391         AND     K7400
1392         TAD     K377    /HIGH COMMON MUST BE AT A MULTIPLE OF 400
1393         DCA     COML
1394         TAD I HLA1P     /IF WE HAVE LOADED
1395         SZA CLA         /ANY CODE INTO FIELD 1
1396         JMP I ER3P      /IT'S AN ERROR
1397         TAD     COML    /SET BANK1 HIGHEST LOADED ADDRESS
1398         DCA I   HLA1P
1399         JMS I   (SETRCN /SET UP HLA AND RCON AGAIN JUST IN CASE
1400 GETSW,  TAD     BANK    /BANK NUMBER
1401         TAD     TOPCOR  /OK FOR NON-EX. MEM.
1402         SMA CLA
1403         JMP I   ER2I    /TOO BIG
1404 /
1405 /MAIN LOADING LOOP
1406 /
1407 LOOP,   JMS     RWORD
1408         TAD     BASE    /LOCATE CORRECT FUNCTION
1409         TAD     CODE    /IN TRANSFER TABLE
1410         DCA     CODE
1411 CODE,   0               /TRANSFER TO APPROPRIATE ADDRESS
1412 \f/READ 12-BIT COMPUTER WORD & 4-BIT RELOCATION CODE
1413 /FROM 2 INPUT CHARACTERS
1414
1415 RWORD,  0
1416         JMS I   HSRPA   /FIRST FRAME
1417         DCA     WORD
1418         TAD     WORD    /EXTRACT RELOC. CODE
1419         RTR
1420         RTR
1421         AND     K17
1422         DCA     CODE
1423         TAD     CODE    /CK FOR LEADER
1424         TAD     M10
1425         SNA CLA
1426         JMP I   EOF     /YES
1427         TAD     WORD    /ADD TO CHECKSUM
1428         TAD     CSUM
1429         DCA     CSUM
1430         JMS FORMWD
1431         JMS I   RCHARP
1432         TAD     WORD
1433         DCA     WORD
1434         JMP I   RWORD
1435
1436 FORMWD, 0
1437         TAD WORD
1438         RTR
1439         RTR
1440         RAR
1441         AND K7400       /ISOLATE HI 4 BITS
1442         DCA WORD        /FROM 1ST CHAR
1443         JMP I FORMWD
1444
1445 /DATA
1446
1447 EOF,    0
1448 LMTC,   0
1449 K17,    17
1450 K377,   377
1451 K777,   777
1452 K7400,  7400
1453 K7600,  7600
1454 M10,    -10
1455 M12,    -12
1456 BASE,   JMP I TRTAB
1457 BCRTA,  BCRT-1
1458 HLAZA,  HLAZ-1
1459 HSRPA,  ICHAR
1460 MORE1A, MORE1
1461 RCHARP, RCHAR
1462 TOPCOR, 0
1463 HLA1P,  HLA1
1464 ER2I,   ER2
1465 \f/RELOCATION CODE TRANSFER TABLE
1466
1467 TRTAB,  RC0             /LOAD AS IS
1468         RC1             /ADD RELOCATION CONSTANT
1469         ER5
1470         RC3             /DEFINE SYMBOL
1471         RC4             /ORIGIN
1472         RC5             /CDF TO CURRENT BANK
1473         RC6             /REPLACE LOCAL # WITH GLOBAL #
1474         ER5
1475 RC10A,  RC10            /LEADER-TRAILER
1476         ER5
1477 ER3P,   ER3             /HIGH COMMON
1478 ER5P,   ER5
1479         ER5
1480         ER5
1481         ER5
1482         RC17            /EXTERNAL SYMBOL SPECIFICATION
1483         PAGE
1484 \f/NEW ORIGIN
1485
1486 RC4,    TAD     WORD    /NEW ORIGIN
1487         CLL
1488         TAD     RCON    /+ RELOCATION CONSTANT
1489         DCA     CUR     /= NEW LOADING ADDRESS
1490         SZL
1491         JMP I OVERFP    /FIELD OVERFLOW
1492         JMP I   LOOPP1
1493 /
1494 /CHANGE CDF TO CURRENT BANK
1495 /
1496 RC5,    TAD     BANK    /MOVE BANK TO BITS 6-8
1497         CLL RTL
1498         RAL
1499         TAD     WORD    /PICK UP CDF
1500         JMP     RC1+2
1501 /
1502 /REPLACE LOCAL EXTERNAL SYMBOL NUMBER WITH GLOBAL EXT. SYM. NO.
1503 /
1504 RC6,    TAD     WORD
1505         AND     K77     /EXTRACT LOCAL NUMBER
1506         DCA     B1
1507         TAD     B1      /CK IF LOCAL # .LE. LOCAL SYM. COUNT
1508         CIA
1509         TAD I   LMTCP1
1510         SPA CLA
1511         JMP I   ER5I    /NO
1512         TAD     B1      /ADD LOCAL # TO BASE OF TABLE
1513         TAD     ORGTA
1514         DCA     B1
1515         TAD     WORD    /LOAD ARG COUNT
1516         AND     K7700
1517 KCDF,   CDF 0
1518         TAD I   B1      /+ GLOBAL #
1519         CDF 10
1520         JMP     RC1+2   /AT CURRENT LOADING ADDRESS
1521 \f/ADD RELOCATION CONSTANT TO WORD
1522
1523 RC1,    TAD     WORD
1524         TAD     RCON
1525         DCA     WORD
1526 /
1527 /LOAD WORD DIRECTLY AS IT IS
1528 /
1529 RC0,    TAD     HLA     /CK FOR CURRENT ADDRESS TO LOAD
1530         CIA CLL         /.GE. HIGHEST ALREADY LOADED
1531         TAD     CUR
1532         SNL CLA
1533         JMP     .+3     /NO
1534         TAD     CUR     /YES, RESET HIGHEST
1535         DCA     HLA
1536         CLL
1537         TAD     CUR     /CK FOR ATTEMPT TO LOAD TOP PAGE
1538         TAD     K200
1539         SZL CLA
1540         JMP I   OVERFP  /YES, ROUTINE IS TOO BIG
1541         CLA CMA
1542         TAD     BANK
1543         SZA CLA
1544         JMP     JUSTLD
1545         CLL CML CLA RTR
1546         TAD     CUR
1547         SZL SPA CLA
1548         JMP     GT2000
1549         TAD     OVLYFG
1550 K7700,  SMA CLA
1551         JMP     OFFSET
1552         JMS I   (CVTREC
1553         TAD     (-11
1554         JMP     PAGEX2
1555 GT2000, TAD     CUR
1556         CLL
1557         TAD     (-3600
1558         SZL CLA
1559         JMP     PAGEX1
1560         JMS I   (WROVLY
1561         CLA CMA
1562         DCA     OVLYFG
1563         JMP     JUSTLD
1564 PAGEX1, TAD     K200
1565         JMS I   (CVTREC
1566 PAGEX2, TAD     (MTEMP+11
1567         JMS I   (WRPGBF
1568         CLA CLL CML RTR
1569         TAD     CUR
1570         SZL SPA CLA
1571         TAD     K200
1572         TAD     CUR
1573         AND     (377
1574         TAD     (1400
1575         JMP     JUSTLD+1
1576 OFFSET, CLA IAC
1577         DCA     OVLYFG
1578         TAD     (1600
1579 JUSTLD, TAD     CUR
1580         DCA     CURX
1581         TAD     BANK
1582         CLL RTL
1583         RAL
1584         TAD     KCDF
1585         DCA     .+2
1586         TAD     WORD
1587         HLT
1588         DCA I   CURX
1589         CDF 10
1590         ISZ     CUR
1591         JMP I   LOOPP1
1592 CURX,   0
1593 /
1594 /DATA
1595 /
1596 K77,    77
1597 K200,   200
1598 ER5I,   ER5
1599 LMTCP1, LMTC
1600 LOOPP1, LOOP
1601 ORGTA,  ORGT
1602 OVERFP, OVERFL
1603 HLAZ,   0               /HLA GROUP MUST REMAIN IN GIVEN ORDER
1604 HLA1,   0
1605 HLA2,   0
1606 HLA3,   0
1607 HLA4,   0
1608 HLA5,   0
1609 HLA6,   0
1610 HLA7,   0
1611 B1,
1612
1613 HLATST, 0
1614         TAD HLAZ
1615         TAD HLAIO
1616 HLASZA, SZA CLA         /SET TO CLA BY /R AND RESTART
1617         JMP I (UIOERR
1618         JMP I HLATST
1619 HLAIO,  -777
1620         PAGE
1621 \f/SYMBOL DEFINITION
1622
1623 RC3,    JMS I   GTSYMP
1624         TAD     TVM1    /ADJUSTED BASE OF TRANSFER VECTOR TABLE
1625         TAD     SYMNUM  /+ NUM. OF SYMBOL IN MST
1626         DCA     C1
1627         TAD     RCON    /LOADING ADDRESS OF THE SYMBOL
1628         TAD     WORD
1629         CDF 00
1630         DCA I   C1      /TO THE TRANS. VEC. TABLE
1631         TAD     C1      /GET POINTER INTO TRANSFER VECTOR TABLE
1632         TAD     M100A   /FORM CORRESPONDING POINTER INTO BANK TABLE
1633         DCA     C1      /=PTR. TO BANK TABLE STORAGE
1634         TAD     BANK    /GET BANK IN BITS 6-8
1635         CLL RTL
1636         RAL
1637         DCA I   C1      /STORE IN BANK TABLE
1638         CDF 10
1639 RC3A,   TAD     NSUB    /CHECK FOR TOO MANY SYMBOLS
1640         TAD     M100A
1641         SPA SNA CLA
1642         JMP I   LOOPP2  /NO
1643         JMP     ER1
1644 /
1645 /TRANSFER VECTOR
1646 /
1647 RC17,   TAD     WORD    /COUNTER OF SYMBOLS TO COME
1648         CIA
1649         DCA     C2
1650 RC17A,  JMS I   GTSYMP
1651         ISZ I   LMTCP2  /INC. LOCAL SYM. CTR.
1652         TAD     ORGTA2  /GET PTR TO STORAGE IN ORIG. TABLE
1653         TAD I   LMTCP2
1654         DCA     C1
1655         CMA             /SYM. # -1 TO ORIG. TABLE
1656         TAD     SYMNUM
1657         CDF 0
1658         DCA I   C1
1659         CDF 10
1660         ISZ     C2      /CK CTR.
1661         JMP     RC17A   /NOT DONE
1662         JMP     RC3A
1663 \f/ERRORS
1664
1665 SIOERR,
1666 H7600,  7600
1667         DCA ERBACK
1668         IAC
1669 HNDERR, IAC
1670 ERSTAD, IAC
1671 INERR,  IAC
1672 OUERR,  IAC
1673 ER5,    IAC             /ILLEGAL INPUT FORMAT
1674 ER4,    IAC             /CHECKSUM ERROR
1675 ER3,    IAC             /HIGHEST COMMON NOT FIRST
1676 ER2,    IAC             /PROGRAM TOO LARGE
1677 ER1,    IAC             /SYMBOL TABLE OVERFLOW
1678 UIOERR, DCA     C3
1679         JMS     CRLF
1680         TAD     K0522   /"ER"
1681         JMS     TTWO
1682         TAD     K2217   /"RO"
1683         JMS     TTWO
1684         TAD     K2240   /"R "
1685         JMS     TTWO
1686         TAD     C3      /#
1687         JMS     TOCT
1688         JMS I   (WRPGBF
1689 ERBACK, JMP I   (CDCALL
1690         CDF CIF 0
1691         JMP I   H7600   /RETURN TO MONITOR
1692 /
1693 /TYPE A CARRIAGE RETURN & LINE FEED
1694 /
1695 CRLF,   0
1696         TAD     K215
1697         JMS I   TYPE
1698         TAD     K212
1699         JMS I   TYPE
1700         JMP I   CRLF
1701 /
1702 /UNPACK & TYPE 2 6-BIT CHARACTERS
1703 /
1704 TTWO,   0
1705         DCA     C1
1706         CMA             /SET FLAG FOR 1ST CHARACTER
1707         DCA     C2
1708         TAD     C1      /MOVE LEFT HALF DOWN
1709         RTR
1710         RTR
1711         RTR
1712         SKP
1713 TTWO1,  TAD     C1      /GET RIGHT HALF
1714         AND     C77
1715         TAD     M40     /200 OR 300 GROUP?
1716         SPA
1717         TAD     K100    /300 + 6BIT
1718         TAD     K2240   /200 + 6BIT
1719         JMS I   TYPE
1720         ISZ     C2      /2ND CHARACTER DONE?
1721         JMP I   TTWO
1722         JMP     TTWO1   /NO
1723 /
1724 /TYPE OCTAL CONTENTS OF AC
1725 /
1726 TOCT,   0
1727         DCA     C1
1728         TAD     M4B
1729         DCA     C2
1730 TOCT1,  TAD     C1      /MOVE NEXT DIGIT INTO BITS 9-11
1731         RTL
1732         RAL
1733         DCA     C1
1734         TAD     C1      /GET DIGIT
1735         RAL
1736         AND     KK7
1737         TAD     C260    /CONVERT TO ASCII
1738         JMS I   TYPE
1739         ISZ     C2
1740         JMP     TOCT1   /MORE TO GO
1741         JMP I   TOCT
1742 /
1743 /DATA
1744 /
1745 C1,     0
1746 C2,     0
1747 C3,
1748 SYMNUM, 0
1749 KK7,    7
1750 C77,    77
1751 K100,   100
1752 K212,   212
1753 K215,   215
1754 C260,   260
1755 K0522,  0522
1756 K2217,  2217
1757 K2240,  2240
1758 M4B,    -4
1759 M40,    -40
1760 M100A,  -100
1761 GTSYMP, GETSYM
1762 LMTCP2, LMTC
1763 LOOPP2, LOOP
1764 ORGTA2, ORGT
1765 TVM1,   TVEC-1
1766         PAGE
1767 \f/STORE OR LOOK UP SYMBOL IN SYMBOL TABLE
1768
1769 DEFN,   0
1770
1771 /READ A SYMBOL FROM INPUT ASCII - 6 FRAMES
1772
1773         CLA CLL CMA RTL
1774         DCA     D1
1775         TAD     S1A     /POINTER TO 3 WORD BUFFER
1776         DCA     X3
1777 RSYM1,  JMS     RCHAR
1778         AND     K0077   /EXTRACT 6-BIT
1779         CLL RTL
1780         RTL
1781         RTL
1782         DCA     D3      /SAVE LEFT HALF
1783         JMS     RCHAR
1784         AND     K0077   /GET RIGHT HALF
1785         TAD     D3
1786         DCA I   X3
1787         ISZ     D1
1788         JMP     RSYM1   /NOT DONE
1789         JMP I   DEFN
1790 /
1791 /SEARCH SYMBOL TABLE FOR CURRENT SYMBOL (IN S1-S3)
1792 /
1793 SEARCH, 0
1794         DCA I   SYMNMP  /CLR SYMBOL COUNTER
1795         TAD     MSTA    /SET SYMBOL TABLE PTR
1796         DCA     D4
1797         TAD     NSUB    /SET CTR FOR NUMBER OF SYMBOLS
1798         CMA             /+1 (IN CASE NSUB=0)
1799         DCA     D5
1800         JMP     SRCH2
1801 SRCH1,  ISZ I   SYMNMP  /KEEP COUNT
1802         TAD     D4      /TEST TABLE ENTRY
1803         DCA     X4      /SYM. TAB. PTR
1804         CLA CLL CMA RTL
1805         DCA     D2      /COUNTER
1806         TAD     S1A
1807         DCA     X3      /PTR TO S1/S3
1808 COMP1,  TAD I   X4      /COMPARE WORDS
1809         CIA
1810         TAD I   X3
1811         SZA CLA
1812         JMP     NOMACH  /NOT ALIKE
1813         ISZ     D2
1814         JMP     COMP1   /TRY NEXT WORD OF TRIPLET
1815         ISZ     SEARCH
1816         JMP I   SEARCH
1817 NOMACH, CLA CLL CMA RTL
1818         TAD D4
1819         DCA     D4
1820 SRCH2,  ISZ     D5
1821         JMP     SRCH1   /NOT DONE
1822         JMP I   SEARCH
1823 /
1824 /ENTER A SYMBOL IN THE SYMBOL TABLE
1825 /
1826 INSERT, 0
1827         TAD     NSUB    /(NUMBER OF SYMBOLS)*3
1828         CLL RAL
1829         TAD     NSUB
1830         CIA             /SUBTRACT FROM BASE OF TABLE
1831         TAD     MSTA
1832         DCA     X3      /FOR POINTER
1833         TAD     S1      /1ST WORD
1834         DCA I   X3
1835         TAD     S2      /2ND
1836         DCA I   X3
1837         TAD     S3      /3RD
1838         DCA I   X3
1839         ISZ     NSUB    /COMPUTE SYM. TAB. NUMBER
1840         TAD     NSUB
1841         DCA I   SYMNMP
1842         JMP I   INSERT
1843 /
1844 /CORE OVERFLOW
1845 /
1846 OVERFL, TAD     BCRTA3
1847         DCA     D1
1848         TAD     TVECA3
1849         DCA     D2
1850         TAD     M100
1851         DCA     D3
1852         CDF 00
1853 OVERF2, TAD I   D1      /CK FOR CDF IN BCRT
1854         SPA CLA
1855         JMP     .+3     /YES
1856         DCA I   D1      /NO, CLEAR IT
1857         DCA I   D2      /CLEAR TV WORD
1858         ISZ     D1
1859         ISZ     D2
1860         ISZ     D3
1861         JMP     OVERF2  /MORE TO GO
1862         CDF 10
1863         JMP I   ER2P
1864
1865 GETSYM, 0       /GET SYMBOL AND SEARCH TABLE
1866         JMS     DEFN
1867         JMS     SEARCH
1868         JMS     INSERT
1869         JMP I   GETSYM
1870 \f/READ 1 FRAME & ADD TO CHECKSUM
1871
1872 RCHAR,  0
1873         JMS I   HSRPB
1874         DCA     D4
1875         TAD     D4
1876         TAD     CSUM
1877         DCA     CSUM
1878         TAD     D4
1879         JMP I   RCHAR
1880
1881 SETRCN, 0               /SUBR TO SET HIGHEST-LOADED ADDRESS (HLA)
1882         TAD I   HLAPTR  /AND RELOCATION CONSTANT (RCON)
1883         DCA     HLA
1884         TAD     HLA
1885         AND     (7600
1886         DCA     RCON
1887         JMP I   SETRCN
1888
1889 MAIN,   1501;1116;4040  /"MAIN"
1890
1891 /
1892 /DATA
1893 /
1894 D1,     0
1895 D2,     0
1896 D3,     0
1897 D4,     0
1898 D5,     0
1899 S1,     0
1900 S2,     0
1901 S3,     0
1902 K0077,  77
1903 M100,   -100
1904 BCRTA3, BCRT
1905 ER2P,   XER2
1906 HSRPB,  ICHAR
1907 MSTA,   MST-3
1908 S1A,    S1-1
1909 SYMNMP, SYMNUM
1910 TVECA3, TVEC
1911         PAGE
1912 \f/TRAILER CODE EXIT
1913
1914 RC10,   JMS I (FORMWD
1915         JMS I   HSRP    /GET LOW ORDER PART
1916         TAD     WORD
1917         CIA
1918         TAD     CSUM    /COMPARE WITH ACCUMULATED SUM
1919         SZA CLA
1920         JMP I   ER4P    /NOT EQUAL
1921         TAD     BCRTA4
1922         DCA     T1
1923         TAD     TVECA
1924         DCA     X2
1925         TAD     M100D
1926         DCA     T3
1927 K6201A, CDF 00
1928 RC10Z,  TAD I   X2      /GET TV ENTRY
1929         SNA CLA
1930         JMP     .+5     /NOT DEFINED; IGNORE IT
1931         TAD I   T1      /GET BCRT WORD
1932         AND     K70     /EXTRACT BANK
1933         TAD     K6201A  /COMBINE CDF
1934         DCA I   T1
1935         ISZ     T1
1936         ISZ     T3
1937         JMP     RC10Z   /NOT DONE YET
1938         CDF 10
1939         TAD     HLA     /STORE HIGHEST LOADED ADDRESS
1940         DCA I   HLAPTR  /IN PROPER LOC. (HLA0-7)
1941         JMP I (LOADOK
1942 \f/LOADER MAP PRINT ROUTINE CONTINUED
1943
1944 MAPX,   SNL CLA         /IF LINK=1 ONLY PRINT PAGE COUNTS,
1945         TAD     NSUB    /OTHERWISE PRINT SYMBOLS
1946         CMA
1947         DCA     T1      /CTR OF ROUTINES
1948         TAD     MSTA4   /SYMB. TAB. PTR.
1949         DCA     X1
1950         TAD     TVECA   /TV PTR
1951         DCA     X2
1952         TAD     BCRTA4  /BCRT PTR
1953         DCA     T4
1954         TAD     (2640   /PRINT V#
1955         JMS I   TTWOP
1956         TAD (VERSION+PATCH
1957         JMS I TTWOP
1958         JMS I   CRLFP
1959         JMP     PRINT1
1960 PRINT,  TAD TM1
1961         RTR CLL
1962         CDF 0
1963         TAD I X2
1964         CDF 10
1965         DCA TM2
1966         TAD TM2
1967         SNL SZA CLA
1968         JMP PIGNOR
1969         TAD I   X1
1970         JMS I   TTWOP
1971         TAD I   X1
1972         JMS I   TTWOP
1973         TAD I   X1
1974         JMS I   TTWOP
1975         TAD     K4040   /2 SPACES
1976         JMS I   TTWOP
1977         CDF 00
1978         TAD I   T4      /PRINT BANK NUMBER
1979         CDF 10
1980         RTR
1981         RAR
1982         AND     K7B
1983         TAD     K260
1984         JMS I   TYPE
1985         TAD     TM2     /PRINT SYMBOL VALUE
1986         JMS I   TOCTP
1987         TAD     TM2     /IF ADDRESS=0,IT IS UNDEFINED
1988         SZA CLA
1989         JMP     .+3     /ITS OK
1990         TAD     K4025   /TYPE SPACE,U
1991         JMS I   TTWOP
1992         JMS I   CRLFP
1993         TAD     M03
1994 PIGNOR, TAD     M03
1995         TAD     X1
1996         DCA     X1
1997         ISZ     T4
1998 PRINT1, ISZ     T1
1999         JMP     PRINT   /JUMP IF MORE SYMBOLS, ELSE FALL INTO NEXT PG
2000 \fPAGES, TAD     FCTR    /SET CTR FOR CORRECT # OF BANKS
2001         DCA     T1
2002         TAD     (HLAZ-1 /INIT. PTR. TO HLA LIST
2003         DCA     X1
2004         TAD I   X1      /GET HLA OF NEXT BANK
2005         CMA RTL         /DIVIDE BY 200 AND COMPLEMENT
2006         RTL
2007         RTL
2008         AND     K37     /=NUMBER OF PAGES LEFT + 1
2009         SZA
2010         TAD     (-1     /REDUCE IF NON-ZERO
2011         JMS I TOCTP
2012         JMS I   CRLFP
2013         ISZ     T1
2014         JMP     PAGES+4 /NOT DONE WITH ALL BANKS
2015         JMP I   (OCLOS
2016
2017 /
2018 /DATA
2019 /
2020 FCTR,   0               /# OF HIGHEST MEM. FIELD
2021 K37,    37
2022 T1,     0
2023 T3,     0
2024 T4,     0
2025 K7B,    7
2026 K70,    70
2027 K260,   260
2028 K4025,  4025
2029 K4040,  4040
2030 M03,    -3
2031 BCRTA4, BCRT
2032 CRLFP,  CRLF
2033 ER4P,   ER4
2034 HSRP,   ICHAR
2035 MSTA4,  MST-3
2036 TOCTP,  TOCT
2037 TTWOP,  TTWO
2038 TVECA,  TVEC-1
2039 M100D,  7700
2040         PAGE
2041 \f/WROVLY IS USED TO STORE THE FIELD COUNT FOR THE PROPGT
2042 /ROUTINE- PROPGT IS CALLED THE FIRST TIME THAT IOTEST IS
2043 /CALLED-SEE LOC.325 IN FIELD ZERO(APPROX.)
2044
2045 BC1000, 1000
2046 WROVLY, 0
2047         TAD OVLYFG
2048         SPA SNA CLA
2049         JMP I WROVLY
2050         CIF 0
2051         JMS I (SHNDLR
2052         0110
2053         1600
2054         MTEMP
2055         JMP I (SIOERR
2056         CIF 0
2057         JMS I (SHNDLR
2058         5010
2059         1600
2060         MTEMP
2061         JMP I (SIOERR
2062         DCA OVLYFG
2063         JMP I WROVLY
2064
2065 WRPGBF, 0
2066         DCA PRECNO
2067         TAD WRBFSW
2068         SNA
2069         JMP PREAD
2070         CIA
2071         TAD PRECNO
2072         SNA CLA
2073         JMP I WRPGBF
2074         CIF 0
2075         JMS I (SHNDLR
2076         4210
2077         1400
2078 WRBFSW, 0
2079         JMP I (SIOERR
2080 PREAD,  DCA OLDT9
2081         TAD PRECNO
2082         SNA CLA
2083         JMP SETBF
2084         CIF 0
2085         JMS I (SHNDLR
2086         0210
2087         1400
2088 PRECNO, 0
2089         JMP I (SIOERR
2090 SETBF,  TAD PRECNO
2091         DCA WRBFSW
2092         JMP I WRPGBF
2093 \f/LOADER CLEANUP CODE - PREPARES TO RETURN TO OS/8
2094
2095 LDRXIT, CDF 10
2096         TAD I (HLA1
2097         TAD BC200
2098 L7700,  SMA CLA         /DID WE LOAD OVER THE LOADER?
2099         TAD (FIVE       /NO
2100         DCA WROVLY      /WROVLY=0 OR 5
2101         CIF 0
2102         JMS I (SHNDLR
2103         0201
2104         400
2105         MTEMP+21        /READ BACK THE RUN-TIME ROUTINES
2106         JMP I (SIOERR   /BADDIE
2107         TAD     K1600
2108         CDF 0
2109         DCA I ST1600
2110         TAD I P4
2111         DCA I P5
2112         ISZ P4
2113         ISZ P5
2114         ISZ P6
2115         JMP .-5         /ALSO MOVE 16-32 INTO LOC 100
2116         CDF 10
2117         JMS I BC200
2118         13              /RESET EVERYTHING
2119         TAD I (MPARAM
2120         AND (40         /GET "/G" SWITCH
2121         SNA CLA
2122         JMP CALMON      /GO SWITCH NOT ON
2123         JMS I   BC200
2124         11              /KICK MONITOR OUT
2125         CDF CIF 0
2126         TAD (MSTCDF
2127         DCA I (FIVE+1   /GO TO PROGRAM START ADR INSTEAD OF 7600
2128         ISZ I (ONE      /OPTOMIZE READ A LITTLE ON DECTAPE
2129         JMP I WROVLY
2130
2131 CALMON, CLA CMA
2132         DCA I L7700     /INDICATE I/O MONITOR IS IN CORE
2133         CDF CIF 0
2134         JMP I WROVLY    /GET OUT
2135
2136 ST1600, 177             /THIS IS SET TO "FINBUF" OR "FOUBUF" BY /I AND /O
2137 P4,     16
2138 P5,     100
2139 P6,     -15
2140 \f/ROUTINE TO TEST FOR /I AND /O SWITCHES
2141
2142 IOTEST, 0
2143         TAD I (MPARAM
2144         AND (10
2145         SNA CLA         //I?
2146         JMP .+4
2147         JMS I (HLATST
2148         CDF CIF 0
2149         JMS I (INPENB
2150         TAD I (MPARAM+1
2151 BC200,  AND BC1000
2152         SNA CLA         //O?
2153         JMP .+4
2154         JMS I (HLATST
2155         CDF CIF 0
2156         JMS I (OUPENB
2157         ISZ     DOPROP  /SHOULD WE PROPAGATE RESIDENT(AND WRITE OUT
2158         JMP     .+4     /THE RUN-TIME ROUTINES?)--NO
2159         TAD     WROVLY  /YES-FIELD COUNT IS IN WROVLY
2160         CDF     CIF 0
2161         JMS I   (PROPGT /DO IT
2162         JMP I IOTEST
2163 K1600,  1600    /RESET TO 2000 IF TWO PG.DEV.HNDLRS AT RUN TIME
2164 DOPROP, 7777    /ONCE-ONLY FLAG FOR PROPAGATING FIELD ZERO
2165                         /RESIDENT AND WRITING OUT RUNTIME ROUTINES
2166                         /NOT RESET AFTER /R!!!!
2167                         /SET TO -2 IF CALLED BY ".R LOADER"
2168                         /BECAUSE OF USELESS INIT CALL TO IOTEST
2169         PAGE
2170         $
2171 \f