/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.
/
/
/
/
/
/
/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
/
/       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
ENAM1,	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
/	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
NOTFS,	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
ZTEST,	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
CSLAST,	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
NEWLIB,	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
/
/	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
FTCHIN, 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
BADINF,	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
/	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
GLMOD,	TAD	TMP3	/GET STARTING BLOCK
	DCA	MODBLK	/OF MODULE
	JMP	LUKMOD	/AND GO GET THE MODULE
L2BMSG,	TEXT	"INPUT LIBRARY TOO BIG";0
	PAGE
/       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
/
/       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
GOTMAT,	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
CHKR,   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
CHKI,	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
/	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
CPYMOD,	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
CHGCHK,	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
LCLOSE,	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
/	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
	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
/	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
/	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
R6R,	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
WAITOP,	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
/
/	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
/	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
/	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
/	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
OOPEN,	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
OUTDMP,	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
OCLOSE,	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
/	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-@@@@"
	$

