TITLE	CATDTA - DECtape interface to the DECsystem-10 Catalog Daemon
SUBTTL	D. Mastrovito /DPM	26-Nov-85

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1986.
;ALL RIGHTS RESERVED.
;
	SEARCH	CATPRM
	CATDEF	(CATDTA)

	.LINK	DEVLNK,C$DTA
C$DTA::	BLOCK	1		;LINK TO NEXT DISPATCH DEVTOR
	EXP	.CTDTA		;CATALOG DEVICE TYPE
	EXP	DTADAT		;DATA BASE ADDRESS
	[ASCIZ	|DECtape|]	;DATA BASE NAME
	EXP	.DTLEN		;WORDS PER VOLUME STORAGE
	EXP	DTAMNV		;MAXIMUM NUMBER OF VOLUMES IN A VOLUME-SET
	EXP	DTALIH		;LIST HEADER
	EXP	.POPJ1		;CHECK ENTRY
	EXP	DTAINS		;INSERT ENTRY
	EXP	DTALIS		;LIST ENTRY
	EXP	DTASHW		;SHOW ENTRY
	EXP	DTARSW		;PROCESS /REELID

DTADAT:	BLOCK	.CDLEN

DTALIH:	ASCIZ	|
            DECtape volume set                   Storage  location   Expiration  Reelid       PPN       Name
----------------------------------------------  -------------------  ----------  ------  -------------  ----
|


DTAINS:	LOAD	S1,.CTVFL(E),CT.NVL	;GET NUMBER OF VOLUMES
	JUMPN	S1,.POPJ1		;RETURN IF WE HAVE SOME
	HRROI	S1,.CTVSN(E)		;POINT TO VOLUME-SET NAME
	PJRST	DTARSX			;PRETEND /REELID SEEN


