sw/os8/v3d/sources/fortran/all/libra.pa

   1 /LIBRA: F4 LIBRARIAN, V24A
   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/LIBRA: FORTRAN IV LIBRARIAN
  41 /
  42 /
  43 /       BORN OF JUD LEONARD, UNDER THE
  44 /       SIGN FOR WHICH IT IS NAMED.
  45 /
  46 /
  47 / CHANGES FOR V23
  48 / .PRINT VERSION NUMBER
  49 / .ACCEPT INPUT FROM CONSOLES WITHOUT PARITY
  50 /
  51 /
  52 / CHANGES FOR OS/8 V3D BY PAULA TIRAK
  53 / .CHANGED VERSION NUMBER TO 24A
  54 / .PUT IN NEW DATE ALGORITHM
  55 / .NO LONGER MISNAMES THE SECOND OUTPUT FILE
  56 /
  57 /
  58 /       OS/8 CONSTANTS:
  59 VERS=24
  60 PATCH="A
  61 /
  62 FETCH=1
  63 LOOKUP=2
  64 ENTER=3
  65 CLOSE=4
  66 DECODE=5
  67 CHAIN=6
  68 ERROR=7
  69 USRIN=10
  70 USROUT=11
  71 /
  72 OUTF1=7600      /LIBRARY
  73 OUTF2=7605      /CATALOG LISTING
  74 OUTF3=7612      /UNUSED
  75 INF=7617
  76 /
  77 EQHI=7642
  78 SWATOL=7643
  79 SWMTOX=7644
  80 SWYTO9=7645
  81 EQLO=7646
  82 DHRES=7647      /HANDLER RESIDENCY TABLE
  83 SYSDAT=7666     /SYSTEM DATE
  84 DCTLW=7760      /DEVICE CONTROL WORD TABLE
  85 /       DEVICE CONTROL WORDS HAVE THE FORM:
  86 /       BIT 0   FILE STRUCTURED
  87 /       BIT 1   READ ONLY
  88 /       BIT 2   WRITE ONLY
  89 /       BITS 3-8 DEVICE TYPE
  90 /       BITS 9-11 DIR BLOCK OF CURRENT TENTATIVE FILE
  91 /
  92 /       INTERNAL DEFINITIONS:
  93 F0=00
  94 F1=10
  95 CATBUF=2000     /IN FIELD 1
  96 CBUFS=1         /NUMBER OF BUFFERS FOR CATALOG
  97 MODBUF=2400     /LIKEWISE
  98 MBUFS=12        /BUFFERS FOR MODULE
  99 ODEVH=7200      /OUTPUT DEVICE HANDLER (ROOM FOR 2-PAGE)
 100 IDEVH=6600      /INPUT DEVICE HANDLER
 101 \f/
 102 /       PAGE 0 FOR LIBRA
 103 /
 104         *1
 105 TMP1,   0
 106 TMP2,   0       /SOME TEMPS
 107 TMP3,   0
 108 TMP4,   0
 109 TMP5,   0
 110 TMP6,   0
 111 TMP7,   0
 112 X0,     0       /AUTO-INDEX
 113 X1,     0
 114 X2,     0
 115 X3,     0
 116 X4,     0
 117 X5,     0
 118 X6,     0
 119 X7,     0
 120 USR,    200     /CURRENT USR CALL ADDRESS
 121                 /LIBRA ASSUMES USR ALWAYS PRESENT
 122 LIBDVH, ODEVH   /ADDRESS OF LIBRARY DEVICE HANDLER
 123 LIBU,   1       /UNIT CONTAINING LIBRARY; INITIALLY SYS:
 124 CATLEN, 0       /LENGTH OF CATALOG
 125 CATBLK, 0       /CURRENT CATALOG BLOCK IN CORE
 126 LAVAIL, 0       /NEXT AVAILABLE LIBRARY BLOCK
 127 LIBNAM, TEXT    "FORLIBRL"
 128         *.-1
 129 INFP,   INF     /CURRENT PLACE IN INPUT FILE LIST
 130 MODU,   0       /UNIT CONTAINING CURRENT MODULE
 131 MODDVH, IDEVH   /INPUT DEVICE HANDLER ADDRESS
 132 MODLEN, 0       /LENGTH OF THIS MODULE
 133 MODBLK, 0       /FIRST BLOCK OF MODULE
 134 INLSW,  0       /NON-ZERO IF IN LIBRARY INPUT
 135 INFST,  0       /FIRST BLOCK OF INPUT FILE
 136 INBLK,  0       /NEXT INPUT BLOCK NUMBER
 137 THSBLK, 0       /READIN CONTROL
 138 FULFLG, 0       /-1 IF CAT FULL
 139 \fENAM1, 0
 140 ENAM2,  0       /HOLDER FOR ESD NAMES
 141 ENAM3,  0
 142         0       /TEXT STOPPER FOR ENAME
 143 ESDCTR, 0
 144 PCAT,   CATBUF  /POINTER TO CURRENT CATALOG BLOCK
 145 INCLUD, -1      /SW FOR NAME INCLUDED IN CATALOG
 146 CHANGD, 1       /0 IF CAT BLOCK MODIFIED
 147 PMOD,   MODBUF  /POINTER TO CURRENT MODULE BLOCK
 148 /
 149 TTFLAG, 0       /NON-ZERO WHEN TTY HAS INITIALIZED
 150 PCHR,   TTO     /OUTPUT ROUTINE
 151 TTPOS,  0       /TTY POSITION COUNTER
 152 CATCNT, 0
 153 IOERR,  0
 154         7421    /ERROR CODE TO MQ
 155         JMP I   .+1
 156         IOMES   /LOG THE ERROR
 157 \f/      LIBRA MAIN CONTROL
 158 /
 159         *177            /MAKES IT EASY TO CALL START
 160 START,  CDF     F0
 161         JMS     TTWAIT  /ALLOW TTY TO COMPLETE
 162         CIF     F1
 163         JMS I   USR
 164         DECODE
 165 TXTRL,  2214            /RL DEFAULT EXT
 166         TAD     (INF    /RESET INPUT FILE POINTER
 167         DCA     INFP
 168         TAD     (TTO    /AND IO DEVICE
 169         DCA     PCHR
 170         DCA     FULFLG
 171         CDF     F1
 172         TAD I   (OUTF1
 173         SNA             /NEW LIBRARY SPECIFIED?
 174         JMP     LASTLB  /NO, USE LAST ONE
 175         DCA     LIBU    /GET LIBRARY UNIT
 176         TAD     (OUTF1
 177         DCA     X0
 178         TAD I   X0
 179         DCA     LIBNAM  /MOVE
 180         TAD I   X0      /IN
 181         DCA     LIBNAM+1 /NEW
 182         TAD I   X0      /NAME
 183         DCA     LIBNAM+2
 184         TAD I   X0
 185         SNA
 186         TAD     TXTRL   /IF NO EXT, FORCE .RL
 187         DCA     LIBNAM+3
 188 LASTLB, TAD     LIBU    /REGET UNIT
 189         AND     (17
 190         TAD     (DCTLW-1        /ADDRESS DEV CTL TABLE
 191         DCA     TMP1
 192         TAD I   TMP1
 193         CDF     F0
 194         SMA CLA         /IS DEVICE FILE-STRUCTURED?
 195         JMP     NOTFS   /NO, BOMB
 196         TAD     (ODEVH!1
 197         DCA     OHADDR  /ALLOW 2-PAGE HANDLER
 198         TAD     LIBU
 199         AND     (17
 200         CIF     F1
 201         JMS I   USR     /GET THE HANDLER
 202         FETCH
 203 OHADDR, ODEVH!1
 204         JMS     IOERR   /YOU'RE KIDDING
 205         TAD     OHADDR  /NOW THE REAL ADDRESS
 206         DCA     LIBDVH
 207         JMP     ZTEST
 208 \fNOTFS, JMS     TTOTXT
 209         FLSTR-1
 210         JMS     CRLF
 211         JMP     START
 212 /
 213 IOMES,  CLA
 214         TAD     (TTO
 215         DCA     PCHR    /ENSURE IT COMES OUT ON TTY
 216         JMS     TTOTXT
 217         IOMSG-1
 218         JMS     CRLF
 219         JMP     START
 220         PAGE
 221 \fZTEST, CDF     F1      /FIND OR CREATE LIB.
 222         TAD I   (SWYTO9 /GET SWITCH WORD
 223         AND     (2000   /TEST FOR /Z
 224         CDF     F0
 225         SZA CLA
 226         JMP     NEWLIB  /YES, ENTER NEW ONE
 227 OLDLIB, JMS     FNDLIB  /LOOKUP THE LIBRARY
 228         LOOKUP
 229         JMP     NEWLIB  /COULDN'T FIND IT
 230 /
 231         TAD     LIBBLK  /FIRST BLOCK OF LIBRARY
 232         DCA     ZCATB
 233         TAD     (CBUFS+MBUFS^200!F1
 234         DCA     ZCATC   /READ ALL YOU CAN
 235         JMS     ZCAT    /DO THE READ
 236         CDF     F1
 237         TAD I   (CATBUF /LOOK AT CONTROL WORD
 238         CLL RAR
 239         SZA CLA         /IS IT A LIBRARY?
 240         JMP     NOTLIB  /NO, ERROR
 241         TAD I   (CATBUF+3
 242         CDF     F0
 243         DCA     CATLEN  /LENGTH IN BLOCKS
 244         TAD     LIBBLK
 245         DCA     LAVAIL  /WILL BE UPDATED DURING SCAN
 246         TAD     LAVAIL
 247         DCA     CATBLK  /CURRENT BLOCK IN BUFFER
 248         TAD     CATLEN
 249         CIA
 250         DCA     TMP2    /COUNTER
 251 CSLOOP, TAD     (CBUFS+MBUFS
 252         TAD     TMP2
 253         SMA             /WILL THE REST FIT IN BUFFER?
 254         JMP     CSLAST  /YES
 255         DCA     TMP2
 256         TAD     (-CBUFS-MBUFS^100
 257         DCA     TMP1    /ENTRIES NOW IN CORE
 258         JMS     SCAT    /SCAN CATALOG
 259         TAD     ZCATB   /NEXT BLOCK WE'LL READ
 260         DCA     CATBLK
 261         JMS     ZCAT    /READ SOME
 262         JMP     CSLOOP
 263 \fCSLAST,        CIA             /NO OF BLOCKS WE DON'T NEED
 264         TAD     (CBUFS+MBUFS
 265         JMS     R6L     /NO OF ENTRIES WE CAN LOOK AT
 266         CIA
 267         DCA     TMP1
 268         JMS     SCAT    /LOOK FOR END
 269 FULCAT, JMS     TTOTXT  /RAN OFF THE END
 270         CATFUL-1
 271         JMS     CRLF    /**
 272         JMP     LCLOSE
 273 /
 274 SCAT,   0
 275         TAD     (CATBUF-1
 276         DCA     X0
 277 SCLOOP, CDF     F1
 278         TAD I   X0
 279         CMA             /TEST FOR END
 280         SNA CLA
 281         JMP     GETINF  /THAT'S IT
 282         ISZ     X0
 283         ISZ     X0      /IGNORE REST OF NAME
 284         TAD I   X0      /GET LENGTH
 285         TAD     LAVAIL  /ADD TO ST BLOCK OF FREE AREA
 286         DCA     LAVAIL
 287         ISZ     TMP1
 288         JMP     SCLOOP
 289         CDF     F0
 290         JMP I   SCAT    /GO FOR NEXT BUFFER LOAD
 291 /
 292 NOTLIB, JMS     PRLBNM  /PRINT LIBRARY NAME
 293         JMS     TTOTXT
 294         UNLIB-1
 295         JMS     CRLF
 296         JMP     START
 297         PAGE
 298 \fNEWLIB,        JMS     FNDLIB
 299         ENTER
 300         JMS     IOERR
 301         TAD     LIBU
 302         AND     (7760
 303         CLL RTR
 304         RTR
 305         SNA             /DID HE GIVE A LENGTH?
 306         STL RTL         /NO, USE 2
 307         DCA     CATLEN
 308         CDF     F1
 309         TAD I   (EQLO   /HOW MANY EXTRA BLOCKS WANTED
 310         CDF     F0
 311         TAD     CATLEN  /PLUS CATALOG REQUIREMENT
 312         CLL
 313         TAD     LIBLEN  /MINUS AVAILABLE LENGTH
 314         SZL CLA         /CHECK FOR ENUF ROOM
 315         JMP     LSZERR  /NO ROOM, GIVE MESSAGE
 316 /
 317 /       WRITE EMPTY CATALOG
 318 /
 319         TAD     (CATBUF-1
 320         DCA     X0
 321         TAD     (-MBUFS-CBUFS^400
 322         DCA     TMP1
 323         CDF     F1
 324         DCA I   X0
 325         ISZ     TMP1
 326         JMP     .-2
 327         TAD     (CATBUF-1       /RESET FOR LATER USE
 328         DCA     X0
 329         CLA CMA
 330         TAD     CATLEN
 331         SPA SNA         /MORE THAN ONE?
 332         JMP     CATB0   /JUST ONE
 333         CIA
 334         ISZ     ZCATB   /START WITH SECOND CAT BLOCK
 335 ZCLOOP, CLL
 336         TAD     (MBUFS+CBUFS
 337         DCA     TMP1
 338         SZL             /FULL WRITE?
 339         TAD     TMP1    /NO
 340         CIA
 341         TAD     (MBUFS+CBUFS
 342         JMS     R6R
 343         TAD     (4000!F1
 344         DCA     ZCATC   /SET CONTROL
 345         JMS     ZCAT
 346         TAD     TMP1
 347         SPA
 348         JMP     ZCLOOP  /MORE TO GO
 349 CATB0,  CDF     F1
 350         CLA IAC         /1 IS LIBRARY CODE
 351         DCA I   X0
 352         TAD     (VERS
 353         DCA I   X0      /MARK LIBRA VERSION #
 354         TAD     LIBLEN  /JUST A GUESS
 355         CIA
 356         DCA I   X0
 357         TAD     CATLEN
 358         DCA I   X0
 359         CLA CMA         /END OF CAT INDICATOR
 360         DCA I   X0      /MARKS FIRST AVAIL SLOT
 361         CDF     F0
 362         DCA     CHANGD  /FORCE A WRITE ON THIS ONE
 363         TAD     ZCATB
 364         DCA     LAVAIL
 365         TAD     LIBBLK  /LIBRARY START BLOCK
 366         DCA     CATBLK  /IS CURRENTLY IN BUFFER
 367         JMP     GETINF  /BEGIN
 368 /
 369 ZCAT,   0
 370         CDF     F0
 371         JMS     CCHK    /LOOKOUT FOR CONTROL C
 372         JMS I   LIBDVH
 373 ZCATC,  F1
 374         CATBUF
 375 ZCATB,  0
 376         JMS     IOERR
 377         TAD     ZCATC
 378         JMS     R6L
 379         AND     (17
 380         TAD     ZCATB
 381         DCA     ZCATB
 382         ISZ     CHANGD  /SET UNMODIFIED SW
 383         JMP I   ZCAT
 384         JMP     .-2
 385 /
 386 FNDLIB, 0
 387         TAD I   FNDLIB
 388         DCA     USRCOD
 389         ISZ     FNDLIB
 390         TAD     (LIBNAM
 391         DCA     LIBBLK
 392         TAD     LIBU
 393         AND     (17
 394         CIF     F1
 395         JMS I   USR
 396 USRCOD, 0
 397 LIBBLK, LIBNAM
 398 LIBLEN, 0               /NEG, REMEMBER
 399         JMP I   FNDLIB  /COULD'T DO IT
 400         TAD     LIBBLK  /FIRST BLOCK
 401         DCA     ZCATB   /OF CATALOG
 402         ISZ     FNDLIB
 403         JMP I   FNDLIB
 404 LSZERR, JMS     TTOTXT
 405         SMALL-1
 406         JMS     CRLF
 407         JMP     START   /GO FOR MORE
 408         PAGE
 409 \f/
 410 /       SETUP POINTERS AND THINGS FOR NEXT INPUT MODULE
 411 /
 412 GETINF, CLA CMA
 413         DCA     INCLUD  /SET NO-NAME-INCLUDED SW
 414         TAD     INLSW   /ARE WE GETTING INPUT FROM A LIBR?
 415         SZA CLA
 416         JMP     INLIB   /YES-GET NEXT MODULE THEREIN
 417 NXTINF, CDF     F1
 418         TAD I   INFP    /UNIT AND LEN OF NEXT IN FILE
 419         SZA             /IS THERE ONE?
 420         JMP     FTCHIN  /YES
 421         TAD I   (SWATOL
 422         AND     (1000   /TEST FOR /C
 423         CDF     F0
 424         SNA CLA
 425         JMP     LCLOSE  /NO MORE
 426         JMS     SAVRES  /PRESERVE DEV HANDLER RESIDENCY
 427         JMS     TTWAIT  /FINISH ANY TYPING
 428         CIF     F1
 429         JMS I   USR     /NEW LINE CONTINUES OLD
 430         DECODE
 431         2214            /RL DEFAULT EXT
 432         0               /DO NOT DELETE TENTATIVE FILES
 433         JMS     RSTRES  /RESTORE RESIDENCY TABLE
 434         TAD     (INF
 435         DCA     INFP    /RESET INPUT FILE POINTER
 436         JMP     NXTINF  /TRY AGAIN
 437 \fFTCHIN, DCA     MODU    /UNIT CONTAINING INPUT MOD
 438         ISZ     INFP
 439         TAD I   INFP
 440         DCA     INFST   /START OF INPUT FILE
 441         ISZ     INFP
 442         TAD     INFST
 443         DCA     MODBLK  /IN THIS CASE, FILE=MODULE
 444         TAD     MODU
 445         AND     (7760
 446         CIA
 447         CLL RTR
 448         RTR
 449         DCA     MODLEN
 450         TAD     (IDEVH!1
 451         DCA     INDVH   /TENTATIVE HANDLER ADDR
 452         CDF     F0
 453         TAD     MODU
 454         AND     (17
 455         CIF     F1
 456         JMS I   USR
 457         FETCH
 458 INDVH,  IDEVH!1         /TENTATIVE INPUT HANDLER ADDR
 459         JMS     IOERR   /DON'T GIVE ME THAT
 460         TAD     INDVH
 461         DCA     MODDVH  /DEVICE HANDLER ADDRESS
 462         DCA     THSBLK  /FORCE READIN TO READ
 463 LUKMOD, TAD     MODBLK  /FIRST BLOCK OF MODULE
 464         DCA     INBLK   /INITIALIZE READIN
 465         JMS     READIN  /GET FIRST BLOCK
 466         CDF     F1
 467         CLA CMA         /-1
 468         TAD I   PMOD    /LOOK AT IDENTIFIER
 469         CDF     F0
 470         SNA
 471         JMP     GOTLIB  /ITS A LIBRARY
 472         CLL RTR
 473         SZA CLA         /IS IT A MODULE
 474         JMP     BADINF  /BAD INPUT
 475         TAD     LIBBLK  /MAKE SURE
 476         CIA
 477         TAD     LIBLEN  /THAT MODULE
 478         TAD     LAVAIL  /FITS IN LIBRARY
 479         CLL
 480         SNA             /CHECK FOR TOO LONG HERE TOO**
 481         JMP     OVFLO   /IT IS TOO LONG
 482         TAD     MODLEN
 483         SNL CLA
 484         JMP     NXTEBK  /GO GETTUM
 485 OVFLO,  JMS     TTOTXT
 486         TOOBIG-1
 487         JMS     CRLF
 488         JMP     GETINF
 489 \fBADINF,        JMS     TTOTXT
 490         NOTMOD-1
 491         JMS     CRLF
 492         JMP     GETINF
 493 /
 494 GOTLIB, TAD     MODLEN
 495         SNA CLA
 496         JMP     LB2BIG          /CAN'T DO A LOOKUP IF G. T. 255
 497         ISZ     INLSW   /SET IN-LIBRARY SWITCH
 498         JMP     INLIB
 499 LB2BIG, JMS     TTOTXT
 500         L2BMSG-1
 501         JMS     CRLF
 502         JMP     START
 503         PAGE
 504 \f/      GET NEXT MODULE FROM LIBRARY
 505 /
 506 INLIB,  TAD     INFST   /START OF INPUT FILE
 507         DCA     INBLK   /IS WHAT WE WANT
 508         JMS     READIN  /BRING CATALOG INTO MODULE BUFFER
 509         TAD     (3
 510         TAD     PMOD
 511         DCA     TMP1
 512         CDF     F1
 513         TAD I   TMP1    /GET CATALOG LEN
 514         CIA
 515         DCA     TMP1    /HOLD COUNTER IN CASE OF FULL CATALOG
 516         TAD     INFST
 517         DCA     INBLK   /WE WANT THE SAME ONE AGAIN
 518         TAD     INFST
 519         DCA     TMP3    /INIT ACCUMULATED MODULE START BLOCK
 520         DCA     MODLEN  /INITAIL MOD LEN IS ZERO
 521 INLSC1, JMS     READIN  /GET CATALOG BLOCK
 522         TAD     (-100
 523         DCA     TMP2    /COUNT ENTRIES IN CAT BLOCK
 524 INLSC2, CDF     F1
 525         TAD I   PMOD    /LOOK FOR END-OF-CATALOG WORD
 526         CMA
 527         SNA CLA
 528         JMP     NDLSC   /END OF SCAN
 529         TAD     (3
 530         TAD     PMOD    /POINT TO LENGTH
 531         DCA     TMP5
 532         TAD I   TMP5
 533         SNA CLA         /FIRST ENTRY FOR A MODULE?
 534         JMP     NOLEN   /NO, DO NOT UPDATE
 535         TAD     MODLEN
 536         TAD     TMP3    /UPDATE MODULE STARTING BLOCK
 537         DCA     TMP3
 538         TAD I   TMP5    /GET THIS LENGTH
 539         DCA     MODLEN  /FOR THIS MODULE
 540 NOLEN,  TAD     MODBLK  /COMPARE LAST MODULE STARTING BLOCK
 541         CMA CLL
 542         TAD     TMP3    /TO ACCUMULATED START BLOCK
 543         SNL CLA         /INTERESTING?
 544         JMP     NOTYET  /NO
 545         TAD I   PMOD    /YES; WAS NAME DELETED?
 546         SZA CLA
 547         JMP     GLMOD   /NO, WE'VE GOT A GOOD MODULE
 548 NOTYET, TAD     (4
 549         TAD     PMOD    /POINT TO NEXT NAME
 550         DCA     PMOD
 551         ISZ     TMP2    /END OF CAT BLOCK?
 552         JMP     INLSC2  /NO
 553         ISZ     TMP1    /YES; END OF CATALOG?
 554         JMP     INLSC1  /NO, GET NEW BLOCK
 555 NDLSC,  DCA     INLSW   /YES, NO LONGER IN A LIBRARY
 556         JMP     NXTINF  /GET ANOTHER FILE
 557 \fGLMOD, TAD     TMP3    /GET STARTING BLOCK
 558         DCA     MODBLK  /OF MODULE
 559         JMP     LUKMOD  /AND GO GET THE MODULE
 560 L2BMSG, TEXT    "INPUT LIBRARY TOO BIG";0
 561         PAGE
 562 \f/       PROCESS LOOP FOR ONE MODULE
 563 /
 564 NXTEBK, TAD     (3
 565         TAD     PMOD    /ADDR OF FIRST ESD-1
 566         DCA     X0      /RESET POINTER TO NAMES
 567         TAD     (-52    /PER BLOCK COUNT
 568         DCA     ESDCTR
 569 ESDLUP, CDF     F1
 570         TAD I   X0
 571         DCA     ENAM1
 572         TAD I   X0
 573         DCA     ENAM2
 574         TAD I   X0
 575         DCA     ENAM3
 576         TAD I   X0      /TYPE CODE
 577         CDF     F0
 578         TAD     (ESDTAB /DISPATCH FROM TBL
 579         DCA     TMP1
 580         JMP I   TMP1
 581 ESDTAB, JMP     ESDEND  /0=END OF ESD TABLE
 582         JMP     DUPLUK  /1=ENTRY=LOOK FOR
 583                         /DUPLICATE NAME
 584         JMP     ESDLND  /2=EXTERN=IGNORE NAME
 585         JMP     ESDLND  /3=FORT COMMON=IGNORE
 586         JMP     DUPLUK  /4=PROG SECTION
 587         HLT             /5=MUL ENTRY=DOESN'T
 588                         /EXIST
 589         HLT             /6=MUL SECTION=DITTO
 590         JMP     DUPLUK  /7=SECT8
 591         JMP     ESDLND  /10=COMMZ
 592         JMP     DUPLUK  /11=FIELD1
 593 \f/
 594 /       LOOK FOR DUPLICATION OF THIS ESD SYMBOL
 595 /
 596 DUPLUK, TAD     CATLEN
 597         CIA
 598         DCA     TMP1    /COUNT LENGTH OF CAT
 599         TAD     CATBLK
 600         CIA
 601         TAD     LIBBLK  /ARE WE AT FIRST BLOCK?
 602         SZA CLA
 603         JMS     CHGCHK  /CHECK FOR BLOCK MODIFIED
 604         TAD     LIBBLK
 605         DCA     NXTCAT  /SETUP FOR FIRST BLOCK OF CAT
 606         TAD CATLEN
 607         CIA
 608         DCA CATCNT
 609 GETCB,  JMS     GCATB   /GET IT
 610         TAD     (CATBUF-1
 611         DCA     X1
 612         TAD     (-100   /COUNT ENTRIES/BLOCK
 613         DCA     TMP2
 614         CDF     F1
 615 CBSRCH, TAD I   X1      /LOOK AT NAME
 616         CMA
 617         SNA
 618         JMP     CHKI    /END OF CATALOG-LOOK FOR /I
 619         IAC             /COMPLETE THE CIA
 620         TAD     ENAM1   /COMPARE
 621         SZA CLA
 622         JMP     NOMTCH
 623         TAD I   X1
 624         CIA
 625         TAD     ENAM2
 626         SZA CLA
 627         JMP     NOMTCH
 628         TAD I   X1      /LAST CHANCE
 629         CIA
 630         TAD     ENAM3
 631         SNA CLA
 632         JMP     GOTMAT  /EQUAL!
 633 NOMTCH, TAD     X1
 634         AND     (-4
 635         TAD     (3      /BUMP TO NEXT
 636         DCA     X1
 637         ISZ     TMP2
 638         JMP     CBSRCH
 639         JMS     CHGCHK  /CHECK FOR MODIFIED BLOCK
 640         ISZ     TMP1    /END OF CATALOG?
 641         JMP     GETCB   /NO, GET NEXT
 642         JMS     TTOTXT
 643         CATFUL-1
 644         JMS     CRLF
 645         CLA CMA
 646         DCA     FULFLG
 647         JMP     ESDEND  /PUT THAT, IF POSSIBLE
 648 \fGOTMAT,        CDF     F0
 649         JMS     TTOTXT
 650         ENAM1-1         /PRINT THE NAME
 651         JMS     TTOTXT
 652         NDUP-1          /WHICH TO KEEP?
 653         CDF     F1
 654         TAD I   (SWATOL
 655         CDF     F0
 656         AND     (10     /TEST /I
 657         SNA CLA
 658         JMP     CHKR    /NO, LOOK FOR /R
 659 GMASK,  JMS     TTOTXT
 660         KEEP-1
 661         JMS     WAITOP
 662         JMP     ESDLND  /DEFAULT TO THE OLD ONE
 663         TAD     (-"O
 664         SNA
 665         JMP     ESDLND  /KEEP OLD
 666         IAC             /IS IT "N"?
 667         SZA CLA
 668         JMP     GMASK   /TRY AGAIN
 669         JMP     DELTO   /DELETE THE OLD
 670         PAGE
 671 \fCHKR,   JMS     CRLF
 672         CDF     F1
 673         TAD I   (SWMTOX
 674         AND     (100    /TEST /R
 675         SNA CLA
 676         JMP     ESDLND  /DEFAULT:KEEP THE OLD ONE
 677 DELTO,  CDF     F1
 678         TAD     X1
 679         AND     (-4
 680         CIA
 681         CMA             /BACK UP POINTER
 682         DCA     X1
 683         DCA I   X1      /CLEAR
 684         DCA I   X1      /OLD
 685         DCA I   X1      /NAME
 686         ISZ     X1      /SKIP OVER LENGTH
 687         DCA     CHANGD  /BLOCK HAS BEEN MODIFIED
 688         JMP     NXTE    /ENTER AT END OF LOOP
 689 NDSCN,  CDF     F1
 690         TAD I   X1      /LOOK AT NEXT
 691         CMA
 692         SNA CLA
 693         JMP     ENDCAT  /NOW WE'RE THERE
 694         TAD     X1
 695         TAD     (3      /BUMP TO NEXT NAME
 696         DCA     X1
 697 NXTE,   ISZ     TMP2
 698         JMP     NDSCN
 699         JMS     CHGCHK  /LOOK OUT FOR CHANGES
 700         ISZ CATCNT      /END OF CAT ?
 701         SKP
 702         JMP FULCAT      /NO MORE PUSSY
 703         JMS     GCATB
 704         TAD     (CATBUF-1
 705         DCA     X1
 706         TAD     (-100
 707         DCA     TMP2
 708         JMP     NDSCN
 709 \fCHKI,  TAD I   (SWATOL /LOOK AT /I SW
 710         AND     (10
 711         SNA CLA
 712         JMP     ENDCAT  /NOT SET
 713         JMS     TTOTXT
 714         ENAM1-1         /TYPE ESD NAME
 715         JMS     TTOTXT
 716         NCLUD-1         /INCLUDE IT?
 717 IANS,   JMS     WAITOP
 718         JMP     ENDCAT  /DEFAULT TO INCLUDE
 719         TAD     (-"Y
 720         SNA
 721         JMP     ENDCAT  /YES, INCLUDE
 722         TAD     ("Y-"N
 723         SZA CLA         /IS IT "N"?
 724         JMP     IANS    /NO, TRY AGAIN
 725         JMP     ESDLND
 726 ENDCAT, TAD     X1      /POINT TO EMPTY SLOT
 727         AND     (-4
 728         CIA
 729         CMA
 730         DCA     X1
 731         JMP     INSERT
 732         PAGE
 733 \f/      THIS ESD GOES IN THE CATALOG
 734 /
 735 INSERT, CDF     F1
 736         TAD     ENAM1   /MOVE
 737         DCA I   X1      /NAME
 738         TAD     ENAM2   /TO
 739         DCA I   X1      /LIBRARY
 740         TAD     ENAM3   /CATALOG
 741         DCA I   X1
 742         ISZ     INCLUD  /IS THIS THE FIRST?
 743         SKP
 744         TAD     MODLEN  /YES, GET THE LENGTH
 745         DCA I   X1      /AND STORE 4TH WORD
 746         DCA     CHANGD  /SET CAT MODIFIED SW
 747         CLA IAC
 748         TAD     X1      /CHECK FOR END OF BLOCK
 749         AND     (377
 750         SZA CLA
 751         JMP     MARKND  /NO, MARK END OF CAT
 752         JMS     CHGCHK  /WRITE THIS BLOCK
 753         CDF     F1
 754         TAD     (-400
 755         DCA     TMP1    /SET COUNT FOR BLOCK LEN
 756         TAD     (CATBUF-1
 757         DCA     X1      /SET POINTER
 758         CLA CMA
 759         DCA I   X1
 760         ISZ     TMP1
 761         JMP     .-2     /CLEAR THE BLOCK
 762         DCA     CHANGD
 763         ISZ     CATBLK
 764         JMP     ESDLND
 765 MARKND, CLA CMA
 766         DCA I   X1      /MARK NEW END OF CAT
 767 ESDLND, CDF     F0
 768         CLA STL RTL     /TWO TO SKIP VALUE
 769         TAD     X0
 770         DCA     X0
 771         ISZ     ESDCTR  /DONE WITH BLOCK?
 772         JMP     ESDLUP  /NO, GET NEXT
 773         JMS     READIN  /GET NEXT BLOK
 774         JMP     NXTEBK  /RESET POINTERS AND CONTINUE
 775 ESDEND, ISZ     INCLUD  /CHECK FOR ANY NAMES OUT
 776         JMP     CPYMOD  /YES, COPY MODULE INTO LIBRARY
 777         JMS     TTOTXT  /SORRY, DIDN'T MAKE IT
 778         NONEIN-1
 779         JMS     CRLF
 780         ISZ     FULFLG
 781         JMP     GETINF  /TRY NEXT
 782         JMP     LCLOSE
 783 \fCPYMOD,        TAD     MODBLK  /GET IN FILE STRT BLOCK
 784         DCA     INBLK
 785         TAD     MODLEN
 786         CIA
 787         DCA     TMP1
 788         TAD     LAVAIL  /FIRST AVAILABLE BLOCK
 789         DCA     NXTOBK
 790 CPYLUP, JMS     READIN  /READ BLOCK OF INPUT
 791         TAD     PMOD
 792         DCA     PNXTOB
 793         JMS I   LIBDVH  /CALL OUTPUT HANDLER
 794         4200!F1
 795 PNXTOB, MODBUF
 796 NXTOBK, 0               /NEXT OUTPUT BLOCK NUMBER
 797         JMS     IOERR
 798         ISZ     NXTOBK  /BUMP BLOCK NUMBER
 799         ISZ     TMP1    /CHECK LENGH
 800         JMP     CPYLUP
 801         TAD     NXTOBK
 802         DCA     LAVAIL  /UPDATE AVAILABLE POINTER
 803         JMP     GETINF  /GO FOR NEXT
 804         PAGE
 805 \fCHGCHK,        0
 806         CDF     F0      /PRECAUTION
 807         TAD     CHANGD  /HAS BLOCK BEEN MODIFIED?
 808         SZA CLA
 809         JMP I   CHGCHK  /NO, NOTHING TO DO
 810         TAD     CATBLK
 811         DCA     ZCATB   /WRITE THE BLOCK
 812         TAD     (4200!F1
 813         DCA     ZCATC
 814         JMS     ZCAT
 815         JMP I   CHGCHK  /OK
 816 /
 817 /
 818 GCATB,  0
 819         CDF     F0
 820         TAD     NXTCAT
 821         CIA
 822         TAD     CATBLK  /IS IT IN CORE?
 823         SNA CLA
 824         JMP     SOEZ    /YES, ITS EZ
 825         TAD     NXTCAT
 826         CIA
 827         TAD     LIBBLK
 828         TAD     CATLEN
 829         SPA SNA CLA     /CHECK FOR INTERNAL ERROR
 830         JMP     FULCAT  /**
 831         TAD     NXTCAT
 832         DCA     ZCATB
 833         TAD     (200!F1 /SET FOR READ
 834         DCA     ZCATC
 835         JMS     ZCAT
 836         TAD     NXTCAT  /NEXT BLOCK
 837         DCA     CATBLK  /IS IN CORE
 838 SOEZ,   ISZ     NXTCAT
 839         JMP I   GCATB
 840 NXTCAT, 0
 841         PAGE
 842 \fLCLOSE,        JMS     CHGCHK
 843         TAD     USRCOD
 844         TAD     (-ENTER /DID WE ENTER A NEW FILE?
 845         SZA CLA
 846         JMP     CATLST  /NO, GO LIST CATALOG
 847         TAD     LIBBLK  /GET LEN
 848         CIA
 849         CDF     F1
 850         TAD I   (EQLO   /GET USER EXTENSION REQUEST
 851         CDF     F0
 852         TAD     LAVAIL  /PLUS CURRENT END
 853         DCA     TMP1
 854         TAD     TMP1
 855         CLL
 856         TAD     LIBLEN  /CHECK FOR POSSIBLE
 857         SNL CLA
 858         JMP     .+4
 859         TAD     LIBLEN  /CAN'T GIVE ALL HE WANTS
 860         CIA
 861         SKP
 862         TAD     TMP1
 863         DCA     LCLEN   /SET CLOSE LENGTH
 864         TAD     CATLEN
 865         CMA
 866         TAD     LCLEN   /COMPARE CAT LEN TO LIB LEN
 867         SPA SNA CLA
 868         JMP     NOLIB   /THERE'S NO POINT
 869         TAD     LIBBLK  /GET FIRST BLOCK
 870         DCA     NXTCAT
 871         JMS     GCATB
 872         CDF     F1
 873         TAD     LCLEN   /ACTUAL LIBRARY LENGTH
 874         DCA I   (CATBUF+2
 875         CDF     F0
 876         DCA     CHANGD
 877         JMS     CHGCHK  /WRITE IT
 878         TAD     LIBU
 879         AND     (17
 880         CIF     F1
 881         JMS I   USR
 882         CLOSE
 883         LIBNAM
 884 LCLEN,  0
 885         JMS     IOERR
 886         JMP     CATLST  /GO LIST THE CATALOG
 887 /
 888 NOLIB,  JMS     TTOTXT
 889         WHYCLS-1
 890         JMS     CRLF
 891         JMP     START
 892         PAGE
 893 \f/      LIST THE CATALOG
 894 /
 895 CATLST, JMS     OOPEN   /OPEN LISTING FILE
 896         JMP     START   /NONE DESIRED
 897         TAD     (OCHAR  /SETUP FOR DEVICE-INDEPENDENT
 898         DCA     PCHR    /OUTPUT
 899         TAD     (214    /AT TOP OF PAGE
 900         JMS I   PCHR
 901         JMS     CRLF
 902         JMS TTOTXT
 903         LBV-1
 904         JMS     TTOTXT
 905         CATOF-1
 906         JMS     PRLBNM  /PRINT THE NAME
 907         CDF     F1
 908         TAD I   (SYSDAT
 909         CDF     F0
 910         SNA
 911         JMP     NODATE  /DON'T KNOW THE DATE
 912         DCA     TMP1
 913         JMS     TTOTXT
 914         ON-1
 915         CLA                     /THE FOLLOWING CODE GETS THE DAY
 916         DCA     TMP2
 917         TAD     TMP1            /GET THE DATE
 918         RTR                     /ROTATE THREE RIGHT AND MASK
 919         RAR                     /TO GET THE DAY IN OCTAL
 920         AND     (37
 921         JMS     MAK8BT          /MAKE IT 8-BIT AND PRINT
 922         DCA     TMP2
 923         TAD     TMP1            /GET THE DATE BACK
 924         AND     (7400           /MASK TO GET THE MONTH BITS
 925         JMS     R6R             /MONTH*4 (IN OCTAL)
 926         DCA     TMP2            /PUT IN TEMP. VARIABLE TO SAVE IT
 927         TAD     TMP2            /GET IT BACK
 928 \f       RTR                     /MONTH
 929         TAD     TMP2
 930         TAD     (MONTHS-6
 931         DCA     .+2             /ADDRESS OF MONTH FROM TABLE
 932         JMS     TTOTXT          /PUT IT IN THE TEXT LINE
 933         0
 934         TAD     TMP1            /GET THE DATE---TO FIND THE YEAR
 935         AND     (7              /MASK TO GET THE YEAR OFFSET BITS
 936         DCA     TMP4            /SAVE THEM
 937         DCA     TMP2
 938         TAD I   (7777           /GET THE DATE EXTENSION BITS
 939         AND     (600
 940         CLL RTR                 /ROTATE TO GET THEM INTO BIT
 941         RTR                     /POSITIONS 7 AND 8
 942         TAD     (106            /ADD 70(ORIGINAL BASE YEAR)
 943         TAD     TMP4            /ADD IN THE YEAR OFFSET BITS
 944         JMS     MAK8BT          /MAKE 8-BIT AND PRINT
 945 NODATE, JMS     CRLF
 946         JMP     PRCAT   /TITLE IS DONE, PRINT CAT
 947 MAK8BT, 0                       /ROUTINE TO CONVERT TO 8-BIT AND PRINT
 948         CLL                     /FIRST CONVERT TO DECIMAL
 949 CONVYR, TAD     (-12            /KEEP SUBTRACTING 12
 950         SPA                     /HAVE THE YEAR
 951         JMP     GETDG1
 952         ISZ     TMP2            /HOLDS THE FIRST DIGIT OF YEAR
 953         JMP     CONVYR
 954 GETDG1, TAD     (12             /GET THE SECOND DIGIT
 955         DCA     TMP3            /SAVE IT
 956         TAD     TMP2            /GET THE FIRST DIGIT
 957         SNA                     /FIRST DIGIT IS A ZERO
 958         JMP     PRDIG2          /PRINT THE SECOND DIGIT
 959         TAD     (260            /MAKE FIRST DIGIT OF YEAR 8-BIT
 960         JMS I   PCHR            /PRINT IT
 961 PRDIG2, TAD     TMP3            /GET THE SECOND DIGIT
 962         TAD     (260            /MAKE SECOND DIGIT OF YEAR 8-BIT
 963         JMS I   PCHR            /PRINT IT
 964         JMP I   MAK8BT          /RETURN
 965         PAGE
 966 \f/      LIST ALL ENTRIES IN THE CATALOG
 967 /
 968 PRCAT,  TAD     CATLEN
 969         CIA
 970         DCA     TMP1
 971         TAD     LIBBLK
 972         DCA     NXTCAT
 973         CLA CMA
 974         DCA     TMP3    /SET LINE COUNTER
 975 CATLUP, JMS     GCATB
 976         TAD     (CATBUF-1
 977         DCA     X0
 978         TAD     (-100
 979         DCA     TMP2
 980 CATLP2, CDF     F1
 981         TAD I   X0      /GET FIRST WORD OF NAME
 982         SNA
 983         JMP     EMPTY   /NOT AN ESD NAME
 984         CMA
 985         SNA
 986         JMP     NDCATL  /END OF CATALOG
 987         CMA             /RESTORE FIRST WORD
 988         JMS     TTO2    /PRINT
 989         JMP     NDNAM   /A SHORT NAME
 990         CDF     F1
 991         TAD I   X0
 992         JMS     TTO2
 993         JMP     NDNAM
 994         CDF     F1
 995         TAD I   X0
 996         JMS     TTO2
 997         NOP
 998 NDNAM,  ISZ     TMP3    /MORE ROOM ON THIS LINE?
 999         JMP     SAMLIN  /SURE
1000         JMS     CRLF
1001         TAD     (-10    /SETUP FOR 8 PER LINE
1002         DCA     TMP3
1003         JMP     EMPTY
1004 SAMLIN, JMS     TAB     /SPACE OVER TO NEXT NAME
1005 EMPTY,  TAD     X0
1006         AND     (-4
1007         TAD     (3
1008         DCA     X0      /POINT TO NEXT
1009         ISZ     TMP2
1010         JMP     CATLP2  /GO FOR NEXT
1011         ISZ     TMP1    /MORE BLOCKS?
1012         JMP     CATLUP  /YES
1013         JMS     CRLF
1014         JMS     TTOTXT
1015         CATFUL-1
1016 NDCATL, JMS     CRLF
1017         TAD     (214    /EJECT PAGE
1018         JMS I   PCHR
1019         JMS     OCLOSE  /CLOSE THE FILE
1020         JMP     START
1021         PAGE
1022 \f/      USEFUL OUTPUT THINGS
1023 /
1024 TTO,    0
1025         DCA     TTOCHR
1026         JMS     TTWAIT
1027         TAD     (200
1028         KRS
1029         TAD     (-217   /CRTL/O CHECK
1030         SNA CLA
1031         KSF
1032         SKP
1033         JMP I   TTO
1034         TAD     TTOCHR
1035         TLS
1036         DCA     TTFLAG
1037         JMP I   TTO
1038 TTOCHR, 0
1039 TTWAIT, 0
1040         TAD     TTFLAG
1041         SNA CLA
1042         JMP I   TTWAIT
1043         JMS     CCHK    /BEWARE OF CTRL/C
1044         TSF
1045         JMP     .-2     /WAIT TILL DONE
1046         DCA     TTFLAG  /CLEAR BUSY FLAG
1047         JMP I   TTWAIT
1048 CCHK,   0
1049         KSF
1050         JMP I   CCHK    /NOTHING TO WORRY ABOUT
1051         TAD     (200
1052         KRS
1053         TAD     (-203
1054         SNA CLA         /WAS IT CONTROL C?
1055         JMP I   (7600   /YES
1056         JMP I   CCHK
1057 TTO2,   0
1058         DCA     TMP7
1059         TAD     TMP7
1060         JMS     R6R
1061         JMS     TTO2A
1062         TAD     TMP7
1063         JMS     TTO2A
1064         ISZ     TTO2
1065         JMP I   TTO2
1066 TTO2A,  0
1067         AND     (77
1068         SNA
1069         JMP I   TTO2
1070         TAD     (-40
1071         SPA
1072         TAD     (100
1073         TAD     (240
1074         JMS I   PCHR
1075         ISZ     TTPOS   /BUMP POSITION COUNT
1076         JMP I   TTO2A
1077 \fR6R,   0
1078         CLL RTR
1079         RTR
1080         RTR
1081         JMP I   R6R
1082 R6L,    0
1083         CLL RTL
1084         RTL
1085         RTL
1086         JMP I   R6L
1087 TTOTXT, 0
1088         CDF     F0
1089         TAD I   TTOTXT
1090         DCA     X7
1091         ISZ     TTOTXT  /BUMP PAST POINTER
1092         TAD I   X7
1093         JMS     TTO2
1094         JMP I   TTOTXT
1095         JMP     .-3
1096 CRLF,   0
1097         DCA     TTPOS   /RESET POSITION
1098         TAD     (215
1099         JMS I   PCHR
1100         TAD     (212
1101         JMS I   PCHR
1102         JMP I   CRLF
1103 TAB,    0               /PSEUDO-TAB GENERATOR
1104         TAD     (240
1105         JMS I   PCHR
1106         ISZ     TTPOS
1107         TAD     TTPOS
1108         AND     (7
1109         SNA CLA         /IS POSITION A MULTIPLE OF 8
1110         JMP I   TAB
1111         JMP     TAB+1   /NO, TRY MORE
1112         PAGE
1113 \fWAITOP,        0
1114         TAD     (277    /QUESTION
1115         JMS     TTO
1116         DCA     RETCHR
1117 WREP,   JMS     TTI     /WAIT FOR REPLY
1118         TAD     (-215
1119         SNA
1120         JMP     DFALT
1121         TAD     (215-240        /PRINTING?
1122         SPA
1123         JMP     WREP    /NO, TRY AGIAN
1124         TAD     (240
1125         DCA     RETCHR
1126         TAD     RETCHR
1127 ECHO,   JMS     TTO
1128         JMS     TTI
1129         TAD     (-215
1130         SNA
1131         JMP     GOTREP
1132         TAD     (215-377        /LOOKOUT FOR RUBOUT!
1133         SNA
1134         JMP     RUBOUT
1135         TAD     (377
1136         JMP     ECHO
1137 RUBOUT, JMS     CRLF
1138         JMP     WAITOP+1
1139 GOTREP, ISZ     WAITOP  /GOT A REAL ANSWER
1140 DFALT,  JMS     CRLF
1141         TAD     RETCHR
1142         JMP I   WAITOP
1143 RETCHR, 0
1144 /
1145 TTI,    0
1146         KSF             /WAIT FOR A KEY
1147         JMP     .-1
1148         KRB
1149         AND     (177    /TAKE CARE OF PARITY
1150         TAD     (-3     /CTRL C?
1151         SNA
1152         JMP I   (7600   /YES
1153         TAD     (203    /GET ORGINIAL CHAR BACK
1154         JMP I   TTI
1155 PAGE
1156 \f/
1157 /       INPUT BUFFERRER AND STUFF
1158 /
1159 READIN, 0
1160         CDF     F0
1161         TAD     INBLK
1162         TAD     THSBLK  /-FIRST BLOCK FOLLOWING BUFFER CONTENTS
1163         CLL
1164         TAD     (MBUFS
1165         SNL             /IS IT IN CORE?
1166         JMP     MUSTRD  /NO, WE HAVE TO DO A READ
1167         CLL RTR
1168         RTR
1169         RAR             /TIMES 400
1170 SETP,   TAD     (MODBUF /PLUSS BUFFER ADDR
1171         DCA     PMOD    /POINTS TO BLOCK
1172         ISZ     INBLK   /READY FOR NEXT
1173         JMP I   READIN
1174 MUSTRD, CLA             /THIS ONE'S HARDER
1175         TAD     INBLK
1176         DCA     RDBLK
1177         TAD     INBLK
1178         TAD     (MBUFS
1179         CIA
1180         DCA     THSBLK
1181         JMS I   MODDVH
1182         MBUFS^200!F1
1183         MODBUF
1184 RDBLK,  0
1185         JMS     IOERR
1186         JMP     SETP    /OK
1187 \f/      ROUTINES TO SAVE AND RESTORE
1188 /       DEVICE HANDLER RESIDENCY TABLE
1189 /
1190 SAVRES, 0
1191         TAD     (DHRES-1
1192         DCA     X0
1193         TAD     (SVRES-1
1194         DCA     X1
1195         JMS     MOVRES
1196         JMP I   SAVRES
1197 RSTRES, 0
1198         TAD     (SVRES-1
1199         DCA     X0
1200         TAD     (DHRES-1
1201         DCA     X1
1202         JMS     MOVRES
1203         JMP I   RSTRES
1204 MOVRES, 0
1205         TAD     (-17
1206         DCA     TMP1
1207         CDF     F1
1208         TAD I   X0
1209         DCA I   X1
1210         ISZ     TMP1
1211         JMP     .-3
1212         CDF     F0
1213         JMP I   MOVRES
1214 SVRES=7400
1215 \f/      PRINT THE LIBRARY NAME
1216 /
1217 PRLBNM, 0
1218         TAD     LIBNAM
1219         JMS     TTO2    /FIRST 2 CHARS
1220         JMP     PREXT
1221         TAD     LIBNAM+1
1222         JMS     TTO2
1223         JMP     PREXT
1224         TAD     LIBNAM+2
1225         JMS     TTO2
1226         NOP
1227 PREXT,  TAD     (".
1228         JMS I   PCHR
1229         TAD     LIBNAM+3
1230         JMS     TTO2
1231         JMP I   PRLBNM
1232         JMP I   PRLBNM
1233         PAGE
1234 \f/      OUTPUT HANDLERS STOLEN FROM PIP
1235 OUFLD=F1
1236 OUCTL=MBUFS^200!4000!F1
1237 OUBUF=MODBUF
1238 /
1239 /       INITIALIZE FOR OUTPUT
1240 /
1241 OUSETP, 0
1242         TAD     (OUCTL&3700     /BUFFER SIZE IN DBL WORDS
1243         CIA             /NEGATE IT (PAL10 BLOWS)
1244         DCA     OUDWCT
1245         TAD     (OUBUF
1246         DCA     OUPTR   /INITIALIZE WORD POINTER
1247         TAD     OUJMPE
1248         DCA     OUJMP   /INITIALIZE 3-WAY CHARACTER SWITCH
1249         JMP I   OUSETP
1250 /
1251 /       STORE CHARACTERS IN OUTPUT BUFFER
1252 /       IN PS8 FORMAT (YOU KNOW, 3 CHARS
1253 /       IN 2 WORDS THE WRONG WAY)
1254 /
1255 OCHAR,  0
1256         AND     (377
1257         DCA     OUTEMP
1258         CDF     OUFLD   /SET DATA FIELD TO BUFFER'S FIELD
1259         ISZ     OUJMP   /BUMP THE CHARACTER SWITCH
1260 OUJMP,  HLT             /THREE WAY CHARACTER SWITCH
1261         JMP     OCHAR1
1262         JMP     OCHAR2
1263         TAD     OUTEMP
1264         CLL RTL
1265         RTL
1266         AND     (7400
1267         TAD I   OUPOLD
1268         DCA I   OUPOLD  /UPDATE FIRST WORD OF TWO WITH HIGH
1269                         /ORDER 4 BITS OF THIRD CHAR
1270         TAD     OUTEMP
1271         CLL RTR
1272         RTR
1273         RAR
1274         AND     (7400
1275         TAD I   OUPTR
1276         DCA I   OUPTR   /UPDATE 2ND WORD FROM LO 4 BITS
1277         TAD     OUJMPE
1278         DCA     OUJMP   /RESET SWITCH
1279         ISZ     OUPTR
1280         ISZ     OUDWCT  /BUMP COUNTER EVERY 3 CHARS
1281         JMP     OUCOMN
1282         TAD     (OUCTL  /LOAD CONTROL WORD FOR A FULL WRITE
1283         JMS I   (OUTDMP /DUMP THE BUFFER
1284         JMS     OUSETP  /RE-INITIALIZE THE POINTERS
1285         JMP     OUCOMN
1286 OCHAR2, TAD     OUPTR
1287         DCA     OUPOLD  /SAVE POINTER TO FIRST WORD OF TWO
1288         ISZ     OUPTR   /BUMP WORD POINTER TO SECOND WORD
1289 OCHAR1, TAD     OUTEMP
1290         DCA I   OUPTR
1291 OUCOMN, CDF     F0
1292         JMP I   OCHAR
1293 OUTEMP, 0
1294 OUPOLD, 0
1295 OUPTR,  0
1296 OUJMPE, JMP     OUJMP
1297 OUDWCT, 0
1298 /
1299 /       MOVE OUTPUT FILE NAME TO FIELD 0
1300 /
1301 OFNAME, 0
1302         TAD     (OUTF2
1303         DCA     X0      /NAME OF CAT LIST FILE
1304         CDF     F1
1305         TAD I   X0
1306         DCA     OUFNAM  /FIRST 2 CHARS
1307         TAD I   X0
1308         DCA     OUFNAM+1
1309         TAD I   X0
1310         DCA     OUFNAM+2
1311         TAD I   X0
1312         SNA
1313         TAD     TXTCA   /DEFAULT CAT EXT
1314         DCA     OUFNAM+3
1315         CDF     F0      /RESTORE FIELD
1316         JMP I   OFNAME
1317 OUFNAM, ZBLOCK  4
1318 TXTCA,  301
1319         PAGE
1320 \fOOPEN, 0
1321         CDF     F1
1322         TAD I   (OUTF2  /GET DEVICE CODE, LEN
1323         DCA     OUELEN  /HOLD IT A MO
1324         JMS I   (OFNAME /GET FILE NAME INTO FIELD 0
1325         TAD     OUELEN  /CHECK FOR NULL FILE
1326         SNA CLA
1327         JMP I   OOPEN   /NOTHING TO OPEN
1328         TAD     OUNAME  /RESET ENTER CALL
1329         DCA     OUBLK
1330         TAD     (IDEVH!1
1331         DCA     OUHNDL
1332         TAD     OUELEN  /THE UNIT
1333         CIF     F1
1334         JMS I   USR
1335         FETCH           /ASSIGN, FETCH HANDLER
1336 OUHNDL, 0               /OUTPUT DEVICE HANDLER ENTRY
1337         JMS     IOERR           /HUH?
1338         TAD     OUELEN  /UNIT AGAIN
1339         CIF     F1
1340         JMS I   USR
1341         ENTER           /ENTER OUTPUT FILE
1342 OUBLK,  OUFNAM          /REPLACED WITH STARTING BLOCK
1343 OUELEN, 0               /REPLACED WITH LENGTH OF HOLE
1344         JMS     IOERR   /YOU BLEW IT!!!
1345         DCA     OUCCNT
1346         JMS I   (OUSETP
1347         ISZ     OOPEN
1348         JMP I   OOPEN
1349 \fOUTDMP,        0
1350         DCA     OUCTLW  /STORE THE CONTROL WORD
1351         TAD     OUCCNT
1352         SNA
1353         ISZ     OUCTLW
1354         TAD     OUBLK
1355         DCA     OUREC   /COMPUTE STARTING BLOCK
1356         TAD     OUCTLW
1357         JMS     R6L
1358         AND     (17     /COMPUTE THE NUMBER OF RECORDS
1359         TAD     OUCCNT  /UPDATE SIZE OF FILE
1360         DCA     OUCCNT
1361         TAD     OUCCNT
1362         CLL CML
1363         TAD     OUELEN
1364         SNL SZA CLA     /EXCEED GIVEN LENGTH ?
1365         JMS     IOERR   /YES - ERROR
1366         CDF     F0
1367         JMS I   OUHNDL
1368 OUCTLW, 0
1369         OUBUF
1370 OUREC,  0
1371         JMS     IOERR
1372         JMP I   OUTDMP
1373 \fOCLOSE,        0
1374         TAD     (232    /OUTPUT A CTRL/Z
1375         JMS I   PCHR
1376 FILLLP, JMS I   PCHR
1377         TAD     (77
1378         AND I   (OUDWCT
1379         SZA CLA         /UP TO THE BOUNDARY YET?
1380         JMP     FILLLP  /NO - FILL WITH ZEROS
1381         TAD I   (OUDWCT /GET DOUBLEWORD COUNT LEFT
1382         TAD     (OUCTL&3700
1383         SNA             /A FULL WRITE LEFT?
1384         JMP     NODUMP  /YES DON'T DO IT
1385         TAD     (4000!OUFLD /PUT IN FIELD AND WRITE BITS
1386         JMS     OUTDMP
1387 NODUMP, CIF CDF F1
1388         TAD I   (OUTF2
1389         CDF     F0
1390         JMS I   USR
1391         CLOSE           /CLOSE THE OUTPUT FILE
1392 OUNAME, OUFNAM          /POINTER TO OUTPUT FILE NAME
1393 OUCCNT, 0
1394         JMS     IOERR   /ERROR WHILE CLOSING - BAD!!
1395         JMP I   OCLOSE  /ALL DONE
1396         PAGE
1397 \f/      MESSAGES
1398 /
1399 LBV,    TEXT    "LIBRA V "
1400 *.-1
1401 VMESG,  VERS&70^7+VERS+6060
1402         PATCH&77^100+40
1403         4000
1404 NONEIN, TEXT    "MODULE NOT INCLUDED";0
1405 FLSTR,  TEXT    "LIBRARY MUST BE ON A FILE-STRUCTURED DEVICE";0
1406 SMALL,  TEXT    "INSUFFICIENT SPACE FOR LIBRARY";0
1407 NOTMOD, TEXT    "INPUT NOT A MODULE";0
1408 TOOBIG, TEXT    "INPUT TOO BIG FOR LIBRARY";0
1409 UNLIB,  TEXT    " IS NOT A LIBRARY";0
1410 NDUP,   TEXT    " IS DUPLICATE NAME";0
1411 KEEP,   TEXT    "; KEEP OLD OR NEW";0
1412 CATFUL, TEXT    "CATALOG IS FULL";0
1413 NCLUD,  TEXT    ": INCLUDE";0
1414 WHYCLS, TEXT    "LIBRARY TOO SMALL FOR USE; START OVER";0
1415 IOMSG,  TEXT    "I/O ERROR";0
1416 CATOF,  TEXT    "CATALOG OF ";0
1417 ON,     TEXT    " ON ";0
1418 CS197,  TEXT    ", 197";0
1419 MONTHS, TEXT    "-JAN-@@@@@-FEB-@@@@@-MAR-@@@@"
1420         TEXT    "-APR-@@@@@-MAY-@@@@@-JUN-@@@@"
1421         TEXT    "-JUL-@@@@@-AUG-@@@@@-SEP-@@@@"
1422         TEXT    "-OCT-@@@@@-NOV-@@@@@-DEC-@@@@"
1423         $
1424 \f