--- /dev/null
+/LIBRA: F4 LIBRARIAN, V24A
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1974, 1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/LIBRA: FORTRAN IV LIBRARIAN
+/
+/
+/ BORN OF JUD LEONARD, UNDER THE
+/ SIGN FOR WHICH IT IS NAMED.
+/
+/
+/ CHANGES FOR V23
+/ .PRINT VERSION NUMBER
+/ .ACCEPT INPUT FROM CONSOLES WITHOUT PARITY
+/
+/
+/ CHANGES FOR OS/8 V3D BY PAULA TIRAK
+/ .CHANGED VERSION NUMBER TO 24A
+/ .PUT IN NEW DATE ALGORITHM
+/ .NO LONGER MISNAMES THE SECOND OUTPUT FILE
+/
+/
+/ OS/8 CONSTANTS:
+VERS=24
+PATCH="A
+/
+FETCH=1
+LOOKUP=2
+ENTER=3
+CLOSE=4
+DECODE=5
+CHAIN=6
+ERROR=7
+USRIN=10
+USROUT=11
+/
+OUTF1=7600 /LIBRARY
+OUTF2=7605 /CATALOG LISTING
+OUTF3=7612 /UNUSED
+INF=7617
+/
+EQHI=7642
+SWATOL=7643
+SWMTOX=7644
+SWYTO9=7645
+EQLO=7646
+DHRES=7647 /HANDLER RESIDENCY TABLE
+SYSDAT=7666 /SYSTEM DATE
+DCTLW=7760 /DEVICE CONTROL WORD TABLE
+/ DEVICE CONTROL WORDS HAVE THE FORM:
+/ BIT 0 FILE STRUCTURED
+/ BIT 1 READ ONLY
+/ BIT 2 WRITE ONLY
+/ BITS 3-8 DEVICE TYPE
+/ BITS 9-11 DIR BLOCK OF CURRENT TENTATIVE FILE
+/
+/ INTERNAL DEFINITIONS:
+F0=00
+F1=10
+CATBUF=2000 /IN FIELD 1
+CBUFS=1 /NUMBER OF BUFFERS FOR CATALOG
+MODBUF=2400 /LIKEWISE
+MBUFS=12 /BUFFERS FOR MODULE
+ODEVH=7200 /OUTPUT DEVICE HANDLER (ROOM FOR 2-PAGE)
+IDEVH=6600 /INPUT DEVICE HANDLER
+\f/
+/ PAGE 0 FOR LIBRA
+/
+ *1
+TMP1, 0
+TMP2, 0 /SOME TEMPS
+TMP3, 0
+TMP4, 0
+TMP5, 0
+TMP6, 0
+TMP7, 0
+X0, 0 /AUTO-INDEX
+X1, 0
+X2, 0
+X3, 0
+X4, 0
+X5, 0
+X6, 0
+X7, 0
+USR, 200 /CURRENT USR CALL ADDRESS
+ /LIBRA ASSUMES USR ALWAYS PRESENT
+LIBDVH, ODEVH /ADDRESS OF LIBRARY DEVICE HANDLER
+LIBU, 1 /UNIT CONTAINING LIBRARY; INITIALLY SYS:
+CATLEN, 0 /LENGTH OF CATALOG
+CATBLK, 0 /CURRENT CATALOG BLOCK IN CORE
+LAVAIL, 0 /NEXT AVAILABLE LIBRARY BLOCK
+LIBNAM, TEXT "FORLIBRL"
+ *.-1
+INFP, INF /CURRENT PLACE IN INPUT FILE LIST
+MODU, 0 /UNIT CONTAINING CURRENT MODULE
+MODDVH, IDEVH /INPUT DEVICE HANDLER ADDRESS
+MODLEN, 0 /LENGTH OF THIS MODULE
+MODBLK, 0 /FIRST BLOCK OF MODULE
+INLSW, 0 /NON-ZERO IF IN LIBRARY INPUT
+INFST, 0 /FIRST BLOCK OF INPUT FILE
+INBLK, 0 /NEXT INPUT BLOCK NUMBER
+THSBLK, 0 /READIN CONTROL
+FULFLG, 0 /-1 IF CAT FULL
+\fENAM1, 0
+ENAM2, 0 /HOLDER FOR ESD NAMES
+ENAM3, 0
+ 0 /TEXT STOPPER FOR ENAME
+ESDCTR, 0
+PCAT, CATBUF /POINTER TO CURRENT CATALOG BLOCK
+INCLUD, -1 /SW FOR NAME INCLUDED IN CATALOG
+CHANGD, 1 /0 IF CAT BLOCK MODIFIED
+PMOD, MODBUF /POINTER TO CURRENT MODULE BLOCK
+/
+TTFLAG, 0 /NON-ZERO WHEN TTY HAS INITIALIZED
+PCHR, TTO /OUTPUT ROUTINE
+TTPOS, 0 /TTY POSITION COUNTER
+CATCNT, 0
+IOERR, 0
+ 7421 /ERROR CODE TO MQ
+ JMP I .+1
+ IOMES /LOG THE ERROR
+\f/ LIBRA MAIN CONTROL
+/
+ *177 /MAKES IT EASY TO CALL START
+START, CDF F0
+ JMS TTWAIT /ALLOW TTY TO COMPLETE
+ CIF F1
+ JMS I USR
+ DECODE
+TXTRL, 2214 /RL DEFAULT EXT
+ TAD (INF /RESET INPUT FILE POINTER
+ DCA INFP
+ TAD (TTO /AND IO DEVICE
+ DCA PCHR
+ DCA FULFLG
+ CDF F1
+ TAD I (OUTF1
+ SNA /NEW LIBRARY SPECIFIED?
+ JMP LASTLB /NO, USE LAST ONE
+ DCA LIBU /GET LIBRARY UNIT
+ TAD (OUTF1
+ DCA X0
+ TAD I X0
+ DCA LIBNAM /MOVE
+ TAD I X0 /IN
+ DCA LIBNAM+1 /NEW
+ TAD I X0 /NAME
+ DCA LIBNAM+2
+ TAD I X0
+ SNA
+ TAD TXTRL /IF NO EXT, FORCE .RL
+ DCA LIBNAM+3
+LASTLB, TAD LIBU /REGET UNIT
+ AND (17
+ TAD (DCTLW-1 /ADDRESS DEV CTL TABLE
+ DCA TMP1
+ TAD I TMP1
+ CDF F0
+ SMA CLA /IS DEVICE FILE-STRUCTURED?
+ JMP NOTFS /NO, BOMB
+ TAD (ODEVH!1
+ DCA OHADDR /ALLOW 2-PAGE HANDLER
+ TAD LIBU
+ AND (17
+ CIF F1
+ JMS I USR /GET THE HANDLER
+ FETCH
+OHADDR, ODEVH!1
+ JMS IOERR /YOU'RE KIDDING
+ TAD OHADDR /NOW THE REAL ADDRESS
+ DCA LIBDVH
+ JMP ZTEST
+\fNOTFS, JMS TTOTXT
+ FLSTR-1
+ JMS CRLF
+ JMP START
+/
+IOMES, CLA
+ TAD (TTO
+ DCA PCHR /ENSURE IT COMES OUT ON TTY
+ JMS TTOTXT
+ IOMSG-1
+ JMS CRLF
+ JMP START
+ PAGE
+\fZTEST, CDF F1 /FIND OR CREATE LIB.
+ TAD I (SWYTO9 /GET SWITCH WORD
+ AND (2000 /TEST FOR /Z
+ CDF F0
+ SZA CLA
+ JMP NEWLIB /YES, ENTER NEW ONE
+OLDLIB, JMS FNDLIB /LOOKUP THE LIBRARY
+ LOOKUP
+ JMP NEWLIB /COULDN'T FIND IT
+/
+ TAD LIBBLK /FIRST BLOCK OF LIBRARY
+ DCA ZCATB
+ TAD (CBUFS+MBUFS^200!F1
+ DCA ZCATC /READ ALL YOU CAN
+ JMS ZCAT /DO THE READ
+ CDF F1
+ TAD I (CATBUF /LOOK AT CONTROL WORD
+ CLL RAR
+ SZA CLA /IS IT A LIBRARY?
+ JMP NOTLIB /NO, ERROR
+ TAD I (CATBUF+3
+ CDF F0
+ DCA CATLEN /LENGTH IN BLOCKS
+ TAD LIBBLK
+ DCA LAVAIL /WILL BE UPDATED DURING SCAN
+ TAD LAVAIL
+ DCA CATBLK /CURRENT BLOCK IN BUFFER
+ TAD CATLEN
+ CIA
+ DCA TMP2 /COUNTER
+CSLOOP, TAD (CBUFS+MBUFS
+ TAD TMP2
+ SMA /WILL THE REST FIT IN BUFFER?
+ JMP CSLAST /YES
+ DCA TMP2
+ TAD (-CBUFS-MBUFS^100
+ DCA TMP1 /ENTRIES NOW IN CORE
+ JMS SCAT /SCAN CATALOG
+ TAD ZCATB /NEXT BLOCK WE'LL READ
+ DCA CATBLK
+ JMS ZCAT /READ SOME
+ JMP CSLOOP
+\fCSLAST, CIA /NO OF BLOCKS WE DON'T NEED
+ TAD (CBUFS+MBUFS
+ JMS R6L /NO OF ENTRIES WE CAN LOOK AT
+ CIA
+ DCA TMP1
+ JMS SCAT /LOOK FOR END
+FULCAT, JMS TTOTXT /RAN OFF THE END
+ CATFUL-1
+ JMS CRLF /**
+ JMP LCLOSE
+/
+SCAT, 0
+ TAD (CATBUF-1
+ DCA X0
+SCLOOP, CDF F1
+ TAD I X0
+ CMA /TEST FOR END
+ SNA CLA
+ JMP GETINF /THAT'S IT
+ ISZ X0
+ ISZ X0 /IGNORE REST OF NAME
+ TAD I X0 /GET LENGTH
+ TAD LAVAIL /ADD TO ST BLOCK OF FREE AREA
+ DCA LAVAIL
+ ISZ TMP1
+ JMP SCLOOP
+ CDF F0
+ JMP I SCAT /GO FOR NEXT BUFFER LOAD
+/
+NOTLIB, JMS PRLBNM /PRINT LIBRARY NAME
+ JMS TTOTXT
+ UNLIB-1
+ JMS CRLF
+ JMP START
+ PAGE
+\fNEWLIB, JMS FNDLIB
+ ENTER
+ JMS IOERR
+ TAD LIBU
+ AND (7760
+ CLL RTR
+ RTR
+ SNA /DID HE GIVE A LENGTH?
+ STL RTL /NO, USE 2
+ DCA CATLEN
+ CDF F1
+ TAD I (EQLO /HOW MANY EXTRA BLOCKS WANTED
+ CDF F0
+ TAD CATLEN /PLUS CATALOG REQUIREMENT
+ CLL
+ TAD LIBLEN /MINUS AVAILABLE LENGTH
+ SZL CLA /CHECK FOR ENUF ROOM
+ JMP LSZERR /NO ROOM, GIVE MESSAGE
+/
+/ WRITE EMPTY CATALOG
+/
+ TAD (CATBUF-1
+ DCA X0
+ TAD (-MBUFS-CBUFS^400
+ DCA TMP1
+ CDF F1
+ DCA I X0
+ ISZ TMP1
+ JMP .-2
+ TAD (CATBUF-1 /RESET FOR LATER USE
+ DCA X0
+ CLA CMA
+ TAD CATLEN
+ SPA SNA /MORE THAN ONE?
+ JMP CATB0 /JUST ONE
+ CIA
+ ISZ ZCATB /START WITH SECOND CAT BLOCK
+ZCLOOP, CLL
+ TAD (MBUFS+CBUFS
+ DCA TMP1
+ SZL /FULL WRITE?
+ TAD TMP1 /NO
+ CIA
+ TAD (MBUFS+CBUFS
+ JMS R6R
+ TAD (4000!F1
+ DCA ZCATC /SET CONTROL
+ JMS ZCAT
+ TAD TMP1
+ SPA
+ JMP ZCLOOP /MORE TO GO
+CATB0, CDF F1
+ CLA IAC /1 IS LIBRARY CODE
+ DCA I X0
+ TAD (VERS
+ DCA I X0 /MARK LIBRA VERSION #
+ TAD LIBLEN /JUST A GUESS
+ CIA
+ DCA I X0
+ TAD CATLEN
+ DCA I X0
+ CLA CMA /END OF CAT INDICATOR
+ DCA I X0 /MARKS FIRST AVAIL SLOT
+ CDF F0
+ DCA CHANGD /FORCE A WRITE ON THIS ONE
+ TAD ZCATB
+ DCA LAVAIL
+ TAD LIBBLK /LIBRARY START BLOCK
+ DCA CATBLK /IS CURRENTLY IN BUFFER
+ JMP GETINF /BEGIN
+/
+ZCAT, 0
+ CDF F0
+ JMS CCHK /LOOKOUT FOR CONTROL C
+ JMS I LIBDVH
+ZCATC, F1
+ CATBUF
+ZCATB, 0
+ JMS IOERR
+ TAD ZCATC
+ JMS R6L
+ AND (17
+ TAD ZCATB
+ DCA ZCATB
+ ISZ CHANGD /SET UNMODIFIED SW
+ JMP I ZCAT
+ JMP .-2
+/
+FNDLIB, 0
+ TAD I FNDLIB
+ DCA USRCOD
+ ISZ FNDLIB
+ TAD (LIBNAM
+ DCA LIBBLK
+ TAD LIBU
+ AND (17
+ CIF F1
+ JMS I USR
+USRCOD, 0
+LIBBLK, LIBNAM
+LIBLEN, 0 /NEG, REMEMBER
+ JMP I FNDLIB /COULD'T DO IT
+ TAD LIBBLK /FIRST BLOCK
+ DCA ZCATB /OF CATALOG
+ ISZ FNDLIB
+ JMP I FNDLIB
+LSZERR, JMS TTOTXT
+ SMALL-1
+ JMS CRLF
+ JMP START /GO FOR MORE
+ PAGE
+\f/
+/ SETUP POINTERS AND THINGS FOR NEXT INPUT MODULE
+/
+GETINF, CLA CMA
+ DCA INCLUD /SET NO-NAME-INCLUDED SW
+ TAD INLSW /ARE WE GETTING INPUT FROM A LIBR?
+ SZA CLA
+ JMP INLIB /YES-GET NEXT MODULE THEREIN
+NXTINF, CDF F1
+ TAD I INFP /UNIT AND LEN OF NEXT IN FILE
+ SZA /IS THERE ONE?
+ JMP FTCHIN /YES
+ TAD I (SWATOL
+ AND (1000 /TEST FOR /C
+ CDF F0
+ SNA CLA
+ JMP LCLOSE /NO MORE
+ JMS SAVRES /PRESERVE DEV HANDLER RESIDENCY
+ JMS TTWAIT /FINISH ANY TYPING
+ CIF F1
+ JMS I USR /NEW LINE CONTINUES OLD
+ DECODE
+ 2214 /RL DEFAULT EXT
+ 0 /DO NOT DELETE TENTATIVE FILES
+ JMS RSTRES /RESTORE RESIDENCY TABLE
+ TAD (INF
+ DCA INFP /RESET INPUT FILE POINTER
+ JMP NXTINF /TRY AGAIN
+\fFTCHIN, DCA MODU /UNIT CONTAINING INPUT MOD
+ ISZ INFP
+ TAD I INFP
+ DCA INFST /START OF INPUT FILE
+ ISZ INFP
+ TAD INFST
+ DCA MODBLK /IN THIS CASE, FILE=MODULE
+ TAD MODU
+ AND (7760
+ CIA
+ CLL RTR
+ RTR
+ DCA MODLEN
+ TAD (IDEVH!1
+ DCA INDVH /TENTATIVE HANDLER ADDR
+ CDF F0
+ TAD MODU
+ AND (17
+ CIF F1
+ JMS I USR
+ FETCH
+INDVH, IDEVH!1 /TENTATIVE INPUT HANDLER ADDR
+ JMS IOERR /DON'T GIVE ME THAT
+ TAD INDVH
+ DCA MODDVH /DEVICE HANDLER ADDRESS
+ DCA THSBLK /FORCE READIN TO READ
+LUKMOD, TAD MODBLK /FIRST BLOCK OF MODULE
+ DCA INBLK /INITIALIZE READIN
+ JMS READIN /GET FIRST BLOCK
+ CDF F1
+ CLA CMA /-1
+ TAD I PMOD /LOOK AT IDENTIFIER
+ CDF F0
+ SNA
+ JMP GOTLIB /ITS A LIBRARY
+ CLL RTR
+ SZA CLA /IS IT A MODULE
+ JMP BADINF /BAD INPUT
+ TAD LIBBLK /MAKE SURE
+ CIA
+ TAD LIBLEN /THAT MODULE
+ TAD LAVAIL /FITS IN LIBRARY
+ CLL
+ SNA /CHECK FOR TOO LONG HERE TOO**
+ JMP OVFLO /IT IS TOO LONG
+ TAD MODLEN
+ SNL CLA
+ JMP NXTEBK /GO GETTUM
+OVFLO, JMS TTOTXT
+ TOOBIG-1
+ JMS CRLF
+ JMP GETINF
+\fBADINF, JMS TTOTXT
+ NOTMOD-1
+ JMS CRLF
+ JMP GETINF
+/
+GOTLIB, TAD MODLEN
+ SNA CLA
+ JMP LB2BIG /CAN'T DO A LOOKUP IF G. T. 255
+ ISZ INLSW /SET IN-LIBRARY SWITCH
+ JMP INLIB
+LB2BIG, JMS TTOTXT
+ L2BMSG-1
+ JMS CRLF
+ JMP START
+ PAGE
+\f/ GET NEXT MODULE FROM LIBRARY
+/
+INLIB, TAD INFST /START OF INPUT FILE
+ DCA INBLK /IS WHAT WE WANT
+ JMS READIN /BRING CATALOG INTO MODULE BUFFER
+ TAD (3
+ TAD PMOD
+ DCA TMP1
+ CDF F1
+ TAD I TMP1 /GET CATALOG LEN
+ CIA
+ DCA TMP1 /HOLD COUNTER IN CASE OF FULL CATALOG
+ TAD INFST
+ DCA INBLK /WE WANT THE SAME ONE AGAIN
+ TAD INFST
+ DCA TMP3 /INIT ACCUMULATED MODULE START BLOCK
+ DCA MODLEN /INITAIL MOD LEN IS ZERO
+INLSC1, JMS READIN /GET CATALOG BLOCK
+ TAD (-100
+ DCA TMP2 /COUNT ENTRIES IN CAT BLOCK
+INLSC2, CDF F1
+ TAD I PMOD /LOOK FOR END-OF-CATALOG WORD
+ CMA
+ SNA CLA
+ JMP NDLSC /END OF SCAN
+ TAD (3
+ TAD PMOD /POINT TO LENGTH
+ DCA TMP5
+ TAD I TMP5
+ SNA CLA /FIRST ENTRY FOR A MODULE?
+ JMP NOLEN /NO, DO NOT UPDATE
+ TAD MODLEN
+ TAD TMP3 /UPDATE MODULE STARTING BLOCK
+ DCA TMP3
+ TAD I TMP5 /GET THIS LENGTH
+ DCA MODLEN /FOR THIS MODULE
+NOLEN, TAD MODBLK /COMPARE LAST MODULE STARTING BLOCK
+ CMA CLL
+ TAD TMP3 /TO ACCUMULATED START BLOCK
+ SNL CLA /INTERESTING?
+ JMP NOTYET /NO
+ TAD I PMOD /YES; WAS NAME DELETED?
+ SZA CLA
+ JMP GLMOD /NO, WE'VE GOT A GOOD MODULE
+NOTYET, TAD (4
+ TAD PMOD /POINT TO NEXT NAME
+ DCA PMOD
+ ISZ TMP2 /END OF CAT BLOCK?
+ JMP INLSC2 /NO
+ ISZ TMP1 /YES; END OF CATALOG?
+ JMP INLSC1 /NO, GET NEW BLOCK
+NDLSC, DCA INLSW /YES, NO LONGER IN A LIBRARY
+ JMP NXTINF /GET ANOTHER FILE
+\fGLMOD, TAD TMP3 /GET STARTING BLOCK
+ DCA MODBLK /OF MODULE
+ JMP LUKMOD /AND GO GET THE MODULE
+L2BMSG, TEXT "INPUT LIBRARY TOO BIG";0
+ PAGE
+\f/ PROCESS LOOP FOR ONE MODULE
+/
+NXTEBK, TAD (3
+ TAD PMOD /ADDR OF FIRST ESD-1
+ DCA X0 /RESET POINTER TO NAMES
+ TAD (-52 /PER BLOCK COUNT
+ DCA ESDCTR
+ESDLUP, CDF F1
+ TAD I X0
+ DCA ENAM1
+ TAD I X0
+ DCA ENAM2
+ TAD I X0
+ DCA ENAM3
+ TAD I X0 /TYPE CODE
+ CDF F0
+ TAD (ESDTAB /DISPATCH FROM TBL
+ DCA TMP1
+ JMP I TMP1
+ESDTAB, JMP ESDEND /0=END OF ESD TABLE
+ JMP DUPLUK /1=ENTRY=LOOK FOR
+ /DUPLICATE NAME
+ JMP ESDLND /2=EXTERN=IGNORE NAME
+ JMP ESDLND /3=FORT COMMON=IGNORE
+ JMP DUPLUK /4=PROG SECTION
+ HLT /5=MUL ENTRY=DOESN'T
+ /EXIST
+ HLT /6=MUL SECTION=DITTO
+ JMP DUPLUK /7=SECT8
+ JMP ESDLND /10=COMMZ
+ JMP DUPLUK /11=FIELD1
+\f/
+/ LOOK FOR DUPLICATION OF THIS ESD SYMBOL
+/
+DUPLUK, TAD CATLEN
+ CIA
+ DCA TMP1 /COUNT LENGTH OF CAT
+ TAD CATBLK
+ CIA
+ TAD LIBBLK /ARE WE AT FIRST BLOCK?
+ SZA CLA
+ JMS CHGCHK /CHECK FOR BLOCK MODIFIED
+ TAD LIBBLK
+ DCA NXTCAT /SETUP FOR FIRST BLOCK OF CAT
+ TAD CATLEN
+ CIA
+ DCA CATCNT
+GETCB, JMS GCATB /GET IT
+ TAD (CATBUF-1
+ DCA X1
+ TAD (-100 /COUNT ENTRIES/BLOCK
+ DCA TMP2
+ CDF F1
+CBSRCH, TAD I X1 /LOOK AT NAME
+ CMA
+ SNA
+ JMP CHKI /END OF CATALOG-LOOK FOR /I
+ IAC /COMPLETE THE CIA
+ TAD ENAM1 /COMPARE
+ SZA CLA
+ JMP NOMTCH
+ TAD I X1
+ CIA
+ TAD ENAM2
+ SZA CLA
+ JMP NOMTCH
+ TAD I X1 /LAST CHANCE
+ CIA
+ TAD ENAM3
+ SNA CLA
+ JMP GOTMAT /EQUAL!
+NOMTCH, TAD X1
+ AND (-4
+ TAD (3 /BUMP TO NEXT
+ DCA X1
+ ISZ TMP2
+ JMP CBSRCH
+ JMS CHGCHK /CHECK FOR MODIFIED BLOCK
+ ISZ TMP1 /END OF CATALOG?
+ JMP GETCB /NO, GET NEXT
+ JMS TTOTXT
+ CATFUL-1
+ JMS CRLF
+ CLA CMA
+ DCA FULFLG
+ JMP ESDEND /PUT THAT, IF POSSIBLE
+\fGOTMAT, CDF F0
+ JMS TTOTXT
+ ENAM1-1 /PRINT THE NAME
+ JMS TTOTXT
+ NDUP-1 /WHICH TO KEEP?
+ CDF F1
+ TAD I (SWATOL
+ CDF F0
+ AND (10 /TEST /I
+ SNA CLA
+ JMP CHKR /NO, LOOK FOR /R
+GMASK, JMS TTOTXT
+ KEEP-1
+ JMS WAITOP
+ JMP ESDLND /DEFAULT TO THE OLD ONE
+ TAD (-"O
+ SNA
+ JMP ESDLND /KEEP OLD
+ IAC /IS IT "N"?
+ SZA CLA
+ JMP GMASK /TRY AGAIN
+ JMP DELTO /DELETE THE OLD
+ PAGE
+\fCHKR, JMS CRLF
+ CDF F1
+ TAD I (SWMTOX
+ AND (100 /TEST /R
+ SNA CLA
+ JMP ESDLND /DEFAULT:KEEP THE OLD ONE
+DELTO, CDF F1
+ TAD X1
+ AND (-4
+ CIA
+ CMA /BACK UP POINTER
+ DCA X1
+ DCA I X1 /CLEAR
+ DCA I X1 /OLD
+ DCA I X1 /NAME
+ ISZ X1 /SKIP OVER LENGTH
+ DCA CHANGD /BLOCK HAS BEEN MODIFIED
+ JMP NXTE /ENTER AT END OF LOOP
+NDSCN, CDF F1
+ TAD I X1 /LOOK AT NEXT
+ CMA
+ SNA CLA
+ JMP ENDCAT /NOW WE'RE THERE
+ TAD X1
+ TAD (3 /BUMP TO NEXT NAME
+ DCA X1
+NXTE, ISZ TMP2
+ JMP NDSCN
+ JMS CHGCHK /LOOK OUT FOR CHANGES
+ ISZ CATCNT /END OF CAT ?
+ SKP
+ JMP FULCAT /NO MORE PUSSY
+ JMS GCATB
+ TAD (CATBUF-1
+ DCA X1
+ TAD (-100
+ DCA TMP2
+ JMP NDSCN
+\fCHKI, TAD I (SWATOL /LOOK AT /I SW
+ AND (10
+ SNA CLA
+ JMP ENDCAT /NOT SET
+ JMS TTOTXT
+ ENAM1-1 /TYPE ESD NAME
+ JMS TTOTXT
+ NCLUD-1 /INCLUDE IT?
+IANS, JMS WAITOP
+ JMP ENDCAT /DEFAULT TO INCLUDE
+ TAD (-"Y
+ SNA
+ JMP ENDCAT /YES, INCLUDE
+ TAD ("Y-"N
+ SZA CLA /IS IT "N"?
+ JMP IANS /NO, TRY AGAIN
+ JMP ESDLND
+ENDCAT, TAD X1 /POINT TO EMPTY SLOT
+ AND (-4
+ CIA
+ CMA
+ DCA X1
+ JMP INSERT
+ PAGE
+\f/ THIS ESD GOES IN THE CATALOG
+/
+INSERT, CDF F1
+ TAD ENAM1 /MOVE
+ DCA I X1 /NAME
+ TAD ENAM2 /TO
+ DCA I X1 /LIBRARY
+ TAD ENAM3 /CATALOG
+ DCA I X1
+ ISZ INCLUD /IS THIS THE FIRST?
+ SKP
+ TAD MODLEN /YES, GET THE LENGTH
+ DCA I X1 /AND STORE 4TH WORD
+ DCA CHANGD /SET CAT MODIFIED SW
+ CLA IAC
+ TAD X1 /CHECK FOR END OF BLOCK
+ AND (377
+ SZA CLA
+ JMP MARKND /NO, MARK END OF CAT
+ JMS CHGCHK /WRITE THIS BLOCK
+ CDF F1
+ TAD (-400
+ DCA TMP1 /SET COUNT FOR BLOCK LEN
+ TAD (CATBUF-1
+ DCA X1 /SET POINTER
+ CLA CMA
+ DCA I X1
+ ISZ TMP1
+ JMP .-2 /CLEAR THE BLOCK
+ DCA CHANGD
+ ISZ CATBLK
+ JMP ESDLND
+MARKND, CLA CMA
+ DCA I X1 /MARK NEW END OF CAT
+ESDLND, CDF F0
+ CLA STL RTL /TWO TO SKIP VALUE
+ TAD X0
+ DCA X0
+ ISZ ESDCTR /DONE WITH BLOCK?
+ JMP ESDLUP /NO, GET NEXT
+ JMS READIN /GET NEXT BLOK
+ JMP NXTEBK /RESET POINTERS AND CONTINUE
+ESDEND, ISZ INCLUD /CHECK FOR ANY NAMES OUT
+ JMP CPYMOD /YES, COPY MODULE INTO LIBRARY
+ JMS TTOTXT /SORRY, DIDN'T MAKE IT
+ NONEIN-1
+ JMS CRLF
+ ISZ FULFLG
+ JMP GETINF /TRY NEXT
+ JMP LCLOSE
+\fCPYMOD, TAD MODBLK /GET IN FILE STRT BLOCK
+ DCA INBLK
+ TAD MODLEN
+ CIA
+ DCA TMP1
+ TAD LAVAIL /FIRST AVAILABLE BLOCK
+ DCA NXTOBK
+CPYLUP, JMS READIN /READ BLOCK OF INPUT
+ TAD PMOD
+ DCA PNXTOB
+ JMS I LIBDVH /CALL OUTPUT HANDLER
+ 4200!F1
+PNXTOB, MODBUF
+NXTOBK, 0 /NEXT OUTPUT BLOCK NUMBER
+ JMS IOERR
+ ISZ NXTOBK /BUMP BLOCK NUMBER
+ ISZ TMP1 /CHECK LENGH
+ JMP CPYLUP
+ TAD NXTOBK
+ DCA LAVAIL /UPDATE AVAILABLE POINTER
+ JMP GETINF /GO FOR NEXT
+ PAGE
+\fCHGCHK, 0
+ CDF F0 /PRECAUTION
+ TAD CHANGD /HAS BLOCK BEEN MODIFIED?
+ SZA CLA
+ JMP I CHGCHK /NO, NOTHING TO DO
+ TAD CATBLK
+ DCA ZCATB /WRITE THE BLOCK
+ TAD (4200!F1
+ DCA ZCATC
+ JMS ZCAT
+ JMP I CHGCHK /OK
+/
+/
+GCATB, 0
+ CDF F0
+ TAD NXTCAT
+ CIA
+ TAD CATBLK /IS IT IN CORE?
+ SNA CLA
+ JMP SOEZ /YES, ITS EZ
+ TAD NXTCAT
+ CIA
+ TAD LIBBLK
+ TAD CATLEN
+ SPA SNA CLA /CHECK FOR INTERNAL ERROR
+ JMP FULCAT /**
+ TAD NXTCAT
+ DCA ZCATB
+ TAD (200!F1 /SET FOR READ
+ DCA ZCATC
+ JMS ZCAT
+ TAD NXTCAT /NEXT BLOCK
+ DCA CATBLK /IS IN CORE
+SOEZ, ISZ NXTCAT
+ JMP I GCATB
+NXTCAT, 0
+ PAGE
+\fLCLOSE, JMS CHGCHK
+ TAD USRCOD
+ TAD (-ENTER /DID WE ENTER A NEW FILE?
+ SZA CLA
+ JMP CATLST /NO, GO LIST CATALOG
+ TAD LIBBLK /GET LEN
+ CIA
+ CDF F1
+ TAD I (EQLO /GET USER EXTENSION REQUEST
+ CDF F0
+ TAD LAVAIL /PLUS CURRENT END
+ DCA TMP1
+ TAD TMP1
+ CLL
+ TAD LIBLEN /CHECK FOR POSSIBLE
+ SNL CLA
+ JMP .+4
+ TAD LIBLEN /CAN'T GIVE ALL HE WANTS
+ CIA
+ SKP
+ TAD TMP1
+ DCA LCLEN /SET CLOSE LENGTH
+ TAD CATLEN
+ CMA
+ TAD LCLEN /COMPARE CAT LEN TO LIB LEN
+ SPA SNA CLA
+ JMP NOLIB /THERE'S NO POINT
+ TAD LIBBLK /GET FIRST BLOCK
+ DCA NXTCAT
+ JMS GCATB
+ CDF F1
+ TAD LCLEN /ACTUAL LIBRARY LENGTH
+ DCA I (CATBUF+2
+ CDF F0
+ DCA CHANGD
+ JMS CHGCHK /WRITE IT
+ TAD LIBU
+ AND (17
+ CIF F1
+ JMS I USR
+ CLOSE
+ LIBNAM
+LCLEN, 0
+ JMS IOERR
+ JMP CATLST /GO LIST THE CATALOG
+/
+NOLIB, JMS TTOTXT
+ WHYCLS-1
+ JMS CRLF
+ JMP START
+ PAGE
+\f/ LIST THE CATALOG
+/
+CATLST, JMS OOPEN /OPEN LISTING FILE
+ JMP START /NONE DESIRED
+ TAD (OCHAR /SETUP FOR DEVICE-INDEPENDENT
+ DCA PCHR /OUTPUT
+ TAD (214 /AT TOP OF PAGE
+ JMS I PCHR
+ JMS CRLF
+ JMS TTOTXT
+ LBV-1
+ JMS TTOTXT
+ CATOF-1
+ JMS PRLBNM /PRINT THE NAME
+ CDF F1
+ TAD I (SYSDAT
+ CDF F0
+ SNA
+ JMP NODATE /DON'T KNOW THE DATE
+ DCA TMP1
+ JMS TTOTXT
+ ON-1
+ CLA /THE FOLLOWING CODE GETS THE DAY
+ DCA TMP2
+ TAD TMP1 /GET THE DATE
+ RTR /ROTATE THREE RIGHT AND MASK
+ RAR /TO GET THE DAY IN OCTAL
+ AND (37
+ JMS MAK8BT /MAKE IT 8-BIT AND PRINT
+ DCA TMP2
+ TAD TMP1 /GET THE DATE BACK
+ AND (7400 /MASK TO GET THE MONTH BITS
+ JMS R6R /MONTH*4 (IN OCTAL)
+ DCA TMP2 /PUT IN TEMP. VARIABLE TO SAVE IT
+ TAD TMP2 /GET IT BACK
+\f RTR /MONTH
+ TAD TMP2
+ TAD (MONTHS-6
+ DCA .+2 /ADDRESS OF MONTH FROM TABLE
+ JMS TTOTXT /PUT IT IN THE TEXT LINE
+ 0
+ TAD TMP1 /GET THE DATE---TO FIND THE YEAR
+ AND (7 /MASK TO GET THE YEAR OFFSET BITS
+ DCA TMP4 /SAVE THEM
+ DCA TMP2
+ TAD I (7777 /GET THE DATE EXTENSION BITS
+ AND (600
+ CLL RTR /ROTATE TO GET THEM INTO BIT
+ RTR /POSITIONS 7 AND 8
+ TAD (106 /ADD 70(ORIGINAL BASE YEAR)
+ TAD TMP4 /ADD IN THE YEAR OFFSET BITS
+ JMS MAK8BT /MAKE 8-BIT AND PRINT
+NODATE, JMS CRLF
+ JMP PRCAT /TITLE IS DONE, PRINT CAT
+MAK8BT, 0 /ROUTINE TO CONVERT TO 8-BIT AND PRINT
+ CLL /FIRST CONVERT TO DECIMAL
+CONVYR, TAD (-12 /KEEP SUBTRACTING 12
+ SPA /HAVE THE YEAR
+ JMP GETDG1
+ ISZ TMP2 /HOLDS THE FIRST DIGIT OF YEAR
+ JMP CONVYR
+GETDG1, TAD (12 /GET THE SECOND DIGIT
+ DCA TMP3 /SAVE IT
+ TAD TMP2 /GET THE FIRST DIGIT
+ SNA /FIRST DIGIT IS A ZERO
+ JMP PRDIG2 /PRINT THE SECOND DIGIT
+ TAD (260 /MAKE FIRST DIGIT OF YEAR 8-BIT
+ JMS I PCHR /PRINT IT
+PRDIG2, TAD TMP3 /GET THE SECOND DIGIT
+ TAD (260 /MAKE SECOND DIGIT OF YEAR 8-BIT
+ JMS I PCHR /PRINT IT
+ JMP I MAK8BT /RETURN
+ PAGE
+\f/ LIST ALL ENTRIES IN THE CATALOG
+/
+PRCAT, TAD CATLEN
+ CIA
+ DCA TMP1
+ TAD LIBBLK
+ DCA NXTCAT
+ CLA CMA
+ DCA TMP3 /SET LINE COUNTER
+CATLUP, JMS GCATB
+ TAD (CATBUF-1
+ DCA X0
+ TAD (-100
+ DCA TMP2
+CATLP2, CDF F1
+ TAD I X0 /GET FIRST WORD OF NAME
+ SNA
+ JMP EMPTY /NOT AN ESD NAME
+ CMA
+ SNA
+ JMP NDCATL /END OF CATALOG
+ CMA /RESTORE FIRST WORD
+ JMS TTO2 /PRINT
+ JMP NDNAM /A SHORT NAME
+ CDF F1
+ TAD I X0
+ JMS TTO2
+ JMP NDNAM
+ CDF F1
+ TAD I X0
+ JMS TTO2
+ NOP
+NDNAM, ISZ TMP3 /MORE ROOM ON THIS LINE?
+ JMP SAMLIN /SURE
+ JMS CRLF
+ TAD (-10 /SETUP FOR 8 PER LINE
+ DCA TMP3
+ JMP EMPTY
+SAMLIN, JMS TAB /SPACE OVER TO NEXT NAME
+EMPTY, TAD X0
+ AND (-4
+ TAD (3
+ DCA X0 /POINT TO NEXT
+ ISZ TMP2
+ JMP CATLP2 /GO FOR NEXT
+ ISZ TMP1 /MORE BLOCKS?
+ JMP CATLUP /YES
+ JMS CRLF
+ JMS TTOTXT
+ CATFUL-1
+NDCATL, JMS CRLF
+ TAD (214 /EJECT PAGE
+ JMS I PCHR
+ JMS OCLOSE /CLOSE THE FILE
+ JMP START
+ PAGE
+\f/ USEFUL OUTPUT THINGS
+/
+TTO, 0
+ DCA TTOCHR
+ JMS TTWAIT
+ TAD (200
+ KRS
+ TAD (-217 /CRTL/O CHECK
+ SNA CLA
+ KSF
+ SKP
+ JMP I TTO
+ TAD TTOCHR
+ TLS
+ DCA TTFLAG
+ JMP I TTO
+TTOCHR, 0
+TTWAIT, 0
+ TAD TTFLAG
+ SNA CLA
+ JMP I TTWAIT
+ JMS CCHK /BEWARE OF CTRL/C
+ TSF
+ JMP .-2 /WAIT TILL DONE
+ DCA TTFLAG /CLEAR BUSY FLAG
+ JMP I TTWAIT
+CCHK, 0
+ KSF
+ JMP I CCHK /NOTHING TO WORRY ABOUT
+ TAD (200
+ KRS
+ TAD (-203
+ SNA CLA /WAS IT CONTROL C?
+ JMP I (7600 /YES
+ JMP I CCHK
+TTO2, 0
+ DCA TMP7
+ TAD TMP7
+ JMS R6R
+ JMS TTO2A
+ TAD TMP7
+ JMS TTO2A
+ ISZ TTO2
+ JMP I TTO2
+TTO2A, 0
+ AND (77
+ SNA
+ JMP I TTO2
+ TAD (-40
+ SPA
+ TAD (100
+ TAD (240
+ JMS I PCHR
+ ISZ TTPOS /BUMP POSITION COUNT
+ JMP I TTO2A
+\fR6R, 0
+ CLL RTR
+ RTR
+ RTR
+ JMP I R6R
+R6L, 0
+ CLL RTL
+ RTL
+ RTL
+ JMP I R6L
+TTOTXT, 0
+ CDF F0
+ TAD I TTOTXT
+ DCA X7
+ ISZ TTOTXT /BUMP PAST POINTER
+ TAD I X7
+ JMS TTO2
+ JMP I TTOTXT
+ JMP .-3
+CRLF, 0
+ DCA TTPOS /RESET POSITION
+ TAD (215
+ JMS I PCHR
+ TAD (212
+ JMS I PCHR
+ JMP I CRLF
+TAB, 0 /PSEUDO-TAB GENERATOR
+ TAD (240
+ JMS I PCHR
+ ISZ TTPOS
+ TAD TTPOS
+ AND (7
+ SNA CLA /IS POSITION A MULTIPLE OF 8
+ JMP I TAB
+ JMP TAB+1 /NO, TRY MORE
+ PAGE
+\fWAITOP, 0
+ TAD (277 /QUESTION
+ JMS TTO
+ DCA RETCHR
+WREP, JMS TTI /WAIT FOR REPLY
+ TAD (-215
+ SNA
+ JMP DFALT
+ TAD (215-240 /PRINTING?
+ SPA
+ JMP WREP /NO, TRY AGIAN
+ TAD (240
+ DCA RETCHR
+ TAD RETCHR
+ECHO, JMS TTO
+ JMS TTI
+ TAD (-215
+ SNA
+ JMP GOTREP
+ TAD (215-377 /LOOKOUT FOR RUBOUT!
+ SNA
+ JMP RUBOUT
+ TAD (377
+ JMP ECHO
+RUBOUT, JMS CRLF
+ JMP WAITOP+1
+GOTREP, ISZ WAITOP /GOT A REAL ANSWER
+DFALT, JMS CRLF
+ TAD RETCHR
+ JMP I WAITOP
+RETCHR, 0
+/
+TTI, 0
+ KSF /WAIT FOR A KEY
+ JMP .-1
+ KRB
+ AND (177 /TAKE CARE OF PARITY
+ TAD (-3 /CTRL C?
+ SNA
+ JMP I (7600 /YES
+ TAD (203 /GET ORGINIAL CHAR BACK
+ JMP I TTI
+PAGE
+\f/
+/ INPUT BUFFERRER AND STUFF
+/
+READIN, 0
+ CDF F0
+ TAD INBLK
+ TAD THSBLK /-FIRST BLOCK FOLLOWING BUFFER CONTENTS
+ CLL
+ TAD (MBUFS
+ SNL /IS IT IN CORE?
+ JMP MUSTRD /NO, WE HAVE TO DO A READ
+ CLL RTR
+ RTR
+ RAR /TIMES 400
+SETP, TAD (MODBUF /PLUSS BUFFER ADDR
+ DCA PMOD /POINTS TO BLOCK
+ ISZ INBLK /READY FOR NEXT
+ JMP I READIN
+MUSTRD, CLA /THIS ONE'S HARDER
+ TAD INBLK
+ DCA RDBLK
+ TAD INBLK
+ TAD (MBUFS
+ CIA
+ DCA THSBLK
+ JMS I MODDVH
+ MBUFS^200!F1
+ MODBUF
+RDBLK, 0
+ JMS IOERR
+ JMP SETP /OK
+\f/ ROUTINES TO SAVE AND RESTORE
+/ DEVICE HANDLER RESIDENCY TABLE
+/
+SAVRES, 0
+ TAD (DHRES-1
+ DCA X0
+ TAD (SVRES-1
+ DCA X1
+ JMS MOVRES
+ JMP I SAVRES
+RSTRES, 0
+ TAD (SVRES-1
+ DCA X0
+ TAD (DHRES-1
+ DCA X1
+ JMS MOVRES
+ JMP I RSTRES
+MOVRES, 0
+ TAD (-17
+ DCA TMP1
+ CDF F1
+ TAD I X0
+ DCA I X1
+ ISZ TMP1
+ JMP .-3
+ CDF F0
+ JMP I MOVRES
+SVRES=7400
+\f/ PRINT THE LIBRARY NAME
+/
+PRLBNM, 0
+ TAD LIBNAM
+ JMS TTO2 /FIRST 2 CHARS
+ JMP PREXT
+ TAD LIBNAM+1
+ JMS TTO2
+ JMP PREXT
+ TAD LIBNAM+2
+ JMS TTO2
+ NOP
+PREXT, TAD (".
+ JMS I PCHR
+ TAD LIBNAM+3
+ JMS TTO2
+ JMP I PRLBNM
+ JMP I PRLBNM
+ PAGE
+\f/ OUTPUT HANDLERS STOLEN FROM PIP
+OUFLD=F1
+OUCTL=MBUFS^200!4000!F1
+OUBUF=MODBUF
+/
+/ INITIALIZE FOR OUTPUT
+/
+OUSETP, 0
+ TAD (OUCTL&3700 /BUFFER SIZE IN DBL WORDS
+ CIA /NEGATE IT (PAL10 BLOWS)
+ DCA OUDWCT
+ TAD (OUBUF
+ DCA OUPTR /INITIALIZE WORD POINTER
+ TAD OUJMPE
+ DCA OUJMP /INITIALIZE 3-WAY CHARACTER SWITCH
+ JMP I OUSETP
+/
+/ STORE CHARACTERS IN OUTPUT BUFFER
+/ IN PS8 FORMAT (YOU KNOW, 3 CHARS
+/ IN 2 WORDS THE WRONG WAY)
+/
+OCHAR, 0
+ AND (377
+ DCA OUTEMP
+ CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD
+ ISZ OUJMP /BUMP THE CHARACTER SWITCH
+OUJMP, HLT /THREE WAY CHARACTER SWITCH
+ JMP OCHAR1
+ JMP OCHAR2
+ TAD OUTEMP
+ CLL RTL
+ RTL
+ AND (7400
+ TAD I OUPOLD
+ DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH
+ /ORDER 4 BITS OF THIRD CHAR
+ TAD OUTEMP
+ CLL RTR
+ RTR
+ RAR
+ AND (7400
+ TAD I OUPTR
+ DCA I OUPTR /UPDATE 2ND WORD FROM LO 4 BITS
+ TAD OUJMPE
+ DCA OUJMP /RESET SWITCH
+ ISZ OUPTR
+ ISZ OUDWCT /BUMP COUNTER EVERY 3 CHARS
+ JMP OUCOMN
+ TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE
+ JMS I (OUTDMP /DUMP THE BUFFER
+ JMS OUSETP /RE-INITIALIZE THE POINTERS
+ JMP OUCOMN
+OCHAR2, TAD OUPTR
+ DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO
+ ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD
+OCHAR1, TAD OUTEMP
+ DCA I OUPTR
+OUCOMN, CDF F0
+ JMP I OCHAR
+OUTEMP, 0
+OUPOLD, 0
+OUPTR, 0
+OUJMPE, JMP OUJMP
+OUDWCT, 0
+/
+/ MOVE OUTPUT FILE NAME TO FIELD 0
+/
+OFNAME, 0
+ TAD (OUTF2
+ DCA X0 /NAME OF CAT LIST FILE
+ CDF F1
+ TAD I X0
+ DCA OUFNAM /FIRST 2 CHARS
+ TAD I X0
+ DCA OUFNAM+1
+ TAD I X0
+ DCA OUFNAM+2
+ TAD I X0
+ SNA
+ TAD TXTCA /DEFAULT CAT EXT
+ DCA OUFNAM+3
+ CDF F0 /RESTORE FIELD
+ JMP I OFNAME
+OUFNAM, ZBLOCK 4
+TXTCA, 301
+ PAGE
+\fOOPEN, 0
+ CDF F1
+ TAD I (OUTF2 /GET DEVICE CODE, LEN
+ DCA OUELEN /HOLD IT A MO
+ JMS I (OFNAME /GET FILE NAME INTO FIELD 0
+ TAD OUELEN /CHECK FOR NULL FILE
+ SNA CLA
+ JMP I OOPEN /NOTHING TO OPEN
+ TAD OUNAME /RESET ENTER CALL
+ DCA OUBLK
+ TAD (IDEVH!1
+ DCA OUHNDL
+ TAD OUELEN /THE UNIT
+ CIF F1
+ JMS I USR
+ FETCH /ASSIGN, FETCH HANDLER
+OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY
+ JMS IOERR /HUH?
+ TAD OUELEN /UNIT AGAIN
+ CIF F1
+ JMS I USR
+ ENTER /ENTER OUTPUT FILE
+OUBLK, OUFNAM /REPLACED WITH STARTING BLOCK
+OUELEN, 0 /REPLACED WITH LENGTH OF HOLE
+ JMS IOERR /YOU BLEW IT!!!
+ DCA OUCCNT
+ JMS I (OUSETP
+ ISZ OOPEN
+ JMP I OOPEN
+\fOUTDMP, 0
+ DCA OUCTLW /STORE THE CONTROL WORD
+ TAD OUCCNT
+ SNA
+ ISZ OUCTLW
+ TAD OUBLK
+ DCA OUREC /COMPUTE STARTING BLOCK
+ TAD OUCTLW
+ JMS R6L
+ AND (17 /COMPUTE THE NUMBER OF RECORDS
+ TAD OUCCNT /UPDATE SIZE OF FILE
+ DCA OUCCNT
+ TAD OUCCNT
+ CLL CML
+ TAD OUELEN
+ SNL SZA CLA /EXCEED GIVEN LENGTH ?
+ JMS IOERR /YES - ERROR
+ CDF F0
+ JMS I OUHNDL
+OUCTLW, 0
+ OUBUF
+OUREC, 0
+ JMS IOERR
+ JMP I OUTDMP
+\fOCLOSE, 0
+ TAD (232 /OUTPUT A CTRL/Z
+ JMS I PCHR
+FILLLP, JMS I PCHR
+ TAD (77
+ AND I (OUDWCT
+ SZA CLA /UP TO THE BOUNDARY YET?
+ JMP FILLLP /NO - FILL WITH ZEROS
+ TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT
+ TAD (OUCTL&3700
+ SNA /A FULL WRITE LEFT?
+ JMP NODUMP /YES DON'T DO IT
+ TAD (4000!OUFLD /PUT IN FIELD AND WRITE BITS
+ JMS OUTDMP
+NODUMP, CIF CDF F1
+ TAD I (OUTF2
+ CDF F0
+ JMS I USR
+ CLOSE /CLOSE THE OUTPUT FILE
+OUNAME, OUFNAM /POINTER TO OUTPUT FILE NAME
+OUCCNT, 0
+ JMS IOERR /ERROR WHILE CLOSING - BAD!!
+ JMP I OCLOSE /ALL DONE
+ PAGE
+\f/ MESSAGES
+/
+LBV, TEXT "LIBRA V "
+*.-1
+VMESG, VERS&70^7+VERS+6060
+ PATCH&77^100+40
+ 4000
+NONEIN, TEXT "MODULE NOT INCLUDED";0
+FLSTR, TEXT "LIBRARY MUST BE ON A FILE-STRUCTURED DEVICE";0
+SMALL, TEXT "INSUFFICIENT SPACE FOR LIBRARY";0
+NOTMOD, TEXT "INPUT NOT A MODULE";0
+TOOBIG, TEXT "INPUT TOO BIG FOR LIBRARY";0
+UNLIB, TEXT " IS NOT A LIBRARY";0
+NDUP, TEXT " IS DUPLICATE NAME";0
+KEEP, TEXT "; KEEP OLD OR NEW";0
+CATFUL, TEXT "CATALOG IS FULL";0
+NCLUD, TEXT ": INCLUDE";0
+WHYCLS, TEXT "LIBRARY TOO SMALL FOR USE; START OVER";0
+IOMSG, TEXT "I/O ERROR";0
+CATOF, TEXT "CATALOG OF ";0
+ON, TEXT " ON ";0
+CS197, TEXT ", 197";0
+MONTHS, TEXT "-JAN-@@@@@-FEB-@@@@@-MAR-@@@@"
+ TEXT "-APR-@@@@@-MAY-@@@@@-JUN-@@@@"
+ TEXT "-JUL-@@@@@-AUG-@@@@@-SEP-@@@@"
+ TEXT "-OCT-@@@@@-NOV-@@@@@-DEC-@@@@"
+ $
+\f
projects / pdp8.git / blobdiff