DTALIS:	MOVEI	S1,.CTVLO(E)		;POINT TO LOCATION TEXT
	HRLI	S1,(POINT 8,)		;MAKE A BYTE POINTER
	MOVEI	S2,[ITEXT (<^H9L/.CTVED(E)/>)]
	SKIPN	.CTVED(E)		;HAVE AN EXPIRATION DATE?
	MOVEI	S2,[ITEXT (<         >)];NO--BLANK OUT FIELD
	$TEXT	(C$TXTC##,<^D5R /.CDLDN(C)/  ^T39L /.CTVSN(E)/  ^Q19L /S1/  ^I/(S2)/   ^W6L /.CTVSL(E)/  ^A>)
	PUSHJ	P,C$LPPN##		;LIST THE PPN
	PUSHJ	P,C$LNAM##		;LIST NAME
	PJRST	C$CRLF##		;APPEND A CRLF AND RETURN

DTASHW:	MOVEI	S1,.CTVSL(E)		;POINT TO START OF REELID STORAGE
	MOVE	S2,.DTRID(S1)		;GET REELID
	$TEXT	(C$TXTC##,<^M^J	Reelid: ^W/S2/>)
	POPJ	P,

DTARSW:	HRROI	S1,(T3)			;POINT TO TEXT
DTARSX:	$CALL	S%SIXB			;CONVERT TO SIXBIT
	MOVEI	S1,.CTVSL(E)		;POINT TO START OF REELID STORAGE
	MOVEM	S2,.DTRID(S1)		;SAVE REELID
	LOAD	S1,.CTVFL(E),CT.FEL	;GET FILE ENTRY LENGTH
	ADDI	S1,.DTLEN		;INCREMENT
	STORE	S1,.CTVFL(E),CT.FEL	;UPDATE
	MOVEI	S1,1			;CAN ONLY HAVE ONE REEL PER VOLUME-SET
	STORE	S1,.CTVFL(E),CT.NVL	;SET REEL COUNT
	JRST	.POPJ1			;RETURN

	PRGEND
TITLE	CATMTA - Magtape interface to the DECsystem-10 Catalog Daemon
SUBTTL	D. Mastrovito /DPM	1-Aug-84

	SEARCH	CATPRM
	CATDEF	(CATMTA)

	.LINK	DEVLNK,C$MTA
C$MTA::	BLOCK	1		;LINK TO NEXT DISPATCH VECTOR
	EXP	.CTMTA		;CATALOG DEVICE TYPE
	EXP	MTADAT		;DATA BASE ADDRESS
	[ASCIZ	|Magtape|]	;DATA BASE NAME
	EXP	.MTLEN		;WORDS PER VOLUME STORAGE
	EXP	MTAMNV		;MAXIMUM NUMBER OF VOLUMES IN A VOLUME-SET
	EXP	MTALIH		;LIST HEADER
	EXP	MTACHK		;CHECK ENTRY
	EXP	MTAINS		;INSERT ENTRY
	EXP	MTALIS		;LIST ENTRY
	EXP	MTASHW		;SHOW ENTRY
	EXP	.POPJ1		;PROCESS /REELID

MTADAT:	BLOCK	.CDLEN

MTALIH:	ASCIZ	|
            Magtape volume set                   Storage  location   Expiration  Reelid       PPN       Name
----------------------------------------------  -------------------  ----------  ------  -------------  ----
|

MTACHK:	LOAD	S1,.CTVSC(E),CT.DEN	;GET DENSITY INDEX
	JUMPE	S1,E$DNS##		;JUMP IF DENSITY NOT SPECIFIED
	LOAD	S2,.CTVSC(E),CT.TRK	;GET TRACKS INDEX
	CAIE	S1,.CT160		;1600 BPI?
	CAIN	S1,.CT625		;6250 BPI?
	JRST	MTAC.1			;HAS TO BE A 9-TRACK TAPE
	JUMPE	S2,E$TNS##		;JUMP IF TRACKS NOT SPECIFIED
	JRST	MTAC.2			;ELSE DENSITY AND TRACKS IS LEGAL

MTAC.1:	CAIN	S2,.CT9TK		;9-TRACK TAPE?
	JRST	MTAC.2			;YES--ALL IS WELL SO FAR
	CAIN	S2,.CT7TK		;7-TRACK?
	JRST	E$DNT##			;DENSITY DOESN'T MATCH TRACK TYPE
	MOVEI	S2,.CT9TK		;1600/6250 BPI IMPLIES 9-TRACK
	STORE	S2,.CTVSC(E),CT.TRK	;UPDATE

MTAC.2:	LOAD	S1,.CTVFL(E),CT.FEL	;GET FILE ENTRY LENGTH
	CAIL	S1,.CTVSL+.MTLEN	;AT LEAST ONE UNIT?
	JRST	.POPJ1			;YES
	SKIPN	.CDMOD(C)		;MODIFY?
	JRST	E$NRV##			;NO REELS IN VOLUME SET
	JRST	E$ARV##			;MODIFY REMOVED LAST REEL IN VOL SET
MTAINS:	SETZM	.CDFIN(C)		;RESET INSERT FINISHED FLAG
	PUSHJ	P,C$GBLK##		;GET NEXT ARG BLOCK
	  JRST	E$OPR##			;OPR CMD ERROR
	CAIE	T1,.CMKEY		;KEYWORD?
	JRST	E$OPR##			;OPR CMD ERROR
	MOVE	S1,(T3)			;GET INDEX
	MOVSI	S2,-MTAMAX		;SET UP COUNTER
	CAME	S1,MTATAB(S2)		;A MATCH?
	AOBJN	S2,.-1			;CHECK ALL ENTRIES
	JUMPGE	S2,E$OPR##		;OPR CMD ERROR
	PUSHJ	P,@MTADSP(S2)		;DISPATCH
	  POPJ	P,			;PROPAGATE ERROR BACK
	SKIPE	.CDFIN(C)		;FINISHED?
	JRST	.POPJ1			;YES--RETURN
	PUSHJ	P,C$GBLK##		;GET NEXT ARG BLOCK
	  JRST	E$OPR##			;OPR CMD ERROR
	CAIN	T1,.CMCFM		;CONFIRMATION?
	JRST	MTAINS			;YES--BACK FOR ANOTHER LINE
	JRST	E$OPR##			;OPR CMD ERROR


DEFINE	SUBR,<

X	(.CTADD,ADD)			;ADD
X	(.CTDON,DON)			;DONE
X	(.CTQUI,QUI)			;QUIT
X	(.CTREM,REM)			;REMOVE

>

DEFINE	X	(NAME,ABRV),<EXP	NAME>
MTATAB:	SUBR
MTAMAX==.-MTATAB

DEFINE	X	(NAME,ABRV),<Z	MTA'ABRV>
MTADSP:	SUBR


MTADON:	SETOM	.CDFIN(C)		;MARK INSERT FINISHED
	JRST	.POPJ1			;AND RETURN
MTAQUI:	POPJ	P,
MTAADD:	$SAVE	<P1>			;SAVE P1
	PUSHJ	P,C$GBLK##		;GET NEXT ARG BLOCK
	  JRST	E$OPR##			;OPR CMD ERROR
	CAIE	T1,.CMFLD		;FIELD?
	JRST	E$OPR##			;OPR CMD ERROR
	LOAD	S1,.CTVFL(E),CT.NVL	;CURRENT NUMBER OF VOLUMES
	MOVNS	S1			;NEGATE
	HRLZ	P1,S1			;-COUNT IN LH
	HRRI	P1,.CTVSL(E)		;POINT TO START OF REELID STORAGE
	PUSHJ	P,MTARID		;GET 6 CHARACTER 8-BIT ASCII REELID
	JUMPGE	P1,MTAAD2		;JUMP IF NO REELS YET

MTAAD1:	CAMN	S1,.MTRID(P1)		;ALREADY
	CAME	S2,.MTRID+1(P1)		; EXISTING
	SKIPA				;  REELID?
	JRST	E$AEV##			;YES
	ADDI	P1,.MTLEN-1		;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJN	P1,MTAAD1		;LOOP THROUGH LIST

MTAAD2:	DMOVEM	S1,.MTRID(P1)		;SAVE REELID
	LOAD	S1,.CTVFL(E),CT.FEL	;GET FILE ENTRY LENGTH
	ADDI	S1,.MTLEN		;INCREMENT
	STORE	S1,.CTVFL(E),CT.FEL	;SET NEW FILE ENTRY LENGTH
	LOAD	S1,.CTVFL(E),CT.NVL	;CURRENT NUMBER OF VOLUMES
	ADDI	S1,1			;PLUS ONE
	STORE	S1,.CTVFL(E),CT.NVL	;UPDATE
	JRST	.POPJ1			;RETURN
MTAREM:	$SAVE	<P1>			;SAVE P1
	PUSHJ	P,C$GBLK##		;GET NEXT ARG BLOCK
	  JRST	E$OPR##			;OPR CMD ERROR
	CAIE	T1,.CMFLD		;FIELD?
	JRST	E$OPR##			;OPR CMD ERROR
	LOAD	S1,.CTVFL(E),CT.NVL	;CURRENT NUMBER OF VOLUMES
	MOVNS	S1			;NEGATE
	HRLZ	P1,S1			;-COUNT IN LH
	HRRI	P1,.CTVSL(E)		;POINT TO START OF REELID STORAGE
	PUSHJ	P,MTARID		;GET 6 CHARACTER 8-BIT ASCII REELID

MTARE1:	CAMN	S1,.MTRID(P1)		;REELID
	CAME	S2,.MTRID+1(P1)		; MATCH?
	SKIPA				;NO
	JRST	MTARE2			;YES--GO REMOVE IT
	ADDI	P1,.MTLEN-1		;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJN	P1,MTARE1		;LOOP
	JRST	E$NEV##			;NON-EXISTANT VOLUME

MTARE2:	ADDI	P1,.MTLEN-1		;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJP	P1,MTARE3		;ADVANCE POINTER
	DMOVE	S1,.MTRID(P1)		;GET REELID
	DMOVEM	S1,.MTRID-.MTLEN(P1)	;OVERWRITE PREVIOUS
	JRST	MTARE2			;LOOP

MTARE3:	SETZM	.MTRID-.MTLEN(P1)	;CLEAR PREVIOUS
	SETZM	.MTRID+1-.MTLEN(P1)	; REELID
	LOAD	S1,.CTVFL(E),CT.FEL	;GET FILE ENTRY LENGTH
	SUBI	S1,.MTLEN		;ADJUST
	STORE	S1,.CTVFL(E),CT.FEL	;SET NEW FILE ENTRY LENGTH
	LOAD	S1,.CTVFL(E),CT.NVL	;CURRENT NUMBER OF VOLUMES
	SUBI	S1,1			;MINUS ONE
	STORE	S1,.CTVFL(E),CT.NVL	;UPDATE
	JRST	.POPJ1			;AND RETURN
MTARID:	$SAVE	<P1,P2,P3,P4>		;SAVE SOME ACS
	MOVEI	S1,(T3)			;POINT TO 7-BIT STRING
	HRLI	S1,(POINT 7,)		;MAKE A BYTE POINTER
	MOVEI	S2,0			;INIT CHARACTER COUNT

MTARI1:	ILDB	TF,S1			;GET A CHARACTER
	SKIPE	TF			;NULL?
	AOJA	S2,MTARI1		;LOOP THROUGHT STRING
	MOVEI	P1,(T3)			;POINT TO 7-BIT ASCII STRING
	HRLI	P1,(POINT 7,)		;MAKE A BYTE POINTER
	MOVE	P2,[POINT 8,P3]		;BYTE POINTER TO 8-BIT STRING
	SETZB	P3,P4			;INIT

MTARI2:	ILDB	S1,P1			;GET A CHARACTER
	IDPB	S1,P2			;PUT A CHARACTER
	SOJG	S2,MTARI2		;LOOP CONVERTING TO 8-BIT
	DMOVE	S1,P3			;GET FINAL 8-BIT REELID
	POPJ	P,			;AND RETURN
MTALIS:	$SAVE	<P1>			;SAVE P1
	PUSHJ	P,MTAATR		;GENERATE ATTRIBUTE TEXT
	MOVEI	S1,.CTVLO(E)		;POINT TO LOCATION STRING
	HRLI	S1,(POINT 8,)		;MAKE A BYTE POINTER
	MOVEI	S2,[ITEXT (<^H9L/.CTVED(E)/>)]
	SKIPN	.CTVED(E)		;HAVE AN EXPIRATION DATE?
	MOVEI	S2,[ITEXT (<         >)];NO--BLANK OUT FIELD
	$TEXT	(C$TXTC##,<^D5R /.CDLDN(C)/  ^T39L /.CTVSN(E)/  ^Q19L /S1/  ^I/(S2)/   ^A>)
	LOAD	S1,.CTVFL(E),CT.NVL	;CURRENT NUMBER OF VOLUMES
	MOVNS	S1			;NEGATE
	MOVEI	P1,.CTVSL(E)		;OFFSET TO START OF UNITS
	HRL	P1,S1			;MAKE AN AOBJN POINTER
	PUSHJ	P,MTAUNI		;LIST REELID
	PUSHJ	P,C$LPPN##		;LIST THE PPN
	PUSHJ	P,C$LNAM##		;LIST NAME
	PUSHJ	P,C$CRLF##		;APPEND A CRLF
	MOVEI	S1,.CDTXA(C)		;POINT TO ATTRIBUTE TEXT
	SKIPE	(S1)			;SOMETHING THERE?
	$TEXT	(C$TXTC##,<          ^T69L/(S1)/^A>)
	ADDI	P1,.MTLEN-1		;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJP	P1,C$CRLF##		;SEE IF NORE THAN ONE UNIT

MTALI1:	MOVEI	S2,^D81			;SPACES TO FILL
	SKIPE	.CDTXA(C)		;PRINT ATTRIBUTE TEXT YET?
	MOVEI	S2,^D2			;YES
	SETZM	.CDTXA(C)		;CLEAR FOR NEXT TIME

MTALI2:	MOVEI	S1," "			;GET A SPACE
	PUSHJ	P,C$TXTC##		;LIST IT
	SOJG	S2,MTALI2		;LOOP
	PUSHJ	P,MTAUNI		;LIST REELID
	PUSHJ	P,C$CRLF##		;APPEND A CRLF
	ADDI	P1,.MTLEN-1		;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJN	P1,MTALI1		;LOOP THROUGH ALL REELIDS

MTALI3:	POPJ	P,			;RETURN


MTASHW:	PUSHJ	P,MTAATR		;GENERATE ATTRIBUTE TEXT
	MOVEI	S1,.CDTXA(C)		;POINT TO ATTRIBUTE BUFFER
	$TEXT	(C$TXTC##,<^M^J	^T/(S1)/^T/MTASHH/^A>)
	LOAD	S1,.CTVFL(E),CT.NVL	;CURRENT NUMBER OF VOLUMES
	MOVNS	S1			;NEGATE
	MOVEI	P1,.CTVSL(E)		;OFFSET TO START OF UNITS
	HRL	P1,S1			;MAKE AN AOBJN POINTER
	SETZM	.CDLDN(C)		;INIT DATA ITEM COUNTER

MTASH1:	AOS	S1,.CDLDN(C)		;COUNT THE REEL
	$TEXT	(C$TXTC##,<	^D6R /S1/  ^A>)
	PUSHJ	P,MTAUNI		;DISPLAY REELID
	PUSHJ	P,C$CRLF##		;APPEND A CRLF
	ADDI	P1,.MTLEN-1		;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJN	P1,MTASH1		;LOOP THROUGH ALL REELIDS
	PJRST	C$CRLF##		;FINISH WITH AN EXTRA CRLF

MTASHH:	ASCIZ	|
	Number  Reelid
	------  ------
|

MTAATR:	MOVX	S1,CT.LTS		;BIT TO TEST
	TDNN	S1,.CTVSC(E)		;LABEL TYPE SET?
	SKIPA	S1,[EXP -1]		;NO
	LOAD	S1,.CTVSC(E),CT.LAB	;GET LABEL TYPE
	MOVE	TF,LABTAB(S1)		;AND TEXT
	LOAD	S1,.CTVSC(E),CT.TRK	;GET TRACK INDEX
	MOVE	S1,TRKTAB(S1)		;AND TEXT
	LOAD	S2,.CTVSC(E),CT.DEN	;GET DENSITY INDEX
	MOVE	S2,DENTAB(S2)		;AND TEXT
	$TEXT	(<-1,,.CDTXA(C)>,<Label type: ^T/@TF/  Tracks: ^T/(S1)/  Density: ^T/(S2)/^0>)
	POPJ	P,			;RETURN


	[ASCIZ	/Default/]
LABTAB:	[ASCIZ	/Bypass/]
	[ASCIZ	/ANSI/]
	[ASCIZ	/ANSI-USER/]
	[ASCIZ	/IBM/]
	[ASCIZ	/IBM-USER/]
	[ASCIZ	/Leading-tape-mark/]
	[ASCIZ	/Non-standard/]
	[ASCIZ	/Nolabels/]
	[ASCIZ	/COBOL-ASCII/]
	[ASCIZ	/COBOL-SIXBIT/]
	[ASCIZ	/User-EOT/]

TRKTAB:	[ASCIZ	/unknown/]
	[ASCIZ	/7/]
	[ASCIZ	/9/]

DENTAB:	[ASCIZ	/unknown/]
	[ASCIZ	/200/]
	[ASCIZ	/556/]
	[ASCIZ	/800/]
	[ASCIZ	/1600/]
	[ASCIZ	/6250/]
MTAUNI:	$SAVE	<P1>			;SAVE P1
	MOVEI	P1,.MTRID(P1)		;POINT TO REELID
	HRLI	P1,(POINT 8,)		;MAKE A BYTE POINTER
	MOVEI	S2,6			;SIX CHARACTERS

MTAUN1:	ILDB	S1,P1			;GET A CHARACTER
	CAIN	S1,.CHNUL		;NULL?
	MOVEI	S1," "			;CONVERT TO A SPACE
	PUSHJ	P,C$TXTC##		;OUTPUT
	SOJG	S2,MTAUN1		;LOOP
	MOVEI	S1," "			;ADVANCE
	PUSHJ	P,C$TXTC##		; TO THE
	MOVEI	S1," "			;  NEXT
	PJRST	C$TXTC##		;   COLUMN

	PRGEND
TITLE	CATSTR - Structure interface to the DECsystem-10 Catalog Daemon
SUBTTL	D. Mastrovito /DPM	1-Aug-84

	SEARCH	CATPRM
	CATDEF	(CATSTR)

	.LINK	DEVLNK,C$STR
C$STR::	BLOCK	1		;LINK TO NEXT DISPATCH VECTOR
	EXP	.CTSTR		;CATALOG DEVICE TYPE
	EXP	STRDAT		;DATA BASE ADDRESS
	[ASCIZ	|Structure|]	;DATA BASE NAME
	EXP	.STLEN		;WORDS PER VOLUME STORAGE
	EXP	STRMNV		;MAXIMUM NUMBER OF VOLUMES IN A VOLUME-SET
	EXP	STRLIH		;LIST HEADER
	EXP	STRCHK		;CHECK ENTRY
	EXP	STRINS		;INSERT ENTRY
	EXP	STRLIS		;LIST ENTRY
	EXP	STRSHW		;SHOW ENTRY
	EXP	.POPJ1		;PROCESS /REELID

STRDAT:	BLOCK	.CDLEN
STRCHK:	LOAD	S1,.CTVFL(E),CT.FEL	;GET FILE ENTRY LENGTH
	CAIL	S1,.CTVSL+.STLEN	;AT LEAST ONE UNIT?
	JRST	.POPJ1			;YES
	SKIPN	.CDMOD(C)		;MODIFY?
	JRST	E$NUS##			;NO UNITS IN STRUCTURE
	JRST	E$ARU##			;MODIFY REMOVED LAST UNIT IN STRUCTURE
STRINS:	SETZM	.CDFIN(C)		;RESET INSERT FINISHED FLAG
	PUSHJ	P,C$GBLK##		;GET NEXT ARG BLOCK
	  JRST	E$OPR##			;OPR CMD ERROR
	CAIE	T1,.CMKEY		;KEYWORD?
	JRST	E$OPR##			;OPR CMD ERROR
	MOVE	S1,(T3)			;GET INDEX
	MOVSI	S2,-STRMAX		;SET UP COUNTER
	CAME	S1,STRTAB(S2)		;A MATCH?
	AOBJN	S2,.-1			;CHECK ALL ENTRIES
	JUMPGE	S2,E$OPR##		;OPR CMD ERROR
	PUSHJ	P,@STRDSP(S2)		;DISPATCH
	  POPJ	P,			;PROPAGATE ERROR BACK
	SKIPE	.CDFIN(C)		;FINISHED?
	JRST	.POPJ1			;YES--RETURN
	PUSHJ	P,C$GBLK##		;GET NEXT ARG BLOCK
	  JRST	E$OPR##			;OPR CMD ERROR
	CAIN	T1,.CMCFM		;CONFIRMATION?
	JRST	STRINS			;YES--BACK FOR ANOTHER LINE
	JRST	E$OPR##			;OPR CMD ERROR


DEFINE	SUBR,<

X	(.CTADD,ADD)			;ADD
X	(.CTDON,DON)			;DONE
X	(.CTQUI,QUI)			;QUIT
X	(.CTREM,REM)			;REMOVE

>
DEFINE	X	(NAME,ABRV),<EXP	NAME>
STRTAB:	SUBR
STRMAX==.-STRTAB

DEFINE	X	(NAME,ABRV),<Z	STR'ABRV>
STRDSP:	SUBR


STRDON:	SETOM	.CDFIN(C)		;MARK INSERT FINISHED
	JRST	.POPJ1			;AND RETURN
STRQUI:	POPJ	P,
STRADD:	$SAVE	<P1>			;SAVE P1
	PUSHJ	P,C$GBLK##		;GET NEXT ARG BLOCK
	  JRST	E$OPR##			;OPR CMD ERROR
	CAIE	T1,.CMFLD		;FIELD?
	JRST	E$OPR##			;OPR CMD ERROR
	LOAD	S1,.CTVFL(E),CT.NVL	;CURRENT NUMBER OF VOLUMES
	MOVNS	S1			;NEGATE
	HRLZ	P1,S1			;-COUNT IN LH
	HRRI	P1,.CTVSL(E)		;POINT TO START OF UNIT STORAGE
	HRROI	S1,(T3)			;POINT TO UNIT-ID
	$CALL	S%SIXB			;CONVERT TO SIXBIT
	JUMPGE	P1,STRAD2		;JUMP IF NO UNITS YET

STRAD1:	CAMN	S2,.STUID(P1)		;ALREADY EXISTING UNIT?
	JRST	E$AEV##			;YES
	ADDI	P1,.STLEN-1		;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJN	P1,STRAD1		;LOOP THROUGH LIST

STRAD2:	MOVEM	S2,.STUID(P1)		;SAVE UNIT-ID
	PUSHJ	P,C$GBLK##		;GET NEXT ARG BLOCK
	  JRST	E$OPR##			;OPR CMD ERROR
	CAIE	T1,.CMKEY		;KEYWORD?
	JRST	E$OPR##			;OPR CMD ERROR
	MOVSI	S1,-UNIMAX		;COUNTER
	MOVE	S2,(T3)			;GET PARSED KONT AND TYPE
	CAME	S2,UNICMD(S1)		;MATCH?
	AOBJN	S1,.-1			;NO
	JUMPE	S1,E$OPR##		;OPR CMD ERROR
	STORE	S2,.STUCH(P1),ST.UTY	;SAVE UNIT TYPE CODE
	LSH	S2,-11			;POSITION
	STORE	S2,.STUCH(P1),ST.UKT	;SAVE KONTROLLER CODE
	PUSHJ	P,C$GBLK##		;GET NEXT ARG BLOCK
	  JRST	E$OPR##			;OPR CMD ERROR
	CAIE	T1,.CMNUM		;NUMBER?
	JRST	E$OPR##			;OPR CMD ERROR
	MOVE	S1,(T3)			;GET CLASS CODE
	STORE	S1,.STUCH(P1),ST.UCL	;SAVE
	LOAD	S1,.CTVFL(E),CT.FEL	;GET FILE ENTRY LENGTH
	ADDI	S1,.STLEN		;GET TOTAL WORDS PER UNIT
	STORE	S1,.CTVFL(E),CT.FEL	;SET NEW FILE ENTRY LENGTH
	LOAD	S1,.CTVFL(E),CT.NVL	;CURRENT NUMBER OF VOLUMES
	ADDI	S1,1			;PLUS ONE
	STORE	S1,.CTVFL(E),CT.NVL	;UPDATE
	JRST	.POPJ1			;RETURN
STRREM:	$SAVE	<P1>			;SAVE P1
	PUSHJ	P,C$GBLK##		;GET NEXT ARG BLOCK
	  JRST	E$OPR##			;OPR CMD ERROR
	CAIE	T1,.CMFLD		;FIELD?
	JRST	E$OPR##			;OPR CMD ERROR
	LOAD	S1,.CTVFL(E),CT.NVL	;CURRENT NUMBER OF VOLUMES
	MOVNS	S1			;NEGATE
	HRLZ	P1,S1			;-COUNT IN LH
	HRRI	P1,.CTVSL(E)		;POINT TO START OF UNIT STORAGE
	HRROI	S1,(T3)			;POINT TO UNIT-ID
	$CALL	S%SIXB			;CONVERT TO SIXBIT

STRRE1:	CAMN	S2,.STUID(P1)		;UNIT-ID MATCH?
	JRST	STRRE2			;YES
	ADDI	P1,.STLEN-1		;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJN	P1,STRRE1		;LOOP
	JRST	E$NEV##			;NON-EXISTANT VOLUME

STRRE2:	ADDI	P1,.STLEN-1		;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJP	P1,STRRE3		;ADVANCE POINTER
	MOVE	S1,.STUID(P1)		;GET UNIT-ID
	MOVEM	S1,.STUID-.STLEN(P1)	;OVERWRITE PREVIOUS
	MOVE	S1,.STUCH(P1)		;GET UNIT CHARACTERISTICS WORD
	MOVEM	S1,.STUCH-.STLEN(P1)	;OVERWRITE PREVIOUS
	JRST	STRRE2			;LOOP

STRRE3:	SETZM	.STUID-.STLEN(P1)	;CLEAR PREVIOUS UNIT-ID
	SETZM	.STUCH-.STLEN(P1)	;CLEAR PREVIOUS UNIT CHARACTERISTICS
	LOAD	S1,.CTVFL(E),CT.FEL	;GET FILE ENTRY LENGTH
	SUBI	S1,.STLEN		;ADJUST
	STORE	S1,.CTVFL(E),CT.FEL	;SET NEW FILE ENTRY LENGTH
	LOAD	S1,.CTVFL(E),CT.NVL	;CURRENT NUMBER OF VOLUMES
	SUBI	S1,1			;MINUS ONE
	STORE	S1,.CTVFL(E),CT.NVL	;UPDATE
	JRST	.POPJ1			;AND RETURN
STRLIS:	$SAVE	<P1>			;SAVE P1
	MOVEI	S1,.CTVLO(E)		;POINT TO LOCATION TEXT
	HRLI	S1,(POINT 8,)		;MAKE A BYTE POINTER
	MOVEI	S2,[ITEXT (<^H9L/.CTVED(E)/>)]
	SKIPN	.CTVED(E)		;HAVE AN EXPIRATION DATE?
	MOVEI	S2,[ITEXT (<         >)];NO--BLANK OUT FIELD
	$TEXT	(C$TXTC##,<^D5R /.CDLDN(C)/  ^T6L /.CTVSN(E)/  ^Q19L /S1/  ^I/(S2)/   ^A>)
	PUSHJ	P,C$LPPN##		;LIST THE PPN
	$TEXT	(C$TXTC##,<  ^A>)
	LOAD	S1,.CTVFL(E),CT.NVL	;CURRENT NUMBER OF VOLUMES
	MOVNS	S1			;NEGATE
	MOVEI	P1,.CTVSL(E)		;OFFSET TO START OF UNITS
	HRL	P1,S1			;MAKE AN AOBJN POINTER
	PUSHJ	P,STRUNI		;LIST UNIT, TYPE, CLASS, LOCATION
	PUSHJ	P,C$LNAM##		;LIST NAME
	PUSHJ	P,C$CRLF##		;APPEND A CRLF
	ADDI	P1,.STLEN-1		;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJP	P1,STRLI3		;SEE IF NORE THAN ONE UNIT

STRLI1:	MOVEI	S2,^D63			;SPACES TO FILL

STRLI2:	MOVEI	S1," "			;GET A SPACE
	PUSHJ	P,C$TXTC##		;LIST IT
	SOJG	S2,STRLI2		;LOOP
	PUSHJ	P,STRUNI		;LIST UNIT, TYPE, CLASS, LOCATION
	PUSHJ	P,C$CRLF##		;APPEND A CRLF
	ADDI	P1,.STLEN-1		;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJN	P1,STRLI1		;LOOP THROUGH ALL UNITS

STRLI3:	POPJ	P,			;RETURN

STRLIH:	ASCIZ	|
  Structure     Storage  location   Expiration       PPN        Unit    Type   Class  Name
-------------  -------------------  ----------  -------------  ------  ------  -----  ----
|
STRSHW:	$TEXT	(C$TXTC##,<^T/STRSHH/^A>) ;OUTPUT HEADER
	LOAD	S1,.CTVFL(E),CT.NVL	;CURRENT NUMBER OF VOLUMES
	MOVNS	S1			;NEGATE
	MOVEI	P1,.CTVSL(E)		;OFFSET TO START OF UNITS
	HRL	P1,S1			;MAKE AN AOBJN POINTER

STRSH1:	MOVEI	S1,.CHTAB		;START OUT EACH
	PUSHJ	P,C$TXTC##		; LINE WITH A TAB
	PUSHJ	P,STRUNI		;DISPLAY UNIT, TYPE, CLASS, LOCATION
	PUSHJ	P,C$CRLF##		;APPEND A CRLF
	ADDI	P1,.STLEN-1		;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJN	P1,STRSH1		;LOOP THROUGH ALL UNITS
	PJRST	C$CRLF##		;FINISH WITH AN EXTRA CRLF
STRUNI:	MOVE	T1,.STUID(P1)		;GET UNIT-ID
	MOVE	S1,.STUCH(P1)		;GET UNIT CHARACTERISTICS WORD
	ANDX	S1,ST.UKT!ST.UTY	;KEEP JUST KONT AND TYPE INFO
	MOVSI	S2,-UNIMAX		;COUNTER
	CAME	S1,UNIFIL(S2)		;MATCH?
	AOBJN	S2,.-1			;NO
	SKIPL	S2			;FOUND A MATCH?
	SKIPA	T2,['??????']		;NO
	MOVE	T2,UNINAM(S2)		;GET UNIT NAME
	LOAD	T3,.STUCH(P1),ST.UCL	;GET CLASS CODE
	$TEXT	(C$TXTC##,<^W6L /T1/  ^W6L /T2/   ^O2R /T3/  ^A>)
	POPJ	P,			;RETURN


STRSHH:	ASCIZ	|
	 Unit    Type   Class
	------  ------  -----
|

DEFINE	X	(NAME,KONT,TYPE),<<SIXBIT |NAME|>>
UNINAM:	DSKUNI

DEFINE	X	(NAME,KONT,TYPE),<<KONT>B26+<TYPE>B35>
UNICMD:	DSKUNI

DEFINE	X	(NAME,KONT,TYPE),<INSVL.(KONT,ST.UKT)!INSVL.(TYPE,ST.UTY)>
UNIFIL:	DSKUNI
UNIMAX==.-UNIFIL


	END