Google
 

Trailing-Edge - PDP-10 Archives - cuspmar86binsrc_1of2_bb-x128b-sb - 10,7/catlog/catlog.mac
There are 2 other files named catlog.mac in the archive. Click here to see a list.
TITLE	CATLOG - DECsystem10 Mountable Device Catalog Daemon
SUBTTL	D. Mastrovito /DPM	26-Nov-85

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1986. ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE INCLUSION
;OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER COPIES THEREOF
;MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO
;TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

	SEARCH	CATPRM			;CATALOG DEFINITIONS
	CATDEF	(CATLOG)		;DEFINE COMMON PARAMETERS

	LOC	<.JBVER==:137>
	EXP	%%CAT			;VERSION NUMBER

	RELOC	0
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1983,1986. ALL RIGHTS RESERVED.
\;END OF COPYRIGHT MACRO

; GLXLIB Initialization Block
IB:	$BUILD	(IB.SZ)			;SIZE OF BLOCK
	  $SET	(IB.PRG,FWMASK,%%.MOD)	;PROGRAM NAME
	  $SET	(IB.FLG,IP.STP,1)	;SEND STOPCODES TO ORION
	  $SET	(IB.PIB,FWMASK,PIB)	;ADDRESS OF PIB
	  $SET	(IB.INT,FWMASK,VECTOR)	;ADDRESS OF PSI VECTORS
	$EOB				;END OF BLOCK

; PID Initialization Block
PIB:	$BUILD	(PB.MNS)		;SIZE OF BLOCK
	  $SET	(PB.HDR,PB.LEN,PB.MNS)	;LENGTH OF THIS BLOCK
	  $SET	(PB.FLG,IP.PSI,1)	;USE PSI FOR IPCF
	  $SET	(PB.FLG,IP.RSE,1)	;RETURN ON SEND FAILURES
;	  $SET	(PB.FLG,IP.JWP,1)	;USE A JOB-WIDE PID
	  $SET	(PB.FLG,IP.SPF,1)	;CREATE A SYSTEM PID
	  $SET	(PB.INT,IP.CHN,IPCOFS)	;OFFSET TO IPCF INTRUPT BLOCK
	  $SET	(PB.INT,IP.SPI,SP.CAT)	;PID IS FOR [SYSTEM]CATALOG
	  $SET	(PB.SYS,IP.SQT,^D511)	;INFINITE SEND QUOTA
	  $SET	(PB.SYS,IP.RQT,^D511)	;INFINITE RECEIVE QUOTA
	$EOB
G$PDL::	BLOCK	PDLSIZ			;PUSH DOWN LIST
G$UDT::	BLOCK	1			;CURRENT DATE/TIME
G$SAB::	BLOCK	SAB.SZ			;IPCF SEND ARGUMENT BLOCK
G$MSG::	BLOCK	PAGSIZ+1		;IPCF MESSAGE STORAGE
G$SND:: BLOCK	1			;SENDER'S PID
G$SID:: BLOCK	1			;SENDER'S ID
G$PRV:: BLOCK	1			;SENDER'S PRIVS
G$FLG:: BLOCK	1			;IPCF RECEIVE FLAGS
G$IDX:: BLOCK	1			;SENDER'S SPECIAL PID INDEX
G$ACK:: BLOCK	1			;NON-ZERO IF SENDER WANTS AN ACK
G$COD:: BLOCK	1			;ACK CODE
G$QSTR::BLOCK	1			;QUEUE STRUCTURE
G$SPPN::BLOCK	1			;SYSTEM FILE PPN
G$SPRT::BLOCK	1			;SYSTEM FILE PROTECTION
G$GLXN:	BLOCK	1			;GALAXY WORLD NAME
G$APLT::BLOCK	1			;APPLICATION NAME
G$APLV::BLOCK	1			;APPLICATION NAME AND VERSION

IPCQUE:	BLOCK	1			;IPCF RESEND QUEUE LINKED LIST
OPRPID:	BLOCK	1			;[SYSTEM]OPERATOR PID
MDAPID:	BLOCK	1			;[SYSTEM]MDA PID
RSENDC:	BLOCK	1			;COUNT OF RESENDS NEEDED
ERRPTR:	BLOCK	1			;ERROR BUFFER BYTE POINTER
ERRCNT:	BLOCK	1			;ERROR COUNTER
ERRFLG:	BLOCK	1			;ERROR FLAGS, CLASS, AND CODE
ERRTXT:	BLOCK	1			;ERROR ITEXT BLOCK ADDRESS
ERRBUF:	BLOCK	ERRLEN			;ERROR BUFFER
MSGLEN:	BLOCK	1			;REQUESTED MESSAGE LENGTH
MSGBLK:	BLOCK	1			;ADDRESS OF CURRENT BLOCK IN MESSAGE
MSGCNT:	BLOCK	1			;COUNT OF MESSAGE BLOCKS TO PROCESS
APLPPN:	BLOCK	1			;OUR PPN
APLCOD:	BLOCK	1			;APPLICATION CODE
ENTBLK::BLOCK	PAGSIZ			;FILE ENTRY
CNVBLK::BLOCK	PAGSIZ			;CONVERSION FILE ENTRY
VECTOR:!				;PSI VECTORS
VECIPC:	BLOCK	4			;IPCF VECTOR
   IPCOFS==<VECIPC-VECTOR>		;IPCF VECTOR OFFSET

	.LNKEN	1,C$DSP			;START OF DISPATCH VECTOR CHAIN
C$DSP::	BLOCK	1			;FILLED IN BY LINK
CATLOG:	JFCL				;NO CCL ENTRY
	MOVE	P,[IOWD	PDLSIZ,G$PDL]	;SET UP STACK
	MOVEI	S1,IPCINT		;IPCF INTERRUPT ROUTINE ADDRESS
	MOVEM	S1,VECIPC+.PSVNP	;SAVE IN VECTOR
	MOVEI	S1,IB.SZ		;IB LENGTH
	MOVEI	S2,IB			;IB ADDRESS
	PUSHJ	P,I%INIT##		;FIRE UP GLXLIB
	$CALL	I%ION			;TURN ON THE PSI SYSTEM
	PUSHJ	P,INITIA		;INITIALIZE

MAIN:	SKIPE	RSENDC			;MEESAGES TO RESEND?
	PUSHJ	P,RESEND		;TRY TO DO THEM NOW
	PUSHJ	P,IPCF			;TRY TO PROCESS IPCF MESSAGES
	MOVEI	S1,ZZTIME		;TIME TO SNOOZE
	$CALL	I%SLP			;ZZZZZZ
	PUSHJ	P,PIDCHK		;CHECK THE PIDS
	JRST	MAIN			;BACK TO TOP LEVEL
SUBTTL	Initialization


INITIA:	MOVEI	S1,GLXNM1		;ASSUME NORMAL PRODUCTION MODE
	SKIPE	DEBUGW			;DEBUGGING?
	MOVEI	S1,GLXNM2		;YES
	MOVEM	S1,G$GLXN		;SAVE
	$CALL	L%CLST			;CREATE A NEW ONE
	MOVEM	S1,IPCQUE		;SAVE HANDLE
	PUSHJ	P,OPRINI		;INIT [SYSTEM]OPERATOR INTERFACE
	PUSHJ	P,MDAINI		;INIT [SYSTEM]MDA INTERFACE
	POPJ	P,			;RETURN

GLXNM1:	ITEXT	(<[SYSTEM]>)
GLXNM2:	ITEXT	(<^U/DEBUGW/>)
SUBTTL	Initialization -- [SYSTEM]OPERATOR interface


OPRINI:	MOVEI	S1,SP.OPR		;GET [SYSTEM]OPERATOR PID INDEX
	$CALL	C%RPRM			;ASK FOR THE PID
	JUMPT	OPRI.1			;JUMP IF WE HAVE IT
	MOVEI	S1,1			;TIME TO WASTE
	$CALL	I%SLP			;ZZZZZZ
	JRST	OPRINI			;TRY AGAIN

OPRI.1:	MOVEM	S1,OPRPID		;SAVE FOR POSTERITY
	MOVEI	M,AHLMSG		;POINT TO APPLICATION HELLO MSG
	PUSHJ	P,C$SOPR		;SEND TO ORION
	SETZM	APLCOD			;NO APPLICATION CODE YET
	MOVNI	S1,1			;-1 FOR OUR JOB
	MOVEI	S2,JI.USR		;NEED OUR PPN
	$CALL	I%JINF			;ASK FOR IT
	MOVEM	S2,APLPPN		;SAVE IT AWAY
	MOVEI	S1,APLTX1		;ASSUME [SYSTEM]CATALOG
	SKIPE	DEBUGW			;DEBUGGING?
	MOVEI	S1,APLTX2		;YES--THEN IT'S A PRIVATE ONE
	MOVEM	S1,G$APLT		;SAVE
	MOVEI	S1,APLTX3		;ASSUME [SYSTEM]CATALOG %XXX
	SKIPE	DEBUGW			;DEBUGGING?
	MOVEI	S1,APLTX4		;YES--THEN IT'S A PRIVATE ONE
	MOVEM	S1,G$APLV		;SAVE
	POPJ	P,			;RETURN


; Application HELLO message
AHLMSG:	$BUILD	(.OHDRS)		;SIZE OF BLOCK
	  $SET	(.MSTYP,MS.TYP,.OMAHL)	;APPLICATION HELLO CODE
	  $SET	(.MSTYP,MS.CNT,AHLLEN)	;LENGTH
	  $SET	(.OARGC,,1)		;1 ARGUMENT BLOCK
	$EOB				;END OF BLOCK

	$BUILD	(ARG.DA)		;SIZE OF BLOCK
	  $SET	(ARG.HD,AR.TYP,.AHNAM)	;BLOCK TYPE
	  $SET	(ARG.HD,AR.LEN,AHNLEN)	;LENGTH OF NAME
	$EOB
	ASCIZ	|CATALOG|		;APPLICATION NAME
AHNLEN==.-AHLMSG-.OHDRS			;APPLICATION NAME LENGTH
AHLLEN==.-AHLMSG			;MESSAGE LENGTH

APLTX1:	ITEXT	(<[SYSTEM]CATALOG>)
APLTX2:	ITEXT	(<^U/APLPPN/CATALOG>)
APLTX3:	ITEXT	(<[SYSTEM]CATALOG %^V/.JBVER/>)
APLTX4:	ITEXT	(<^U/APLPPN/CATALOG %^V/.JBVER/>)
SUBTTL	Initialization -- [SYSTEM]MDA interface


MDAINI:	MOVEI	S1,SP.MDA		;GET PID INDEX FOR [SYSTEM]MDA
	$CALL	C%RPRM			;ASK FOR THE PID
	JUMPF	MDAI.1			;OK IF NOT THERE
	PUSHJ	P,RQST			;REQUEST QUEUE STRUCTURE

MDAI.1:	MOVE	S1,[%LDSYS]		;NEED THE SYSTEM FILE PPN
	GETTAB	S1,			;ASK MONITOR
	  MOVE	S1,[1,,4]		;DEFAULT TO [1,4]
	SKIPE	DEBUGW			;DEBUGGING?
	MOVEI	S1,0			;YES--USE OUR PPN
	MOVEM	S1,G$SPPN		;SAVE
	MOVE	S1,[%LDSSP]		;NEED THE .SYS FILE PROTECTION
	GETTAB	S1,			;ASK MONITOR
	  MOVSI	S1,(<157>B8)		;DEFAULT TO <157>
	MOVEM	S1,G$SPRT		;SAVE
	MOVE	S1,C$DSP		;POINT TO FIRST DISPATCH VECTOR

MDAI.2:	MOVE	C,.CVDAT(S1)		;POINT TO DATA BASE
	MOVEI	S2,.CWDNI		;GET WAIT STATE CODE
	MOVEM	S2,.CDWSC(C)		;MARK DATA BASE NOT INITIALIZED
	SKIPE	S1,.CVLNK(S1)		;POINT TO NEXT DEVICE DISPATCH
	JRST	MDAI.2			;LOOP
	POPJ	P,			;RETURN
SUBTTL	Initialization -- Device catalogs


DEVINI:	$SAVE	<P1,P2,P3>		;SAVE SOME ACS
	MOVE	P1,C$DSP		;POINT TO FIRST DISPATCH VECTOR
	SETZ	P3,			;DON'T KNOWN ACTUAL STR NAME YET

DEVI.1:	PUSHJ	P,DEVI.2		;FIRE UP THIS DEVICE
	  PUSHJ	P,IPCERR		;COMPLAIN ABOUT ERRORS
	SKIPE	P1,.CVLNK(P1)		;POINT TO NEXT DEVICE DISPATCH
	JRST	DEVI.1			;AND GO INITIALIZE
	POPJ	P,			;RETURN

DEVI.2:	MOVE	C,.CVDAT(P1)		;POINT TO DATA BASE
	SKIPE	S1,.CDPIF(C)		;GET PRIMARY FILE IFN
	$CALL	F%RREL			;RELEASE IT
	SKIPE	S1,.CDPML(C)		;GET PENDING IPCF MESSAGE LIST
	$CALL	L%DLST			;DELETE IT
	SKIPE	S1,.CDCOR(C)		;GET CORE ALLOCATION LIST
	$CALL	L%DLST			;DELETE IT
	MOVSI	S1,(C)			;FIRST CLEAR OUT
	HRRI	S1,1(C)			;DATA BASE
	SETZM	(C)			;CLEAR FIRST WORD
	BLT	S1,.CDLEN-1(C)		;CLEAR ENTIRE BLOCK OUT
	MOVSI	S1,(P1)			;POINT TO A DISPATCH VECTOR
	HRRI	S1,(C)			;MAKE A BLT POINTER
	BLT	S1,.CVLEN-1(C)		;LOAD DISPATCH VECTOR
	$CALL	L%CLST			;CREATE LINKED LIST HANDLE FOR
	MOVEM	S1,.CDPML(C)		; PENDING IPCF MESSAGES
	$CALL	L%CLST			;CREATE LINKED LIST FOR CORE ALLOCATION
	MOVEM	S1,.CDCOR(C)		;SAVE HANDLE
	MOVEI	S1,.CWDNI		;GET WAIT STATE CODE
	MOVEM	S1,.CDWSC(C)		;MARK DATA BASE NOT INITIALIZED
	MOVE	S1,.CVFMT(C)		;GET CURRENT FILE FORMAT NUMBER
	MOVEM	S1,.CDFMT(C)		;SAVE
	PUSHJ	P,C$TBLC		;CREATE INITIAL TABLE
	  POPJ	P,			;PROPAGATE ERROR BACK

DEVI.3:	PUSHJ	P,C$PFIL		;SET UP PRIMARY DATA FILE
	PUSHJ	P,C$IOPN		;OPEN FOR INPUT
	  JRST	DEVI.7			;FAILED
	JUMPN	P3,DEVI.4		;JUMP IF WE KNOW THE ACTUAL STR NAME
	MOVE	S1,.CDPFD+.FDSTR(C)	;GET ACTUAL STRUCTURE NAME
	MOVEM	S1,G$QSTR		;NO--DO IT NOW
	AOS	P3			;DO THIS ONLY ONCE

DEVI.4:	PUSHJ	P,C$PRFM		;READ FILE FORMAT NUMBER
	  JRST	DEVI.7			;I/O ERROR
	CAMN	S1,.CVFMT(C)		;CURRENT FORMAT?
	JRST	DEVI.5			;YES
	PUSHJ	P,@.CVCVT(C)		;ELSE CONVERT TO CURRENT
	  POPJ	P,			;PROPAGATE ERROR BACK
	PUSHJ	P,E$CVT			;GENERATE CONVERSION MESSAGE
	PUSHJ	P,IPCERR		;TELL THE WORLD
	JRST	DEVI.3			;AND RESTART

DEVI.5:	MOVE	P2,.CDPFP(C)		;GET CURRENT POSITION
	MOVEI	E,ENTBLK		;POINT TO STORAGE
	PUSHJ	P,C$PREN		;READ THE ENTRY
	  JRST	DEVI.6			;DONE
	PUSHJ	P,C$AVSN		;ALLOCATE VSN STORAGE
	  POPJ	P,			;PROPAGATE ERROR BACK
	HRR	S2,P2			;GET POSITION IN FILE
	PUSHJ	P,C$TBLA		;ADD TO TABLE
	  POPJ	P,			;PROPAGATE ERROR BACK
	JRST	DEVI.5			;LOOP FOR ALL ENTRIES

DEVI.6:	MOVE	S1,.CDTAB(C)		;POINT TO TABLE
	HLRZ	S1,(S1)			;GET NUMBER OF ENTRIES
	PUSHJ	P,@.CVINI(C)		;DO SPECIAL INITIALIZATION
	  POPJ	P,			;FAILED
	MOVEI	S1,.CWRUN		;GET WAIT STATE CODE
	MOVEM	S1,.CDWSC(C)		;MARK DATA BASE VALID AND USABLE
	AOS	.CDUPD(C)		;INDICATE UPDATES ARE ALLOWED
	JRST	.POPJ1			;RETURN

DEVI.7:	MOVE	S2,.CVFMT(C)		;GET FORMAT FROM DISPATCH VECTOR
	MOVEM	S2,.CDPFM(C)		;SAVE FOR PRIMARY FILE IF OPENED LATER
	POPJ	P,			;RETURN WITH FILE ERROR IN S1
SUBTTL	Initialization -- QSTCHK - Check for queue structure


; Here when [SYSTEM]MDA hasn't told us what the queue structure is
; and we've received a request for catalog information (probably
; from [SYSTEM]OPERATOR.  This special code is needed incase a site
; is setting up their catalog for the first time and a full blown
; GALAXY system isn't running (runnable?) yet.  This routine is also
; useful for debugging CATLOG.
; Call:	MOVE	C, dispatch
;	PUSHJ	P,QSTCHK
;	<RETURN>

QSTCHK:	SKIPE	G$QSTR			;HAVE A QUEUE STRUCTURE?
	POPJ	P,			;YES
	MOVSI	S1,'SSL'		;ASSUME STANDARD DEFAULT
	MOVEM	S1,G$QSTR		;SAVE
	PUSHJ	P,DEVINI		;TRY TO INITIALIZE DATA BASES
	POPJ	P,			;RETURN
SUBTTL	IPCF/Operator/QUASAR interface -- IPCF interrupt processing


IPCINT:	$BGINT	(1)			;SWITCH TO INTERRUPT CONTEXT
	$CALL	C%INTR			;TELL LIBRARY WE HAVE A MESSAGE
	$DEBRK				;DISMISS INTERRUPT
SUBTTL	IPCF/Operator/QUASAR interface -- IPCF message processing


IPCF:	$CALL	C%RECV			;TRY TO RECEIVE A MESSAGE
	JUMPF	.POPJ			;NONE THERE--RETURN
	PUSHJ	P,IPCSET		;SET UP ALL SORTS OF VARIABLES
	  JRST	IPCF.X			;ERROR OF SOME SORT
	LOAD	S1,.MSTYP(M),MS.TYP	;GET MESSAGE TYPE
	PUSH	P,S1			;SAVE IT
	$CALL	I%NOW			;GET CURRENT DATE/TIME
	MOVEM	S1,G$UDT		;SAVE FOR TIMESTAMPING
	MOVE	S1,MSGPTR		;GET POINTER TO MESSAGE TABLE

IPCF.1:	HLRZ	S2,(S1)			;GET TYPE FROM TABLE
	CAME	S2,(P)			;A MATCH?
	AOBJN	S1,IPCF.1		;KEEP SEARCHING
	SKIPL	S1			;POINTER POSITIVE IF NO MATCH
	MOVEI	S1,MSGTAB		;UNKNOWN MESSAGE TYPE
	POP	P,(P)			;TRIM STACK
	HRRZ	S1,(S1)			;GET PROCESSOR ADDRESS
	PUSHJ	P,(S1)			;DISPATCH
	SKIPE	ERRFLG			;NEED TO ERROR ACK?
	PUSHJ	P,IPCERR		;YES

IPCF.X:	$CALL	C%REL			;RELEASE MESSAGE
	JRST	IPCF			;TRY FOR ANOTHER PACKET


; Message dispatch table
MSGTAB:	XWD	000000,UNKMSG		;?????? UNKNOWN MESSAGES
	XWD	.CFRCT,RCAT		;CATLOG REQUEST FOR CATALOG INFO
	XWD	.CFAQS,AQST		;CATLOG ANSWER TO REQUEST FOR QUEUE STR
	XWD	.CFINS,INSERT		;CATALOG INSERT BY MDA
	XWD	.CFMOD,MODIFY		;CATALOG MODIFY BY MDA
	XWD	.OMHAC,AACK		;ORION  APPLICATION ACK
	XWD	.OMCMD,OPRCMD		;ORION  OPERATOR COMMAND MESSAGE
	XWD	MT.TXT,ACK		;ACKS
NUMMSG==.-MSGTAB
MSGPTR:	-NUMMSG,,MSGTAB			;AOBJN POINTER TO MESSAGE TABLE
; Routine to set up for IPCF message processing
IPCSET:	SETZB	C,ERRFLG		;ZAP DATA BASE POINTER AND ERROR CODE
	SETZM	G$ACK			;ASSUME NO ACK WANTED
	MOVE	S2,MDB.SP(S1)		;GET THE SENDERS PID
	MOVEM	S2,G$SND		;AND SAVE IT
	MOVE	S2,MDB.SD(S1)		;GET THE SENDERS ID
	MOVEM	S2,G$SID		;AND SAVE IT
	MOVE	S2,MDB.PV(S1)		;GET SENDERS CAPABILITIES
	MOVEM	S2,G$PRV		;SAVE THAT AS WELL
	MOVE	S2,MDB.SI(S1)		;GET THE SENDERS SPECIAL PID INDEX
	MOVEM	S2,G$IDX		;STORE IT
	MOVE	S2,MDB.FG(S1)		;GET FLAG WORD
	MOVEM	S2,G$FLG		;SAVE
	LOAD	M,MDB.MS(S1),MD.ADR	;POINT M AT INCOMMING PACKET
	MOVE	S1,.MSCOD(M)		;GET THE MESSAGE ACK CODE
	MOVEM	S1,G$COD		;AND SAVE IT
	MOVEI	S1,.OHDRS+ARG.HD(M)	;POINT TO FIRST BLOCK IN MESSAGE
	MOVEM	S1,MSGBLK		;SAVE
	MOVE	S1,.OARGC(M)		;GET ARGUMENT BLOCK COUNT
	MOVEM	S1,MSGCNT		;SAVE
	SETZM	G$ACK			;ASSUME NO ACK WANTED
	MOVX	S1,MF.ACK		;GET ACK BIT
	TDNE	S1,.MSFLG(M)		;IS IT SET?
	SETOM	G$ACK			;SENDER WANTS AN ACK
	LOAD	S1,G$IDX,SI.IDX		;GET THE SENDERS SPECIAL PID INDEX
	JUMPE	S1,.POPJ1		;RETURN IF SENDER IS NO ONE SPECIAL
	LOAD	S2,.MSTYP(M),MS.TYP	;GET MESSAGE TYPE
	CAIN	S1,SP.GFR		;THE GOPHER?
	CAIE	S2,.IPCQU		;QUEUE. UUO?
	JRST	.POPJ1			;NO
	PUSHJ	P,QUEUUO		;TRANSLATE QUEUE. UUO INTO IPCF MSG
	  JRST	E$QFE			;QUEUE. UUO FORMAT ERROR
	MOVEI	S1,.OHDRS+ARG.HD(M)	;POINT TO FIRST BLOCK IN MESSAGE
	MOVEM	S1,MSGBLK		;SAVE
	MOVE	S1,.OARGC(M)		;GET ARGUMENT BLOCK COUNT
	MOVEM	S1,MSGCNT		;SAVE
	JRST	.POPJ1			;RETURN
SUBTTL	IPCF/Operator/QUASAR interface -- Resend messages


RESEND:	$SAVE	<P1,P2>			;SAVE P1 AND P2
	SETZB	P1,P2			;CLEAR PREVIOUS PID AND INDEX
	MOVE	S1,IPCQUE		;GET LINKED LIST FOR RESENDS
	$CALL	L%FIRS			;POSITION TO FIRST ENTRY
	JRST	RESE.2			;ENTER LOOP

RESE.1:	MOVE	S1,IPCQUE		;GET LINKED LIST FOR RESENDS
	$CALL	L%NEXT			;POSITION TO NEXT ENTRY

RESE.2:	JUMPF	.POPJ			;RETURN IF END OF LIST
	MOVSI	S1,(S2)			;POINT TO SAVED SAB
	HRRI	S1,G$SAB		;AND WORKING COPY
	BLT	S1,G$SAB+SAB.SZ-1	;RETRIEVE FROM LIST
	MOVE	M,G$SAB+SAB.MS		;POINT TO THE MESSAGE
	MOVE	S1,G$SAB+SAB.LN		;GET MESSAGE LENGTH
	TRNN	M,PAGSIZ-1		;ON A PAGE BOUNDRY?
	CAIE	S1,PAGSIZ		;AND A PAGE IN LENGTH?
	MOVEI	M,SAB.SZ(S2)		;NO--POINT TO SAVED MESSAGE
	MOVEM	M,G$SAB+SAB.MS		;UPDATE
	CAMN	P1,G$SAB+SAB.PD		;THIS PID SAME AS LAST ONE?
	CAME	P2,G$SAB+SAB.SI		;INDEX THE SAME TOO?
	JRST	RESE.1			;YES--IGNORE SINCE LAST SEND FAILED
	MOVEI	S1,SAB.SZ		;SAB LENGTH
	MOVEI	S2,G$SAB		;SAB ADDRESS
	$CALL	C%SEND			;SEND MESSAGE
	JUMPT	RESE.3			;DELETE FROM QUEUE IF SUCESSFUL
	CAIE	S1,ERNSP$		;NO SUCH PID?
	CAIN	S1,ERPWA$		;PID WENT AWAY?
	JRST	RESE.3			;JUST REMOVE FROM QUEUE
	MOVE	P1,G$SAB+SAB.PD		;COPY PID
	MOVE	P2,G$SAB+SAB.SI		;AND INDEX
	JRST	RESE.1			;TRY ANOTHER TO RESEND TO ANOTHER PID

RESE.3:	SETZB	P1,P2			;CLEAR PREVIOUS PID AND INDEX
	MOVE	S1,IPCQUE		;ELSE MUST DELETE
	$CALL	L%DENT			;THE QUEUE ENTRY
	SOSE	RSENDC			;COUNT DOWN
	JRST	RESE.1			;GO TRY ANOTHER RESEND
	POPJ	P,			;QUEUE IS EMPTY
SUBTTL	IPCF/Operator/QUASAR interface -- Wait for a system PID to restart


; Here to wait for the system PID
PIDWAI:	$SAVE	<P1>			;SAVE P1
	SKIPA	P1,S1			;COPY PID INDEX

PIDW.1:	MOVE	S1,P1			;GET THE PID INDEX
	$CALL	C%RPRM			;ASK FOR THE PID
	JUMPT	PIDW.2			;GOT IT
	MOVEI	S1,1			;TIME TO WASTE
	$CALL	I%SLP			;ZZZZZZ
	JRST	PIDW.1			;TRY AGAIN

PIDW.2:	CAIE	P1,SP.OPR		;[SYSTEM]OPERATOR?
	JRST	PIDW.3			;NO
	PUSHJ	P,OPRINI		;RESTART COMMUMICATIONS
	SETOM	APLCOD			;FLAG RESTART
	PUSHJ	P,E$ROP			;GENERATE RESTART TEXT
	PJRST	IPCERR			;SEND MESSAGE AND RETURN

PIDW.3:	CAIE	P1,SP.QSR		;QUASAR?
	CAIN	P1,SP.MDA		;MDA?
	SKIPA				;YES
	JRST	PIDW.5			;NO
	PUSH	P,G$QSTR		;SAVE CURRENT QUEUE STRUCTURE
	PUSHJ	P,MDAINI		;GET NEW QUESTR FROM MDA
	POP	P,S1			;RETRIEVE OLD ONE
	CAME	S1,G$QSTR		;QUESTR CHANGE?
	JRST	PIDW.4			;NO
	PUSHJ	P,E$RMI			;BUILD RE-INIT MESSAGE
	PUSHJ	P,IPCERR		;SEND IT OFF
	PUSHJ	P,DEVINI		;RE-INIT DEVICE CATALOGS

PIDW.4:	PUSHJ	P,E$RMN			;BUILD RESTART MESSAGE
	PUSHJ	P,IPCERR		;SEND IT OFF

PIDW.5:	POPJ	P,			;DONE
SUBTTL	IPCF/Operator/QUASAR interface -- PID checking


PIDCHK:	MOVEI	S1,SP.OPR		;GET THE PID INDEX FOR [SYSTEM]OPERATOR
	$CALL	C%RPRM			;ASK FOR THE PID
	JUMPF	PIDC.1			;SHOULDN'T FAIL
	CAMN	S1,OPRPID		;SAME AS BEFORE?
	JRST	PIDC.1			;YES
	PUSHJ	P,OPRINI		;RESTART COMMUMICATIONS
	SETOM	APLCOD			;FLAG RESTART
	PUSHJ	P,E$ROP			;GENERATE RESTART TEXT
	PUSHJ	P,IPCERR		;SEND IT OFF

PIDC.1:	MOVEI	S1,SP.MDA		;GET THE PID INDEX FOR [SYSTEM]MDA
	$CALL	C%RPRM			;ASK FOR THE PID
	JUMPF	.POPJ			;SHOULDN'T FAIL
	EXCH	S1,MDAPID		;SWAP
	CAME	S1,MDAPID		;SAME AS BEFORE?
	PUSHJ	P,RQST			;NO--REQUEST QUEUE STRUCTURE INFO
	POPJ	P,			;RETURN
SUBTTL	IPCF/Operator/QUASAR interface -- Error ACK generation


IPCERR:	$SAVE	<P1>			;SAVE P1
	PUSHJ	P,C$SETM		;SET UP MESSAGE
	MOVE	P1,ERRFLG		;GET THE ERROR FLAGS+CLASS AND CODE
	TLZE	P1,AM.ACK		;ACK?
	MOVEI	S1,.OMACK		;YES
	TLZE	P1,AM.LOG		;LOG?
	MOVEI	S1,.OMLOG		;YES
	TLZE	P1,AM.WTO		;WTO?
	MOVEI	S1,.OMWTO		;YES
	LOAD	S2,G$IDX,SI.IDX		;GET THE SENDERS SPECIAL PID INDEX
	CAIN	S2,SP.GFR		;THE GOPHER ONLY REALLY
	MOVEI	S1,MT.TXT		; UNDERSTANDS "TEXT" ACKS
	STORE	S1,.MSTYP(M),MS.TYP	;SET MESSAGE TYPE
	MOVEM	P1,ERRFLG		;UPDATE FLAGS
	MOVE	S1,G$COD		;GET ACK CODE
	MOVEM	S1,.MSCOD(M)		;SAVE
	MOVX	S1,WT.SJI		;SUPPRESS JOB INFO
	MOVEM	S1,.OFLAG(M)		;SAVE
	MOVEI	P1,.OHDRS(M)		;POINT TO FIRST DATA WORD
	HLRZ	S1,ERRFLG		;GET CLASS
	CAIN	S2,SP.GFR		;GOPHER?
	JRST	IPCE.2			;YES
	CAIN	S1,.AMTXT		;SIMPLE ACK?
	JRST	IPCE.3			;YES

IPCE.1:	MOVEI	S2,.WTTYP		;BLOCK TYPE
	STORE	S2,ARG.HD(P1),AR.TYP	;SAVE
	HLRZ	S2,ERRTYP(S1)		;GET MESSAGE PREFIX
	STORE	S2,.MSFLG(M),MF.SUF	;SAVE
	HRRZ	S2,ERRTYP(S1)		;GET TYPE TEXT
	$TEXT	(<-1,,ARG.DA(P1)>,<^I/(S2)/^0>) ;GENERATE TYPE TEXT
	PUSHJ	P,IPCE.L		;COMPUTE AND STORE BLOCK LENGTH
	MOVEI	S1,.WTTXT		;NEXT BLOCK TYPE
	JRST	IPCE.4			;ONWARD

IPCE.2:	MOVX	S2,MF.FAT		;GET THE FATAL BIT
	IORM	S2,.MSFLG(M)		;SET FOR IPCSER
	HLRZ	S2,ERRTYP(S1)		;GET PREFIX
	STORE	S2,.MSFLG(M),MF.SUF	;SAVE
	SKIPA	S1,[.CMTXT]		;GOPHER ONLY UNDERSTANDS "TEXT" ACKS
IPCE.3:	MOVEI	S1,.WTTYP		;BLOCK TYPE
IPCE.4:	STORE	S1,ARG.HD(P1),AR.TYP	;SAVE
	$TEXT	(<-1,,ARG.DA(P1)>,<^T/ERRBUF/^0>) ;GENERATE MESSAGE TEXT
	PUSHJ	P,IPCE.L		;COMPUTE AND STORE BLOCK LENGTH
	SUBI	P1,(M)			;COMPUTE TOTAL MESSAGE LENGTH
	STORE	P1,.MSTYP(M),MS.CNT	;SAVE
	LOAD	S1,G$IDX,SI.IDX		;GET SENDERS PID INDEX
	CAIE	S1,SP.GFR		;GOPHER?
	PJRST	C$SOPR			;SEND TO [SYSTEM]OPERATOR
	PJRST	C$SGFR			;SEND TO [SYSTEM]GOPHER


; Compute and store length of current text block
IPCE.L:	MOVEI	S1,ARG.DA(P1)		;INIT ADDRESS
	SKIPE	(S1)			;END OF TEXT?
	AOJA	S1,.-1			;LOOP
	SUBI	S1,ARG.HD-ARG.DA(P1)	;COMPUTE WORDS ADDED
	STORE	S1,ARG.HD(P1),AR.LEN	;SAVE
	AOS	.OARGC(M)		;COUNT THE BLOCK
	ADDI	P1,(S1)			;ADVANCE TO NEXT FREE BLOCK
	POPJ	P,			;AND RETURN
SUBTTL	IPCF/Operator/QUASAR interface -- Message block processing


; Get the next block of a message
; Call:	PUSHJ	P,C$GBLK
;	<NON-SKIP>		;END OF MESSAGE
;	<SKIP>			;NEXT BLOCK FOUND
;
; On error return, T1, T2 and T3 left unchanged
; On sucessful return, T1= type, T2= length, T3= data address
;
; AC usage:	Destroys S1
;
C$GBLK::SOSGE	MSGCNT			;SUBTRACT 1 FROM THE BLOCK COUNT
	POPJ	P,			;ERROR RETURN IF NO MORE
	MOVE	S1,MSGBLK		;GET THE PREVIOUS BLOCK ADDRESS
	LOAD	T1,ARG.HD(S1),AR.TYP	;GET THE BLOCK TYPE
	LOAD	T2,ARG.HD(S1),AR.LEN	;GET THE BLOCK LENGTH
	MOVEI	T3,ARG.DA(S1)		;GET THE BLOCK DATA ADDRESS
	ADD	S1,T2			;POINT TO THE NEXT MESSAGE BLOCK
	MOVEM	S1,MSGBLK		;SAVE IT FOR THE NEXT CALL
	JRST	.POPJ1			;RETURN SUCESSFUL
; Set up the catalog data base from the OPR command message
C$DATA::TDZA	S1,S1			;NORMAL ENTRY POINT
C$DATX::MOVEI	S1,1			;HERE REGARDLESS OF WAIT STATE
	$SAVE	<P1>			;SAVE P1
	MOVE	P1,S1			;SAVE FLAG
	PUSHJ	P,C$GBLK		;GET NEXT ARG BLOCK
	  JRST	E$OPR			;OPR CMD ERROR
	CAIE	T1,.CMKEY		;A KEYWORD?
	JRST	E$OPR			;OPR CMD ERROR
	MOVE	S1,C$DSP		;POINT TO START OF DISPATCH TABLES

DATA.1:	MOVE	S2,.CVTYP(S1)		;GET CATALOG DEVICE TYPE
	CAMN	S2,(T3)			;A MATCH?
	JRST	DATA.2			;YES
	SKIPE	S1,.CVLNK(S1)		;POINT TO NEXT
	JRST	DATA.1			;TRY AGAIN
	JRST	E$OPR			;OPR CMD ERROR

DATA.2:	MOVE	C,.CVDAT(S1)		;POINT TO DATA STORAGE
	JUMPN	P1,.POPJ1		;RETURN IF LEGAL IN ANY WAIT STATE
	MOVEI	S1,.CWDNI		;WAIT STATE TO CHECK
	CAMN	S1,.CDWSC(C)		;DATA BASE INITIALIZED?
	JRST	E$CNA			;NO--CATALOG NOT AVAILABLE
	JRST	.POPJ1			;RETURN
SUBTTL	IPCF/Operator/QUASAR interface -- Send setup


; Setup a message
; Call:	PUSHJ	P,C$SETM
;
; On return, M= message address
;
C$SETM::MOVEI	S1,PAGSIZ		;LENGTH
	MOVEM	S1,MSGLEN		;SAVE REQUESTED LENGTH
	MOVEI	M,G$MSG			;POINT TO MESSAGE STORAGE
	TRNN	M,PAGSIZ-1		;ON A PAGE BOUNDRY?
	ADDI	M,1			;YES--DON'T WANT TO IPCF IT AWAY
	MOVSI	S1,(M)			;START ADDRESS
	HRRI	S1,1(M)			;MAKE A BLT POINTER
	SETZM	(M)			;CLEAR FIRST WORD
	BLT	S1,PAGSIZ-1(M)		;CLEAR MESSAGE STORAGE
	MOVE	S1,G$COD		;GET ACK CODE
	MOVEM	S1,.MSCOD(M)		;SAVE
	POPJ	P,			;DONE
SUBTTL	IPCF/Operator/QUASAR interface -- Unknown message


UNKMSG:	JRST	E$UIM			;UNKNOWN IPCF MESSAGE

UNKTXT:	ITEXT	(<                  Unknown IPCF message
Sender: ^O12R0/G$SND/, ^U/G$SID/
Header: ^O12R0/.MSTYP(M)/, ^O12R0/.MSFLG(M)/, ^O12R0/.MSCOD(M)/>)
SUBTTL	IPCF/Operator/QUASAR interface -- GOPHER message #000040 (QUEUE. UUO)


QUEUUO:	$SAVE	<P1,P2>			;SAVE P1 AND P2
	$CALL	M%GPAG			;GET A PAGE
	MOVE	P1,S1			;COPY ADDRESS
	MOVE	S1,[.CTVSL+.OHDRS,,.CFRCT] ;LENGTH,,FUNCTION CODE
	MOVEM	S1,.MSTYP(P1)		;SAVE
	MOVE	S1,G$COD		;GET ACK CODE
	MOVEM	S1,.MSCOD(P1)		;SAVE
	AOS	.OARGC(P1)		;ONLY ONE BLOCK ALLOWED
	MOVEI	P2,.OHDRS(P1)		;POINT TO START OF BLOCK DESCRIPTOR
	MOVE	S1,[.CTVSL,,.CTVSN]	;LENGTH,,BLOCK TYPE
	MOVEM	S1,ARG.HD(P2)		;SAVE
	ADDI	P2,ARG.DA		;ADVANCE TO START OF DATA

QUEU.1:	PUSHJ	P,C$GBLK		;FIND A BLOCK
	  JRST	QUEU.3			;END OF MESSAGE
	MOVE	S1,QUEPTR		;AOBJN POINTER

QUEU.2:	HLRZ	S2,(S1)			;GET A BLOCK TYPE
	CAIE	S2,(T1)			;A MATCH?
	AOBJN	S1,QUEU.2		;LOOP
	JUMPGE	S1,.POPJ		;CHECK FOR ERRORS
	HRRZ	S2,(S1)			;GET PROCESSOR ADDRESS
	PUSHJ	P,(S2)			;DISPATCH
	  POPJ	P,			;ERROR
	JRST	QUEU.1			;LOOP THROUGH THE MESSAGE

QUEU.3:	MOVSI	S1,(P1)			;POINT TO NEW MESSAGE
	HRRI	S1,(M)			;AND TO THE OLD ONE
	BLT	S1,PAGSIZ-1(M)		;OVERWRITE QUEUE. UUO WITH IPCF MSG
	MOVE	S1,P1			;GET SCRATCH PAGE ADDRESS BACK
	$CALL	M%RPAG			;RELEASE IT
	JRST	.POPJ1			;RETURN

QUETAB:	XWD	.QBACT,.POPJ1		;ACCOUNT STRING (NOOP)
	XWD	.QBFNC,.POPJ1		;FUNCTION WORD (NOOP)
	XWD	.QBNOD,.POPJ1		;NODE (NOOP)
	XWD	.QBNAM,.POPJ1		;NAME (NOOP)
	XWD	.QBVSN,QBVSN		;VOLUME-SET NAME
	XWD	.QBMFG,QBMFG		;FLAGS
QUETLN==.-QUETAB			;LENGTH OF TABLE
QUEPTR:	-QUETLN,,QUETAB			;POINTER TO QUEUE. UUO TABLE
; VOLUME-SET NAME
QBVSN:	MOVSI	S1,(T3)			;POINT TO VSN
	HRRI	S1,.CTVSN(P2)		;DESTINATION
	MOVEI	S2,-1(T2)		;GET SPECIFIED LENGTH
	ADDI	S2,.CTVSN(P2)		;COMPUTE END OF BLT
	BLT	S1,-1(S2)		;COPY VOLUME-SET NAME
	JRST	.POPJ1			;RETURN


; FLAGS
QBMFG:	CAIE	T2,2			;MUST BE A SINGLE WORD (+OVERHEAD)
	POPJ	P,			;IT ISN'T
	SETZ	S1,			;CLEAR RESULT
	MOVE	S2,(T3)			;GET FLAGS
	TXNE	S2,-1-QB.DTA!QB.TAP!QB.DSK ;CHECK FOR JUNK FLAGS
	POPJ	P,			;NO GOOD
	TXNE	S2,QB.DTA		;DECTAPE?
	MOVEI	S1,.CTDTA		;YES
	TXNE	S2,QB.TAP		;MAGTAPE?
	MOVEI	S1,.CTMTA		;YES
	TXNE	S2,QB.DSK		;STRUCTURE?
	MOVEI	S1,.CTSTR		;YES
	STORE	S1,.CTVFL(P2),CT.TYP	;SAVE CATALOG TYPE
	JRST	.POPJ1			;RETURN
SUBTTL	IPCF/Operator/QUASAR interface -- CATALOG message #100001 (REQ INFO)


RCAT:	$SAVE	<P1,P2>			;SAVE P1 AND P2
	PUSHJ	P,QSTCHK		;DEFAULT QUEUE STRUCTURE IF NECESSARY
	PUSHJ	P,C$MVSN		;FIND THE REQUESTED VSN
	  JRST	RCAT.4			;FAILED
	PUSHJ	P,C$SETM		;SET UP SEND
	PUSHJ	P,C$PRIV		;DO PRIV CHECKING
	  JRST	E$VNF			;REQUESTOR IS NOBODY SPECIAL
	MOVEI	S1,.CFACT		;MESSAGE TYPE
	STORE	S1,.MSTYP(M),MS.TYP	;SAVE
	MOVEI	P1,.OHDRS(M)		;POINT TO FIRST FREE WORD
	LOAD	S1,G$IDX,SI.IDX		;GET THE SENDERS SPECIAL PID INDEX
	CAIN	S1,SP.GFR		;RESPONDING TO [SYSTEM]GOPHER?
	ADDI	P1,ARG.DA		;YES--RESERVE ROOM FOR .CMTXT HEADER
	MOVEI	S1,.CTVSB		;VOLUME-SET BLOCK TYPE
	STORE	S1,ARG.HD(P1),AR.TYP	;SAVE
	MOVEI	S1,.CTVSL		;BLOCK LENGTH
	STORE	S1,ARG.HD(P1),AR.LEN	;SAVE
	MOVSI	S1,.CTVFL(E)		;SET UP TO COPY
	HRRI	S1,ARG.DA(P1)		; THE VOLUME-SET DATA
	BLT	S1,ARG.DA+.CTVSL-1(P1)	;COPY
	ADDI	P1,.CTVSL		;ADVANCE POINTER TO NEXT FREE WORD
	AOS	.OARGC(M)		;COUNT THE BLOCK
	LOAD	S1,.CTVFL(E),CT.NVL	;GET NUMBER OF VOLUMES IN VOLUME-SET
	JUMPE	S1,RCAT.3		;FINISH UP IF NO VOLUMES
	MOVNS	S1			;NEGATE
	HRLZ	P2,S1			;GET -COUNT
	HRRI	P2,.CTVSL(E)		;POINT TO FIRST VOLUME

RCAT.2:	MOVEI	S1,.CTVLB		;VOLUME BLOCK TYPE
	STORE	S1,ARG.HD(P1),AR.TYP	;SAVE
	MOVE	S1,.CVWVS(C)		;GET WORDS PER VOLUME STORAGE
	ADDI	S1,ARG.DA		;PLUS MESSAGE OVERHEAD
	STORE	S1,ARG.HD(P1),AR.LEN	;SAVE
	MOVSI	S1,(P2)			;POINT TO VOLUME STORAGE
	HRRI	S1,ARG.DA(P1)		;WHERE TO STORE IN MESSAGE
	MOVEI	S2,ARG.DA(P1)		;START ADDRESS
	ADD	S2,.CVWVS(C)		;COMPUTE END BLT ADDRESS
	BLT	S1,-1(S2)		;COPY
	LOAD	S1,ARG.HD(P1),AR.LEN	;GET TOTAL MESSAGE BLOCK LENGTH BACK
	ADDI	P1,(S1)			;ADVANCE POINTER
	AOS	.OARGC(M)		;COUNT THE BLOCK
	ADD	P2,.CVWVS(C)		;ADVANCE VOLUME BLOCK POINTER
	SUBI	P2,1			;ACCOUNT FOR NEXT INSTRUCTION
	AOBJN	P2,RCAT.2		;LOOP THROUGH VOLUMES

RCAT.3:	SUBI	P1,(M)			;COMPUTE MESSAGE LENGTH
	STORE	P1,.MSTYP(M),MS.CNT	;SAVE
	LOAD	S1,G$IDX,SI.IDX		;GET THE SENDERS SPECIAL PID INDEX
	CAIE	S1,SP.GFR		;GOPHER?
	PJRST	C$SMDA			;SEND MESSAGE TO [SYSTEM]MDA
	MOVEI	S1,MT.TXT		;THE GOPHER ONLY REALLY
	STORE	S1,.MSTYP(M),MS.TYP	; UNDERSTANDS "TEXT" ACKS
	HLLZ	S1,.OHDRS+ARG.DA(M)	;MUST ENCAPSULATE THE ENTIRE RESPONSE
	ADD	S1,[ARG.DA,,.CMTXT]	; IN A .CMTXT BLOCK SO THE CALLER
	MOVEM	S1,.OHDRS+ARG.HD(M)	;  GETS HIS RESPONSE BLOCK FILLED IN
	PJRST	C$SGFR			;SEND MESSAGE TO [SYSTEM]GOPHER

RCAT.4:	LOAD	S2,G$IDX,SI.IDX		;GET THE SENDERS SPECIAL PID INDEX
	CAIN	S2,SP.GFR		;GOPHER?
	POPJ	P,			;YES--ACK VIA ERROR HANDLING CODE
	CAIE	S2,SP.QSR		;QUASAR?
	CAIN	S2,SP.MDA		;MDA?
	SKIPA				;YES
	POPJ	P,			;ACK WITH ERROR TEXT
	SETZM	ERRFLG			;DON'T SEND TEXT ACK
	PUSHJ	P,C$SETM		;SET UP SEND
	MOVEI	S1,.CFACT		;MESSAGE TYPE
	STORE	S1,.MSTYP(M),MS.TYP	;SAVE
	MOVEI	S1,.OHDRS		;LENGTH
	STORE	S1,.MSTYP(M),MS.CNT	;SAVE
	MOVX	S1,MF.FAT		;FLAG FATAL ERROR
	MOVEM	S1,.MSFLG(M)		;SAVE
	PJRST	C$SMDA			;SEND MESSAGE TO [SYSTEM]MDA
SUBTTL	IPCF/Operator/QUASAR interface -- CATALOG message #100003 (REQ QUESTR)


RQST:	PUSHJ	P,C$SETM		;SET UP SEND
	MOVE	S1,G$QSTR		;GET OLD QUEUE STRUCTURE
	MOVEM	S1,.MSCOD(M)		;MAKE THAT OUR ACK CODE
	MOVEI	S1,.CFRQS		;MESSAGE TYPE
	STORE	S1,.MSTYP(M),MS.TYP	;SAVE
	MOVEI	S1,.OHDRS		;LENGTH
	STORE	S1,.MSTYP(M),MS.CNT	;SAVE
	PUSHJ	P,C$SMDA		;SEND TO MDA
	POPJ	P,			;AND RETURN
SUBTTL	IPCF/Operator/QUASAR interface -- CATALOG message #100004 (ANS QUESTR)


AQST:	MOVE	S1,.OHDRS(M)		;GET QUEUE STRUCTURE NAME
	SKIPE	DEBUGW			;DEBUGGING?
	MOVSI	S1,'DSK'		;YES
	JUMPE	S1,.POPJ		;NO NAME IS NO GOOD
	EXCH	S1,G$QSTR		;SWAP WITH OLD
	JUMPE	S1,AQST.1		;FIRST TIME THROUGH?
	CAMN	S1,G$QSTR		;DID QUEUE STRUCTURE CHANGE?
	JRST	AQST.2			;NO
	PUSHJ	P,E$RMI			;BUILD RE-INIT MESSAGE
	PUSHJ	P,IPCERR		;SEND IT OFF

AQST.1:	PUSHJ	P,DEVINI		;INIT DEVICE CATALOGS
	POPJ	P,			;AND RETURN

AQST.2:	SKIPN	.MSCOD(M)		;UNSOLICITED ANSWER?
	POPJ	P,			;NO--STARTUP SEQUENCE OUT OF SYNCH
	PUSHJ	P,E$RMN			;BUILD RESTART MESSAGE
	PUSHJ	P,IPCERR		;SEND IT OFF
	POPJ	P,			;DONE
SUBTTL	IPCF/Operator/QUASAR interface -- CATALOG message #100006 (DISABLE)
SUBTTL	IPCF/Operator/QUASAR interface -- CATALOG message #100007 (ENABLE)


DISENA:	PUSHJ	P,C$SETM		;SET UP SEND
	MOVEI	S1,.CFDIS		;ASSUME DISABLE
	SKIPE	.CDUPD(C)		;ENABLES ALLOWED?
	MOVEI	S1,.CFENA		;YES
	STORE	S1,.MSTYP(M),MS.TYP	;SAVE MESSAGE TYPE
	SETZM	.MSCOD(M)		;NO ACK CODE
	MOVE	S1,.CVTYP(C)		;GET THIS CATALOG DEVICE TYPE
	MOVEM	S1,.OFLAGS(M)		;SAVE
	MOVEI	S1,.OHDRS		;LENGTH OF MESSAGE
	STORE	S1,.MSTYP(M),MS.CNT	;SAVE
	PUSHJ	P,C$SMDA		;SEND MESSAGE TO MDA
	POPJ	P,			;RETURN
SUBTTL	IPCF/Operator/QUASAR interface -- CATALOG message #1000010 (INSERT)


INSERT:	PUSHJ	P,QSTCHK		;DEFAULT QUEUE STRUCTURE IF NECESSARY
	PJRST	.INSER			;JOIN COMMON OPR PARSING CODE
SUBTTL	IPCF/Operator/QUASAR interface -- CATALOG message #1000011 (MODIFY)


MODIFY:	PUSHJ	P,QSTCHK		;DEFAULT QUEUE STRUCTURE IF NECESSARY
	PJRST	.MODIF			;JOIN COMMON OPR PARSING CODE
SUBTTL	IPCF/Operator/QUASAR interface -- ORION message #200020 (APL ACK)


AACK:	PUSHJ	P,C$GBLK		;GET ARGUMENT BLOCK
	  JRST	E$APL			;BAD APPLICATION MESSAGE
	CAIN	T1,.AHTYP		;APPLICATION CODE?
	CAIE	T2,2			;TWO WORDS?
	JRST	E$APL			;BAD APPLICATION MESSAGE
	MOVE	S1,(T3)			;GET CODE
	EXCH	S1,APLCOD		;SAVE FOR LATER REFERENCE
	CAME	S1,[EXP -1]		;RESTART?
	JRST	E$STR			;GENERATE STARTING MESSAGE AND RETURN
	JRST	E$RST			;ELSE IT'S A RESTART MESSAGE


AACKT1:	ITEXT	(<Application code = ^O/APLCOD/>)
SUBTTL	IPCF/Operator/QUASAR interface -- ORION message #200050 (OPR CMD)


OPRCMD:	PUSHJ	P,QSTCHK		;DEFAULT QUEUE STRUCTURE IF NECESSARY
	MOVE	S1,MSGBLK		;GET CURRENT BLOCK ADDRESS
	MOVE	T1,MSGCNT		;GET COUNT OF BLOCKS
	MOVE	T2,0(S1)		;GET APPLICATION CODE
	MOVE	T3,1(S1)		;GET NODE (INCASE OF ERROR)
	SKIPLE	T1			;CHECK BLOCK COUNT
	CAME	T2,APLCOD		;MATCHING APPLICATION CODE
	JRST	E$APL			;APPLICATION MESSAGE SCREWUP
	ADDI	S1,(T1)			;OFFSET TO ARG BLOCK COUNT
	MOVE	S2,(S1)			;GET COUNT
	MOVEM	S2,MSGCNT		;SAVE
	ADDI	S1,1			;ADVANCE TO FIRST APPLICATION ARG
	MOVEM	S1,MSGBLK		;UPDATE
	PUSHJ	P,C$GBLK		;GET INITIAL BLOCK
	  JRST	E$OPR			;OPR CMD ERROR
	CAIE	T1,.CMKEY		;MUST START WITHA KEYWORD
	JRST	E$OPR			;OPR CMD ERROR
	MOVSI	S1,-CMDMAX		;SET COUNTER

OPRC.1:	HLRZ	S2,CMDTAB(S1)		;GET OPERATOR COMMAND CODE
	CAME	S2,(T3)			;A MATCH?
	AOBJN	S1,OPRC.1		;KEEP SEARCHING
	JUMPGE	S1,E$OPR		;OPR CMD ERROR
	HRRZ	S2,CMDTAB(S1)		;GET PROCESSOR ADDRESS
	JRST	(S2)			;DISPATCH

CMDTAB:	XWD	.CTDEL,.DELET		;DELETE
	XWD	.CTDIS,.DISAB		;DISABLE
	XWD	.CTENA,.ENABL		;ENABLE
	XWD	.CTHLP,E$OPR		;HELP
	XWD	.CTINS,.INSER		;INSERT
	XWD	.CTLIS,.LIST		;LIST
	XWD	.CTMOD,.MODIF		;MODIFY
	XWD	.CTSHO,.SHOW		;SHOW
CMDMAX==.-CMDTAB			;LENGTH OF TABLE
SUBTTL	IPCF/Operator/QUASAR interface -- ACK message #700000


ACK:	$SAVE	<P1>			;SAVE P1
	MOVE	P1,C$DSP		;POINT TO FIRST DISPATCH VECTOR
	MOVX	S2,MF.NOM		;GET THE 'NO MESSAGE' BIT
	SKIPE	S1,.MSCOD(M)		;GET ACK CODE (IF ANY)
	TDNN	S2,.MSFLG(M)		;ALL GOOD ACKS HAVE THIS BIT SET
	JRST	ACK.3			;MUST BE SOME JUNK TEXT ACK

ACK.1:	MOVE	C,.CVDAT(P1)		;POINT TO DATA BASE
	CAMN	S1,.CDACK(C)		;A MATCH?
	JRST	ACK.2			;YES
	SKIPE	P1,.CVLNK(P1)		;POINT TO NEXT
	JRST	ACK.1			;LOOP
	JRST	E$UPA			;UNEXPECTED PROCESS ACK

ACK.2:	SETZM	.CDACK(C)		;CLEAR FOR NEXT TIME
	POPJ	P,			;RETURN FOR NOW

ACK.3:	SKIPN	.OARGC(M)		;QUASAR SNIFFING AROUND?
	POPJ	P,			;YES--JUST RETURN
	LOAD	S1,.MSFLG(M),MF.SUF	;GET SUFFIX
	CAIE	S1,'ODE'		;OPR DOES NOT EXIST?
	JRST	E$UTA			;NO--UNEXPECTED TEXT ACK
	POPJ	P,			;RETURN
C$SGFR::MOVE	S2,[SI.FLG+SP.GFR]	;SEND TO [SYSTEM]GOPHER
	MOVEI	S1,0			;DON'T USE A REAL PID
	JRST	C$SEND			;GO SEND MESSAGE

C$SMDA::SKIPA	S2,[SI.FLG+SP.MDA]	;SEND TO [SYSTEM]MDA
C$SOPR::MOVE	S2,[SI.FLG+SP.OPR]	;SEND TO [SYSTEM]OPERATOR
	MOVEI	S1,0			;DON'T USE A REAL PID

C$SEND::MOVEM	S1,G$SAB+SAB.PD		;SAVE PID
	MOVEM	S2,G$SAB+SAB.SI		;SAVE SPECIAL PID INDEX WORD
	LOAD	S1,.MSTYP(M),MS.CNT	;GET LENGTH
	MOVEM	S1,G$SAB+SAB.LN		;SAVE
	MOVEM	M,G$SAB+SAB.MS		;SAVE MESSAGE ADDRESS
	PUSHJ	P,FNDPID		;FIND THE PID IN THE RESEND QUEUE
	  JRST	SEND.1			;ALREADY THERE
	MOVEI	S1,SAB.SZ		;SAB LENGTH
	MOVEI	S2,G$SAB		;SAB ADDRESS
	$CALL	C%SEND			;SEND MESSAGE
	JUMPT	.POPJ			;RETURN IF NO ERRORS
	CAIE	S1,ERNSP$		;NO SUCH PID?
	CAIN	S1,ERPWA$		;PID WENT AWAY?
	POPJ	P,			;JUST GIVE UP

SEND.1:	$SAVE	<P1>			;SAVE P1
	MOVE	S1,IPCQUE		;GET RESEND QUEUE HANDLE
	$CALL	L%LAST			;POSITION TO END OF LIST
	MOVE	S2,G$SAB+SAB.LN		;GET MESSAGE LENGTH
	TRNN	M,PAGSIZ-1		;MESSAGE ON A PAGE BOUNDRY?
	CAIE	S2,PAGSIZ		;AND A PAGE IN LENGTH?
	JRST	SEND.2			;NO--RANDOM PACKET
	SETZ	S2,			;ONLY SAVE THE SAB

SEND.2:	ADDI	S2,SAB.SZ		;PLUS THE SAB
	MOVE	P1,S2			;SAVE ENTRY SIZE
	MOVE	S1,IPCQUE		;GET LINKED LIST HANDLE AGAIN
	$CALL	L%CENT			;CREATE LIST ENTRY
	MOVSI	S1,G$SAB		;POINT TO THE SAB
	HRRI	S1,(S2)			;AND TO THE LINKED LIST STORAGE
	BLT	S1,SAB.SZ-1(S2)		;COPY SAB
	CAIG	P1,SAB.SZ		;SAVING JUST THE SAB (PAGE MODE)?
	JRST	SEND.3			;YES
	MOVSI	S1,(M)			;POINT TO MESSAGE
	HRRI	S1,SAB.SZ(S2)		;POINT PAST THE SAB STORAGE
	ADD	S2,G$SAB+SAB.LN		;COMPUTE END BLT ADDRESS
	BLT	S1,SAB.SZ-1(S2)		;COPY MESSAGE INTO LIST

SEND.3:	AOS	RSENDC			;COUNT THE RESEND NEEDED LATER
	POPJ	P,			;RETURN
FNDPID:	$SAVE	<P1,P2>			;SAVE SOME ACS
	MOVE	P1,G$SAB+SAB.PD		;GET PID
	MOVE	P2,G$SAB+SAB.SI		;GET SPECIAL INDEX WORD
	MOVE	S1,IPCQUE		;GET LINKED LIST FOR RESENDS
	$CALL	L%FIRS			;POSITION TO FIRST ENTRY
	JRST	FNDP.2			;ENTER LOOP

FNDP.1:	MOVE	S1,IPCQUE		;GET LINKED LIST FOR RESENDS
	$CALL	L%NEXT			;POSITION TO NEXT ENTRY

FNDP.2:	JUMPF	.POPJ1			;RETURN IF END OF LIST
	CAMN	P1,SAB.PD(S2)		;BOTH THE PID
	CAME	P2,SAB.SI(S2)		;AND THE INDEX MUST MATCH
	JRST	FNDP.1			;KEEP SEARCHING
	POPJ	P,			;RETURN
SUBTTL	Command processing -- DELETE


.DELET:	PUSHJ	P,C$DATA		;FIND THE CATALOG DATA BASE
	  POPJ	P,			;FAILED
	PUSHJ	P,C$GBLK		;GET NEXT ARG BLOCK
	JRST	E$OPR			;OPR CMD ERROR
	CAIE	T1,.CMFLD		;A FIELD?
	JRST	E$OPR			;OPR CMD ERROR
	PUSHJ	P,C$CVSN		;CONVERT VSN TO UPPER CASE
	PUSHJ	P,C$TBLS		;SEARCH FOR A MATCH
	  POPJ	P,			;NOT FOUND
	TXNE	S2,TL%ABR		;UNIQUE ABBREVIATION?
	JRST	E$ANL			;NOT LEGAL IN THIS CASE
	MOVE	T1,S1			;COPY TABLE ENTRY ADDRESS
	PUSHJ	P,C$PRIV		;CALLER PRIV'ED?
	  JRST	E$NPV			;NO
	MOVE	S2,T1			;COPY TABLE ENTRY ADDRESS
	PUSHJ	P,C$TBLD		;DELETE THE TABLE ENTRY
	  JFCL				;NOT FOUND? (DIDN'T WANT IT ANYWAY)
	PUSHJ	P,C$FILW		;RE-WRITE THE FILE
	  POPJ	P,			;PROPAGATE ERROR BACK
	JRST	E$DEL			;GENERATE DELETE ACK AND RETURN
SUBTTL	Command processing -- DISABLE/ENABLE


.DISAB:	TDZA	S1,S1			;DISABLE ENTRY POINT
.ENABL:	MOVEI	S1,1			;ENABLE ENTRY POINT
	$SAVE	<P1>			;SAVE P1
	MOVE	P1,S1			;COPY FLAG
	SETZ	E,			;NO VOLUME-SET ENTRY
	PUSHJ	P,C$PRIV		;CALLER PRIV'ED?
	  JRST	E$NPV			;NO
	PUSHJ	P,C$DATX		;FIND THE CATALOG DATA BASE
	  POPJ	P,			;FAILED
	MOVEM	P1,.CDUPD(C)		;SAVE UPDATE FLAG
	PUSHJ	P,DISENA		;SEND ENABLE/DISABLE TO QUASAR
	JRST	@[E$DIS			;DISABLE ACK
		  E$ENA](P1)		;ENABLE ACK
SUBTTL	Command processing -- INSERT


.INSER:	SETZ	E,			;NO VOLUME-SET ENTRY
	PUSHJ	P,C$PRIV		;IS CALLER PRIV'ED?
	  JRST	E$NPV			;NO
	TDZA	S1,S1			;INSERT
.MODIF:	MOVEI	S1,1			;MODIFY
	MOVE	E,S1			;SAVE TEMPORARILY
	PUSHJ	P,C$DATX		;FIND THE CATALOG DATA BASE
	  POPJ	P,			;FAILED
	SKIPE	.CDUPD(C)		;UPDATES ALLOWED?
	JRST	INSE.1			;YES--NO CHECKING NEEDED
	LOAD	S1,G$IDX,SI.IDX		;GET THE SENDERS SPECIAL PID INDEX
	CAIE	S1,SP.QSR		;QUASAR?
	CAIN	S1,SP.MDA		;MDA?
	JRST	E$CUD			;YES--CATALOG UPDATES ARE DISABLED

INSE.1:	MOVEM	E,.CDMOD(C)		;SAVE POSSIBLE MODIFY FLAG
	SETZB	A,.CDNVA(C)		;NO NEW VSN YET
	MOVEI	E,CNVBLK		;POINT TO ALTERNATE ENTRY BLOCK
	PUSHJ	P,C$CLEN		;CLEAR IT OUT

INSE.2:	PUSHJ	P,C$GBLK		;GET NEXT ARG BLOCK
	JRST	E$OPR			;OPR CMD ERROR
	CAIE	T1,.CMFLD		;A FIELD?
	JRST	E$OPR			;OPR CMD ERROR
	SKIPN	(T3)			;NULL?
	JRST	E$NVN			;NO VSN GIVEN
	PUSHJ	P,C$CVSN		;CONVERT VSN TO UPPER CASE
	SKIPN	.CDMOD(C)		;MODIFY?
	JRST	INSE.3			;NO
	PUSHJ	P,C$TBLS		;SEARCH THE TABLE FOR EXISTING ENTRY
	 POPJ	P,			;NOT FOUND
	TXNE	S2,TL%ABR		;UNIQUE ABBREVIATION?
	JRST	E$ANL			;NOT LEGAL IN THIS CASE
	MOVEM	S1,.CDMOD(C)		;SAVE ADDR FOR LATER REFERENCE
	HRRZ	S2,(S1)			;GET FILE POSITION
	MOVEM	S2,.CDPFP(C)		;SET FOR I/O
	PUSHJ	P,C$PREN		;READ ENTRY INTO CORE
	  POPJ	P,			;FAILED
	PUSHJ	P,C$PRIV		;IS CALLER PRIV'ED?
	  JRST	E$NPV			;NO
	JRST	INSE.4			;GO CHECK FOR SWITCHES

INSE.3:	MOVSI	S1,(T3)			;PREPARE TO COPY
	HRRI	S1,.CTVSN(E)		;THE VSN INTO THE
	MOVEI	S2,.CTVSN(E)		;GET STORAGE ADDRESS
	ADDI	S2,(T2)			;COMPUTE END BLT ADDRESS
	BLT	S1,-1(S2)		;COPY THE VSN
	MOVE	T4,T3			;COPY VSN ADDRESS
	HRLI	T4,-1(T2)		;AND LENGTH IN WORDS
	PUSHJ	P,C$GBLK		;GET NEXT ARG BLOCK
	  JRST	E$OPR			;OPR CMD ERROR
	CAIE	T1,.CMTOK		;A TOKEN?
	JRST	INSE.5			;NO
	MOVE	S1,(T3)			;GET IT
	CAME	S1,[ASCIZ /=/]		;INSERT FOO=BAR?
	JRST	E$OPR			;OPR CMD ERROR
	MOVEM	T4,.CDNVA(C)		;SAVE NEW VSN ADDRESS
	PUSHJ	P,C$GBLK		;GET NEXT ARG BLOCK
	  JRST	E$OPR			;OPR CMD ERROR
	CAIE	T1,.CMFLD		;FIELD?
	JRST	E$OPR			;OPR CMD ERROR
	PUSHJ	P,C$CVSN		;CONVERT VSN TO UPPER CASE
	PUSHJ	P,C$TBLS		;SEARCH TABLE FOR VSN MATCH
	  POPJ	P,			;NOT FOUND
	HRRZ	S2,(S1)			;GET FILE POSITION
	MOVEM	S2,.CDPFP(C)		;SET FOR I/O
	PUSHJ	P,C$PREN		;READ ENTRY INTO CORE
	  POPJ	P,			;FAILED
	MOVSI	S1,.CTVSN(E)		;NOW CLEAR OUT
	HRRI	S1,.CTVSN+1(E)		; THE EXISTING VSN
	SETZM	.CTVSN(E)		;  STORAGE AREA
	BLT	S1,.CTVSN+VSNSIZ-1(E)	;CLEAR ENTIRE VSN BLOCK
	HRLZ	S1,.CDNVA(C)		;POINT TO NEW VSN
	HRRI	S1,.CTVSN(E)		;WHERE IT IS NOW
	HLRZ	S2,.CDNVA(C)		;GET LENGTH
	ADDI	S2,.CTVSN(E)		;COMPUTE END BLT ADDRESS
	BLT	S1,-1(S2)		;COPY NEW VSN OVER OLD ONE

INSE.4:	PUSHJ	P,C$GBLK		;GET NEXT ARG BLOCK
	  JRST	E$OPR			;OPR CMD ERROR

INSE.5:	CAIE	T1,.CMSWI		;SWITCH?
	JRST	INSE.6			;NO
	MOVE	T1,(T3)			;GET VALUE
	MOVSI	S1,-SWTMAX		;-COUNT
	CAME	T1,SWTTAB(S1)		;A MATCH?
	AOBJN	S1,.-1			;KEEP LOOKING
	JUMPGE	S1,E$OPR		;OPR CMD ERROR
	HRRZM	S1,.CDMST(C)		;SAVE INDEX IN MESSAGE TEMP WORD
	PUSHJ	P,C$GBLK		;GET NEXT ARG BLOCK
	  JRST	E$OPR			;OPR CMD ERROR
	MOVE	S1,.CDMST(C)		;GET INDEX BACK
	SKIPL	SWTVAL(S1)		;IF NEGATIVE, DON'T CHECK .CMXXX TYPES
	CAMN	T1,SWTVAL(S1)		;ARG TYPES MATCH?
	PUSHJ	P,@SWTDSP(S1)		;PROCESS SWITCH
	  POPJ	P,			;FAILED FOR SOME REASON
	JRST	INSE.4			;LOOP BACK FOR ANOTHER SWITCH

INSE.6:	MOVE	S1,.CVTYP(C)		;GET DEVICE TYPE
	STORE	S1,.CTVFL(E),CT.TYP	;SAVE
	CAIN	T1,.CMCFM		;CONFIRMATION?
	PUSHJ	P,@.CVINS(C)		;NOW PROCESS SPECIAL STUFF
	  JRST	E$OPR			;OPR CMD ERROR
	PUSHJ	P,@.CVCHK(C)		;CHECK FOR LEGAL ENTRY
	  POPJ	P,			;PROPAGATE ERROR BACK
	SKIPN	S1,.CDMOD(C)		;MODIFY
	JRST	INSE.7			;NO
	HLLZS	(S1)			;YES--CLEAR OLD FILE POSITION
	JRST	INSE.8			;NO TO EITHER

INSE.7:	PUSHJ	P,C$AVSN		;ALLOCATE VSN STORAGE
	  POPJ	P,			;PROPAGATE ERROR BACK
	PUSHJ	P,C$TBLA		;ADD NEW ONE TO THE TABLE
	  POPJ	P,			;PROPAGATE ERROR BACK

INSE.8:	MOVE	A,E			;SAVE ENTRY ADDRESS AWAY
	PUSHJ	P,C$FILW		;WRITE IT OUT TO THE FILE
	  POPJ	P,			;PROPAGATE ERROR BACK
	SKIPN	.CDMOD(C)		;MODIFY?
	JRST	E$INS			;GENERATE INSERT ACK
	JRST	E$MOD			;GENERATE MODIFY ACK
DEFINE	SWTCHS,<

X	(.CTDEN,.CMKEY,DENSWT)		;/DENSITY
X	(.CTEXP,-1,EXPSWT)		;/EXPIRATION
X	(.CTLAB,.CMKEY,LABSWT)		;/LABEL-TYPE
X	(.CTLOC,-1,LOCSWT)		;/LOCATION
X	(.CTNAM,-1,NAMSWT)		;/NAME
X	(.CTTRK,.CMKEY,TRKSWT)		;/TRACKS
X	(.CTRID,.CMFLD,RIDSWT)		;/REELID
X	(.CTUSR,.CMUSR,USRSWT)		;/USER

>

DEFINE	X	(NAME,CMND,DISP),<EXP	NAME>
SWTTAB:	SWTCHS
SWTMAX==.-SWTTAB			;LENGTH OF TABLE

DEFINE	X	(NAME,CMND,DISP),<EXP	CMND>
SWTVAL:	SWTCHS

DEFINE	X	(NAME,CMND,DISP),<EXP	DISP>
SWTDSP:	SWTCHS


; DENSITY
DENSWT:	MOVE	S1,(T3)			;GET DENSITY INDEX
	CAILE	S1,0			;RANGE
	CAILE	S1,.CTDMX		; CHECK
	JRST	E$OPR			;OPR CMD ERROR
	STORE	S1,.CTVSC(E),CT.DEN	;SAVE MAGTAPE DENSITY
	JRST	.POPJ1			;RETURN


; EXPIRATION DATE
EXPSWT:	CAIE	T1,.CMTAD		;DATE?
	CAIN	T1,.CMKEY		;OR KEYWORD?
	SKIPA	S1,(T3)			;GET EXPIRATION DATE OR ZERO (NONE)
	POPJ	P,			;GIVE UP
	HLLZM	S1,.CTVED(E)		;SAVE
	JRST	.POPJ1			;RETURN

; LABEL-TYPE
LABSWT:	MOVE	S1,(T3)			;PICK UP KEYWORD
	CAIE	S1,-1			;DEFAULT?
	JRST	LABSW1			;NO
	MOVX	S1,CT.LTS!CT.LAB	;BITS TO CLEAR
	ANDCAM	S1,.CTVSC(E)		;NO LABEL TYPE IS STORED
	JRST	.POPJ1			;RETURN
LABSW1:	CAIL	S1,0			;RANGE
	CAILE	S1,.TFLNV		; CHECK
	JRST	E$OPR			;OPR CMD ERROR
	STORE	S1,.CTVSC(E),CT.LAB	;SAVE MAGTAPE LABEL TYPE
	MOVX	S1,CT.LTS		;BIT TO SET
	IORM	S1,.CTVSC(E)		;REMEMBER LABEL TYPE WAS SET
	JRST	.POPJ1			;RETURN

; LOCATION
LOCSWT:	CAIE	T1,.CMQST		;QUOTED STRING?
	CAIN	T1,.CMFLD		;OR UNQUOTED TEXT?
	SKIPA				;YES
	POPJ	P,			;GIVE UP
	MOVSI	S1,.CTVLO(E)		;FIRST
	HRRI	S1,.CTVLO+1(E)		; CLEAR
	SETZM	.CTVLO(E)		;  OUT THE
	BLT	S1,.CTVLO+LOCSIZ-1(E)	;   NAME BLOCK
	MOVSI	S1,(T3)			;POINT TO MESSAGE
	HRRI	S1,.CTVLO(E)		;WHERE TO PUT THE STRING
	MOVEI	S2,-1(T2)		;GET BLOCK LENGTH
	ADDI	S2,.CTVLO(E)		;COMPUTE END BLT ADDRESS
	BLT	S1,-1(S2)		;COPY
	JRST	.POPJ1			;RETURN

; NAME
NAMSWT:	CAIE	T1,.CMQST		;QUOTED STRING?
	CAIN	T1,.CMFLD		;OR UNQUOTED TEXT?
	SKIPA				;YES
	POPJ	P,			;GIVE UP
	MOVSI	S1,.CTVNM(E)		;FIRST
	HRRI	S1,.CTVNM+1(E)		; CLEAR
	SETZM	.CTVNM(E)		;  OUT THE
	BLT	S1,.CTVNM+NAMSIZ-1(E)	;   NAME BLOCK
	MOVSI	S1,(T3)			;POINT TO MESSAGE
	HRRI	S1,.CTVNM(E)		;WHERE TO PUT THE STRING
	MOVEI	S2,-1(T2)		;GET BLOCK LENGTH
	ADDI	S2,.CTVNM(E)		;COMPUTE END BLT ADDRESS
	BLT	S1,-1(S2)		;COPY
	JRST	.POPJ1			;RETURN

; REELID
RIDSWT:	PUSHJ	P,@.CVRSW(C)		;PROCESS /REELID
	  JRST	E$OPR			;OPR CMD ERROR
	JRST	.POPJ1			;RETURN

; TRACKS
TRKSWT:	MOVE	S1,(T3)			;GET TRACK INDEX
	CAIE	S1,.CT7TK		;7-TRACK?
	CAIN	S1,.CT9TK		;9-TRACK?
	SKIPA				;YES
	JRST	E$OPR			;OPR CMD ERROR
	STORE	S1,.CTVSC(E),CT.TRK	;SAVE MAGTAPE TRACK INDEX
	JRST	.POPJ1			;RETURN

; User name
USRSWT:	CAIN	T2,3			;BLOCK CONTAIN A WILDCARD MASK?
	JRST	USRSW1			;YES--HANDLE DIFFERENTLY
	MOVE	S1,(T3)			;GET PPN
	MOVEM	S1,.CTVUS(E)		;SAVE
	JRST	.POPJ1			;RETURN
USRSW1:	HLRZ	S1,0(T3)		;GET PROJECT NUMBER
	HLRZ	S2,1(T3)		; AND THE MASK
	PUSHJ	P,USRSW2		;CHECK IT OUT
	  JRST	E$PWI			;PARTIAL WILDCARDING IS ILLEGAL
	HRLZM	S1,.CTVUS(E)		;SAVE
	HRRZ	S1,0(T3)		;GET PROGRAMMER NUMBER
	HRRZ	S2,1(T3)		; AND THE MASK
	PUSHJ	P,USRSW2		;CHECK IT OUT TOO
	  JRST	E$PWI			;PARTIAL WILDCARDING IS ILLEGAL
	HRRM	S1,.CTVUS(E)		;SAVE
	JRST	.POPJ1			;ALL DONE
USRSW2:	CAIN	S2,-1			;NOT WILD?
	AOSA	(P)			;NOTHING TO DO
	CAIE	S1,0			;FULL HALF-WORD WILDCARD?
	POPJ	P,			;NO--THAT'S ILLEGAL
	MOVEI	S1,-1			;SET HALF-WORD WILD
	JRST	.POPJ1			;AND RETURN
SUBTTL	Command processing -- LIST


.LIST:	SETZ	E,			;NO VOLUME-SET ENTRY
	PUSHJ	P,C$PRIV		;IS CALLER PRIV'ED?
	  JRST	E$NPV			;NO
	PUSHJ	P,C$DATA		;FIND THE CATALOG DATA BASE
	  POPJ	P,			;FAILED
	PUSHJ	P,C$GBLK		;GET NEXT ARG BLOCK
	  JRST	E$OPR			;OPR CMD ERROR
	CAIE	T1,.CMOFI		;OUTPUT FILESPEC?
	JRST	E$OPR			;OPR CMD ERROR
	PUSHJ	P,C$LFIL		;SET UP LISTING FILE
	PUSH	P,S1			;SAVE MAGIC INDEX
	MOVSI	S1,-1(T3)		;WHERE THE FD IS NOW
	HRRI	S1,.CDLFD(C)		;WHERE TO PUT IT
	BLT	S1,.CDLFD+FDXSIZ-1(C)	;COPY IT
	MOVEI	S1,.FDNAT		;NATIVE MODE FILE
	STORE	S1,.CDLFD+.FDLEN(C),FD.TYP ;SAVE
	POP	P,S1			;RETRIEVE INDEX
	PUSHJ	P,C$OOPN		;OPEN FILE FOR OUTPUT
	  POPJ	P,			;FAILED
	MOVE	S1,.CDTAB(C)		;POINT TO TABLE
	SETOM	.CDTXF(C)		;FLAG LISTING TO A FILE
	SETZM	.CDLPN(C)		;SET PAGE COUNTER TO ZERO
	HLRZ	P1,(S1)			;GET NUMBER OF ENTRIES
	MOVNS	P1			;NEGATE
	HRLZS	P1			;PUT IN LH
	HRRI	P1,1(S1)		;POINT TO START OF DATA
	JUMPGE	P1,LIST.2		;JUMP IF NO ENTRIES IN FILE

LIST.1:	HRRZ	S1,(P1)			;GET FILE POSITION
	MOVEM	S1,.CDPFP(C)		;SAVE
	MOVEI	E,ENTBLK		;POINT TO ENTRY STORAGE
	PUSHJ	P,C$PREN		;READ FROM FILE
	  POPJ	P,			;RETURN
	MOVEI	S1,(P1)			;POINT TO CURRENT ENTRY
	SUB	S1,.CDTAB(C)		;COMPUTE TABLE INDEX
	MOVEM	S1,.CDLDN(C)		;SAVE AS LISTING DATA ITEM NUMBER
	PUSHJ	P,@.CVLST(C)		;LIST THE ENTRY
	AOBJN	P1,LIST.1		;LOOP THROUGH TABLE

LIST.2:	PUSHJ	P,LISTSM		;SUMMARIZE
	MOVE	S1,.CDLIF(C)		;GET IFN
	$CALL	F%REL			;CLOSE AND RELEASE THE IFN
	SETZM	.CDTXF(C)		;NO LONGER LISTING TO A FILE
	JRST	E$LIS			;GENERATE LIST ACK AND RETURN
LISTHD:	$TEXT	(C$TXTC,<^I/LISTHT/^T/@.CVLHD(C)/^A>)
	POPJ	P,

LISTSM:	MOVE	S1,.CDTAB(C)		;GET TABLE ADDRESS
	HLRZ	S1,(S1)			;GET NUMBER OF ENTRIES
	MOVEI	S2,"s"			;ASSUME MORE THAN ONE
	CAIN	S1,1			;JUST ONE?
	MOVEI	S2," "			;YES
	$TEXT	(C$TXTC,<^I/LISTST/>)	;LIST SUMMARY TEXT
	POPJ	P,			;AND RETURN

LISTHT:	ITEXT	(<^M^T/@.CVTXT(C)/ listing by ^I/@G$APLT/ %^V/[%%CAT]/ on ^H9L/G$UDT/ at ^C/G$UDT/	Page ^D/.CDLPN(C)/
File: ^F/.CDPFD(C)/	File format: ^D/.CDPFM(C)/
>)

LISTST:	ITEXT	(<

A total of ^D/S1/ ^T/@.CVTXT(C)/^7/S2/
>)
SUBTTL	Command processing -- SHOW


.SHOW:	PUSHJ	P,C$DATA		;FIND THE CATALOG DATA BASE
	  POPJ	P,			;FAILED
	PUSHJ	P,C$GBLK		;GET NEXT ARG BLOCK
	  JRST	E$OPR			;OPR CMD ERROR
	CAIE	T1,.CMFLD		;A FIELD?
	JRST	E$OPR			;OPR CMD ERROR
	PUSHJ	P,C$CVSN		;CONVERT VSN TO UPPER CASE
	PUSHJ	P,C$TBLS		;SEARCH THE APPROPRIATE TABLE
	  POPJ	P,			;NOT FOUND
	HRRZ	S2,(S1)			;GET FILE POSITION
	MOVEM	S2,.CDPFP(C)		;SAVE
	MOVEI	E,ENTBLK		;POINT TO ENTRY STORAGE
	PUSHJ	P,C$PREN		;READ FROM FILE
	  POPJ	P,			;FAILED
	PUSHJ	P,C$SETM		;SET UP FOR SEND
	PUSHJ	P,C$PRIV		;IS CALLER PRIV'ED?
	  JRST	E$NPV			;NO
	MOVEI	S1,[ITEXT (< ^T/@.CVTXT(C)/ catalog >)] ;DISPLAY HEADER
	PUSHJ	P,TXTACK		;SET UP ACK MESSAGE
	$TEXT	(C$TXTC,<	^T/@.CVTXT(C)/ ^T/.CTVSN(E)/^A>)
	MOVEI	S1,.CTVLO(E)		;POINT TO LOCATION TEXT
	HRLI	S1,(POINT 8,)		;MAKE A BYTE POINTER
	SKIPE	(S1)			;HAVE ONE?
	$TEXT	(C$TXTC,<^M^J	Location: ^Q/S1/^A>)
	SKIPE	S1,.CTVED(E)		;HAVE A VOLUME-SET EXPIRATION DATE?
	$TEXT	(C$TXTC,<^M^J	Expiration date: ^H9L/S1/^A>)
	PUSHJ	P,C$SOWN		;SHOW OWNER PPN AND NAME
	PUSHJ	P,@.CVSHW(C)		;GENERATE "SHOW" LISTING
	PUSHJ	P,TXTDON		;FINISH UP TEXT STUFF
	PUSHJ	P,C$SOPR		;SEND TO OPR
	POPJ	P,			;AND RETURN
C$LPPN::SKIPN	.CTVUS(E)		;HAVE AN OWNER PPN?
	JRST	LPPN.1
	HLRE	TF,.CTVUS(E)		;GET PROJECT NUMBER
	MOVEI	S1,[ITEXT (<^O6R /.CTVUS(E),LHMASK/>)] ;OCTAL PROJECT #
	CAMN	TF,[EXP -1]		;WILD?
	MOVEI	S1,[ITEXT (<     *>)]	;YES
	HRRE	TF,.CTVUS(E)		;GET PROGRAMMER NUMBER
	MOVEI	S2,[ITEXT (<^O6L /.CTVUS(E),RHMASK/>)] ;OCTAL PROGRAMMER #
	CAMN	TF,[EXP -1]		;WILD?
	MOVEI	S2,[ITEXT (<*     >)]	;YES
	$TEXT	(C$TXTC,<^I/(S1)/,^I/(S2)/^A>)
	POPJ	P,			;RETURN

LPPN.1:	$TEXT	(C$TXTC,<             ^A>) ;FILL COLUMNS
	POPJ	P,			;AND RETURN
C$SOWN::MOVEI	S1,[ASCIZ |Owned by no one|]
	SKIPE	.CTVUS(E)		;HAVE AN OWNER?
	MOVEI	S1,[ASCIZ |Owned by |]	;YES
	$TEXT	(C$TXTC,<^M^J	^T/(S1)/^A>)
	SKIPN	.CTVUS(E)		;HAVE AN OWNER?
	JRST	LNAM.1			;NO--LOOK FOR A NAME
	HLRE	TF,.CTVUS(E)		;GET PROJECT NUMBER
	MOVEI	S1,[ITEXT (<^O/.CTVUS(E),LHMASK/>)] ;OCTAL PROJECT #
	CAMN	TF,[-1]			;WILD?
	MOVEI	S1,[ITEXT (<*>)]	;YES
	HRRE	TF,.CTVUS(E)		;GET PROGRAMMER NUMBER
	MOVEI	S2,[ITEXT (<^O/.CTVUS(E),RHMASK/>)] ;OCTAL PROGRAMMER #
	CAMN	TF,[-1]			;WILD?
	MOVEI	S2,[ITEXT(<*>)]		;YES
	$TEXT	(C$TXTC,<[^I/(S1)/,^I/(S2)/]^A>)


C$LNAM::MOVEI	S1," "			;START OFF
	PUSHJ	P,C$TXTC		; WITH A
	MOVEI	S1," "			;  COUPLE
	PUSHJ	P,C$TXTC		;   OF SPACES
LNAM.1:	MOVEI	S1,.CTVNM(E)		;POINT TO NAME STORAGE
	PJRST	C$ASC8			;TYPE AND RETURN
SUBTTL	C$PRIV - Check privileges


; Perform priviledge checking on the requestor
; Call:	MOVE	E, volume-set entry address or zero
;	PUSHJ	P,C$PRIV
;	  <NON-SKIP>			;NOT PRIVILEGED
;	<SKIP>				;NOT PRIVILEGED OR NOT VOL-SET OWNER

C$PRIV::LOAD	S1,G$IDX,SI.IDX		;GET THE SENDERS SPECIAL PID INDEX
	CAIE	S1,SP.QSR		;QUASAR?
	CAIN	S1,SP.MDA		;MDA?
	JRST	.POPJ1			;HE CAN DO ANYTHING
	CAIE	S1,SP.OPR		;ORION?
	JRST	PRIV.1			;NO
	MOVE	S1,G$COD		;GET ACK CODE (OPR'S PID)
	$CALL	C%PIDJ			;FIND OUT WHAT JOB SENT THIS
	JUMPF	.POPJ			;ABORT NOW IF PID WENT AWAY
	MOVEI	S2,JI.USR		;GET LOGGED-IN DIRECTORY
	$CALL	I%JINF			; ...
	JUMPF	.POPJ			;JOB WENT AWAY?
	JRST	PRIV.2			;ENTER COMMON CODE

PRIV.1:	MOVE	S1,G$PRV		;GET REQUESTOR'S PRIVS
	TXNE	S1,MD.PWH		;JACCT?
	JRST	.POPJ1			;YES--LET HIM THROUGH
	LOAD	S1,S1,MD.PJB		;GET REQUESTOR'S JOB NUMBER
	MOVE	S2,G$SID		;GET REQUESTOR'S PPN
	JRST	PRIV.2			;ONWARD

PRIV.2:	HRLZS	S1			;MAKE AN INDEX
	HRRI	S1,.GTPRV		;FORM GETTAB ARGUMENT
	GETTAB	S1,			;READ PRIV WORD
	  SETZ	S1,			;???
	TXNE	S1,JP.ADM		;ADMINISTRATIVE PRIVS?
	JRST	.POPJ1			;YES

PRIV.3:	JUMPE	E,.POPJ			;RETURN IF NO VOLUME-SET ENTRY
	MOVE	S1,.CTVUS(E)		;GET VOLUME-SET OWNER
	TLC	S1,-1			;WILDCARDED
	TLCN	S1,-1			; PROJECT NUMBER?
	TLO	S2,-1			;YES
	TRC	S1,-1			;WILDCARDED
	TRCN	S1,-1			; PROGRAMMER NUMBER?
	TRO	S2,-1			;YES
	XOR	S2,S1			;COMPARE
	JUMPN	S2,.POPJ		;DIFFERENT--SAY VOLUME-SET NOT FOUND
	JRST	.POPJ1			;RETURN GOODNESS
SUBTTL	Common subroutines -- C$TBLA - Add entry to table


C$TBLA::$SAVE	<P1,P2>			;SAVE P1 AND P2
	HLRZ	P1,S2			;PUT NAME ADDR IN RH INCASE OF ERROR
	SKIPA	P2,S2			;COPY ARGUMENT

TBLA.1:	MOVE	S2,P2			;GET ARGUMENT
	MOVE	S1,.CDTAB(C)		;POINT TO TABLE
	$CALL	S%TBAD			;ADD ENTRY TO TABLE
	JUMPT	.POPJ1			;RETURN
	CAIN	S1,EREIT$		;ALREADY IN TABLE?
	JRST	E$AIC			;YES
	CAIE	S1,ERTBF$		;TABLE FULL?
	JRST	E$TSE			;TABLE SEARCH ERROR
	PUSHJ	P,C$TBLI		;INCREATE SIZE OF TABLE
	  POPJ	P,			;PROPAGATE ERROR BACK
	JRST	TBLA.1			;AND TRY AGAIN
SUBTTL	Common subroutines -- C$TBLD - Delete entry from a table


C$TBLD::MOVE	S1,.CDTAB(C)		;POINT TO TABLE
	$CALL	S%TBDL			;DELETE ENTRY FROM TABLE
	JUMPT	.POPJ1			;RETURN
	MOVEI	S1,TBLD.1		;POINT TO ERROR ITEXT BLOCK
	POPJ	P,			;AND RETURN

TBLD.1:	ITEXT	(<^T/@.CVTXT(C)/ "^T/(S2)/" not found>)
SUBTTL	Common subroutines -- C$TBLC - Create a table


C$TBLC::MOVE	S1,.CDCOR(C)		;GET LINKED LIST HANDLE FOR CORE
	SKIPN	S2,.CDTAB(C)		;GET TABLE ADDRESS
	JRST	TBLC.1			;DOESN'T EXIST YET
	$CALL	L%APOS			;POSITION
	JUMPF	TBLC.1			;???
	$CALL	L%DENT			;RETURN CORE

TBLC.1:	MOVE	S1,.CDCOR(C)		;GET HANDLE INCASE OF ERROR
	MOVEI	S2,TBLLEN		;GET INITIAL LENGTH
	$CALL	L%CENT			;GET CORE
	JUMPF	E$COR			;CHECK FOR ERRORS
	MOVEI	S1,TBLLEN		;GET SIZE AGAIN
	MOVEM	S1,.CDTLN(C)		;SAVE
	MOVEM	S2,.CDTAB(C)		;SAVE ADDRESS
	SUBI	S1,1			;ACCOUNT FOR OVERHEAD WORD
	MOVEM	S1,(S2)			;SET UP MAXIMUM LENGTH IN TABLE
	JRST	.POPJ1			;AND RETURN
SUBTTL	Common subroutines -- C$TBLI - Increase table length


C$TBLI::$SAVE	<P1,P2>			;SAVE P1 AND P2
	MOVE	P1,.CDTLN(C)		;GET OLD LENGTH
	MOVE	P2,.CDTAB(C)		;GET OLD ADDRESS
	MOVE	S1,.CDCOR(C)		;GET LINKED LIST HANDLE FOR CORE
	MOVEI	S2,<TBLLEN/2>(P1)	;INCREATE BY HALF AS MUCH
	$CALL	L%CENT			;GET CORE
	JUMPF	E$COR			;CHECK FOR ERRORS
	MOVEI	S1,<TBLLEN/2>(P1)	;GET LENGTH BACK
	MOVEM	S1,.CDTLN(C)		;SAVE LENGTH
	MOVEM	S2,.CDTAB(C)		;SAVE ADDRESS
	SUBI	S1,1			;ACCOUNT FOR OVERHEAD WORD
	HRRM	S1,(P2)			;SET NEW MAXIMUM LENGTH
	HRLZ	S1,P2			;OLD TABLE ADDR
	HRR	S1,S2			;NEW TABLE ADDR
	ADDI	S2,(P1)			;COMPUTE END OF BLT
	BLT	S1,-1(S2)		;COPY NEW TO OLD
	MOVE	S1,.CDCOR(C)		;GET LINKED LIST HANDLE FOR CORE
	MOVE	S2,P2			;AND OLD TABLE ADDRESS
	$CALL	L%APOS			;POSITION LIST
	JUMPF	.POPJ1			;???
	$CALL	L%DENT			;DELETE LIST ENTRY
	JRST	.POPJ1			;AND RETURN
SUBTTL	Common subroutines -- C$TBLS - Table search


C$TBLS::SKIPN	(T3)			;HAVE A NAME?
	JRST	E$NVN			;NULL VSN
	MOVE	S1,.CDTAB(C)		;POINT TO TABLE HEADER
	MOVEI	S2,(T3)			;POINT TO STRING ADDRESS
	$CALL	S%TBLK			;FIND THE NAME
	JUMPF	E$UNK			;CHECK FOR ERRORS
	TXNE	S2,TL%EXM!TL%ABR	;EXACT MATCH OR UNIQUE ABBREVIATION?
	JRST	.POPJ1			;YES
	TXNE	S2,TL%NOM		;NO MATCH?
	JRST	E$UNK			;YES
	TXNE	S2,TL%AMB		;AMBIGUOUS?
	JRST	E$AMB			;YES
	MOVEI	S2,(T3)			;POINT TO NAME
	POPJ	P,			;AND GIVE UP
SUBTTL	Common subroutines -- C$ASC8 - Type an 8-bit ASCIZ string


C$ASC8::MOVE	S2,S1			;COPY STRING ADDRESS
	HRLI	S2,(POINT 8,)		;MAKE A BYTE POINTER

ASC8.1:	ILDB	S1,S2			;GET A CHARACTER
	JUMPE	S1,.POPJ		;RETURN ON A NULL
	PUSHJ	P,C$TXTC		;PUT A CHARACTER
	JRST	ASC8.1			;LOOP
SUBTTL	Text routines -- C$TYPT - Table driven typeout


; Routine to type text based on the contents of a translation table
; Call:	MOVE	S1, table-address
;	PUSHJ	P,C$TYPT

C$TYPT::$SAVE	<P1>			;SAVE P1
	MOVE	P1,S1			;GET AOBJN POINTER TO TABLE

TYPT.1:	MOVE	S1,0(P1)		;GET CHARACTERS TO OUTPUT
	MOVEI	S2,@1(P1)		;ADDRESS OF STRING
	HLL	S2,1(P1)		;MAKE A BYTE POINTER
	PUSHJ	P,TYPX.1		;TYPE QUANTITY
	ADDI	P1,1			;ACCOUNT FOR MULTI-WORD ENTRIES
	AOBJN	P1,TYPT.1		;AND LOOP
	POPJ	P,			;RETURN
SUBTTL	Text routines -- C$TYPx - Type 6, 7, or 8-bit text


C$TYP6:	HRLI	S2,(POINT 6,)		;SIXBIT
	JRST	TYPX.1			;ENTER COMMON CODE

C$TYP7::HRLI	S2,(POINT 7,)		;7-BIT ASCII
	JRST	TYPX.1			;ENTER COMMON CODE

C$TYP8::HRLI	S2,(POINT 8,)		;8-BIT ASCII
TYPX.1:	PUSH	P,S1			;SAVE BYTE COUNT

TYPX.2:	ILDB	S1,S2			;GET A CHARACTER
	JUMPE	S1,TYPX.3		;JUMPF IF END OF STRING
TYPX.A:	PUSHJ	P,C$TXTC		;PUT A CHARACTER
	SKIPL	(P)			;-1 MEANS TYPE ANY LENGTH
	SOSGE	(P)			;COUNT DOWN
	JRST	TYPX.2			;LOOP

TYPX.3:	SKIPG	(P)			;MORE TO TYPE?
	JRST	TYPX.5			;NO

TYPX.4:	MOVEI	S1," "			;GET A SPACE
	PUSHJ	P,C$TXTC		;OUTPUT
	SOSGE	(P)			;COUNT DOWN
	JRST	TYPX.3			;LOOP

TYPX.5:	POP	P,(P)			;PRUNE STACK
	POPJ	P,			;AND RETURN
SUBTTL	File I/O -- C$xFIL - Set up for I/O


; Routine to set up the FOB, FAB, and FD blocks for primary
; data file, alternate data file, or listing files.
; Call:	PUSHJ	P,C$xFIL
;
; On return, S1 and S2 will be set up ready to call a F%xOPN.
;
; AC usage: All preserved.

C$PFIL::TDZA	S1,S1			;PRIMARY DATA FILE ENTRY POINT
C$AFIL::MOVEI	S1,1			;ALTERNATE DATA FILE ENTRY POINT
	JRST	FILE.1			;ENTER COMMON CODE
C$LFIL::MOVEI	S1,2			;LISTING FILE ENTRY POINT

; Set the entry point index
FILE.1:	$SAVE	<P1,P2,P3,P4>		;SAVE SOME ACS
	MOVE	P1,S1			;COPY INDEX
	MOVEI	P2,@FOBTAB(P1)		;POINT TO CORRECT FOB
	MOVEI	P3,@FABTAB(P1)		;POINT TO CORRECT FAB
	MOVEI	P4,@FDTAB(P1)		;POINT TO CORRECT FD
	SETZM	@POSTAB(P1)		;ZAP CURRENT FILE POSITION

; Set up the FOB
FILE.2:	MOVEM	P4,FOB.FD(P2)		;SAVE FD ADDRESS
	MOVE	S1,BSZTAB(P1)		;GET DESIRED BYTE SIZE
	TXO	S1,FB.PHY		;DOING PHYSICAL I/O
	MOVEM	S1,FOB.CW(P2)		;SAVE CONTROL WORD
	SETZM	FOB.US(P2)		;NO IN-YOUR-BEHALF PPN
	SETZM	FOB.CD(P2)		;NO CONNECTED DIRECTORY STUFF
	MOVEM	P3,FOB.AB(P2)		;SAVE ATTRIBUTE BLOCK ADDRESS

; Set up the FAB
FILE.3:	MOVE	S1,[FI.IMM!<2,,.FIPRO>]	;IMMEDIATE 2-WORD PROTECTION CODE ARG
	MOVEM	S1,0(P3)		;SAVE
	MOVE	S1,G$SPRT		;GET .SYS FILE PROTECTION CODE
	MOVEM	S1,1(P3)		;SAVE
; Set up the FD
FILE.4:	MOVSI	S1,(P4)			;START ADDRESS
	HRRI	S1,1(P4)		;MAKE A BLT POINTER
	SETZM	(P4)			;CLEAR FIRST WORD
	BLT	S1,FDXSIZ-1(P4)		;CLEAR ENTIRE FD
	MOVEI	S1,FDXSIZ		;FD LENGTH
	STORE	S1,.FDLEN(P4),FD.LEN	;SAVE
	MOVEI	S1,.FDNAT		;NATIVE MODE FILE
	STORE	S1,.FDLEN(P4),FD.TYP	;SAVE
	MOVE	S1,G$QSTR		;GET QUEUE STRUCTURE
	MOVEM	S1,.FDSTR(P4)		;SAVE
	MOVE	S1,.CVFIL(C)		;GET FILE NAME
	MOVEM	S1,.FDNAM(P4)		;SAVE
	MOVSI	S1,'SYS'		;GET EXTENSION
	MOVEM	S1,.FDEXT(P4)		;SAVE
	SKIPN	DEBUGW			;DEBUGGING?
	SKIPA	S1,G$SPPN		;NO--USE SYSTEM FILE UFD
	MOVEI	S1,0			;ELSE DEFAULT TO CURRENT PATH
	MOVEM	S1,.FDPPN(P4)		;SAVE
	MOVE	S1,P1			;RETURN MAGIC INDEX
	POPJ	P,			;RETURN


; FOB offsets
FOBTAB:	Z	.CDPFB(C)		;PRIMARY DATA FILE
	Z	.CDAFB(C)		;ALTERNATE DATA FILE
	Z	.CDLFB(C)		;LISTING FILE


; FAB offsets
FABTAB:	Z	.CDPFA(C)		;PRIMARY DATA FILE
	Z	.CDAFA(C)		;ALTERNATE DATA FILE
	Z	.CDLFA(C)		;LISTING FILE


; FD offsets
FDTAB:	Z	.CDPFD(C)		;PRIMARY DATA FILE
	Z	.CDAFD(C)		;ALTERNATE DATA FILE
	Z	.CDLFD(C)		;LISTING FILE


; IFN offsets
IFNTAB:	Z	.CDPIF(C)		;PRIMARY DATA FILE
	Z	.CDAIF(C)		;ALTERNATE DATA FILE
	Z	.CDLIF(C)		;LISTING FILE

; Byte sizes
BSZTAB:	EXP	44			;PRIMARY DATA FILE
	EXP	44			;ALTERNATE DATA FILE
	EXP	7			;LISTING DATA FILE


; File format number offsets
FMTTAB:	Z	.CDPFM(C)		;PRIMARY DATA FILE
	Z	.CDAFM(C)		;ALTERNATE DATA FILE


; File position offset
POSTAB:	Z	.CDPFP(C)		;PRIMARY DATA FILE
	Z	.CDAFP(C)		;ALTERNATE DATA FILE


OPETAB:	EXP	E$POP,E$AOP,E$LOP	;OPEN ERRORS
PSETAB:	EXP	E$PPS,E$APS		;POSITIONING ERROR
PEFTAB:	EXP	E$PEF,E$AEF		;PREMATURE EOF
IERTAB:	EXP	E$PIE,E$AIE		;INPUT ERRORS
OERTAB:	EXP	E$POE,E$AOE,E$LOE	;OUTPUT ERRORS
SUBTTL	File I/O -- C$xOPN - Open a file for I/O


C$IOPN::TDZA	S2,S2			;INPUT
C$OOPN::MOVEI	S2,1			;OUTPUT
	$SAVE	<P1,P2>			;SAVE P1 AND P2
	MOVE	P1,S1			;COPY MAGIC INDEX
	MOVE	P2,S2			;SAVE I/O FLAG
	MOVEI	S1,FOB.SZ		;FOB SIZE
	MOVEI	S2,@FOBTAB(P1)		;POINT TO FOB
	XCT	[$CALL	F%IOPN		;OPEN FOR INPUT
		 $CALL	F%OOPN](P2)	;OPEN FOR OUTPUT
	JUMPF	@OPETAB(P1)		;RETURN APPROPRIATE ERROR MESSAGE
	MOVEM	S1,@IFNTAB(P1)		;SAVE IFN
	MOVNI	S2,1			;WANT EXACT FILESPEC
	$CALL	F%FD			;ASK GLXFIL
	MOVSI	S2,(S1)			;POINT TO RETURNED FD
	HRRI	S2,@FDTAB(P1)		;MAKE A BLT POINTER
	LOAD	S1,.FDLEN(S1),FD.LEN	;GET RETURNED LENGTH
	ADDI	S1,@FDTAB(P1)		;COMPUTE END BLT ADDRESS
	BLT	S2,-1(S1)		;COPY THE FD
	MOVE	S1,.CDWSC(C)		;GET WAIT STATE CODE
	CAIN	S1,.CWDNI		;DATA BASE NOT INITED (NEW FILE)?
	MOVEI	S1,.CWRUN		;YES--MAKE RUNNABLE NOW
	MOVEM	S1,.CDWSC(C)		;UPDATE
	JRST	.POPJ1			;AND RETURN
SUBTTL	File I/O -- C$FILW - Write a file


C$FILW::$SAVE	<P1>			;SAVE P1
	PUSHJ	P,C$AFIL		;SET UP ALTERNATE DATA FILE BLOCKS
	PUSHJ	P,C$OOPN		;AND OPEN FOR OUTPUT
	  POPJ	P,			;FAILED
	MOVE	S1,.CVFMT(C)		;GET CURRENT FILE FORMAT NUMBER
	MOVEM	S1,.CDAFM(C)		;UPDATE
	PUSHJ	P,C$AWFM		;WRITE FILE FORMAT
	  POPJ	P,			;FAILED
	MOVE	S1,.CDTAB(C)		;GET TABLE ADDRESS
	HLRZ	P1,(S1)			;GET NUMBER OF ENTRIES IN TABLE
	MOVNS	P1			;NEGATE
	HRLZS	P1			;PUT IN LH
	HRRI	P1,1(S1)		;POINT TO FIRST DATA WORD
	JUMPGE	P1,FILW.4		;JUMP IF NO ENTRIES IN FILE

FILW.1:	HRRZ	S1,(P1)			;GET FILE POSITION NUMBER
	JUMPE	S1,FILW.2		;JUMP IF ENTRY DOESN'T EXIST YET
	MOVEM	S1,.CDPFP(C)		;SAVE
	MOVEI	E,ENTBLK		;SET ENTRY BLOCK ADDRESS
	PUSHJ	P,C$PREN		;READ THE ENTRY
	  POPJ	P,			;FAILED
	JRST	FILW.3			;SKIP NEW ENTRY STUFF

FILW.2:	MOVE	E,A			;COPY NEW ENTRY ADDRESS TO BE ADDED
FILW.3:	MOVE	S1,.CDAIF(C)		;GET OUTPUT IFN
	LOAD	S2,.CTVFL(E),CT.FEL	;GET FILE ENTRY LENGTH
	HRLZS	S2			;PUT IN LH
	HRRI	S2,(E)			;AND ENTRY BLOCK ADDRESS
	$CALL	F%OBUF			;OUTPUT THE ENTRY
	JUMPF	FILW.5			;CHECK FOR ERRORS
	MOVE	S1,.CDAFP(C)		;GET CURRENT POSITION
	HRRM	S1,(P1)			;SET IN TABLE
	LOAD	S2,.CTVFL(E),CT.FEL	;GET FILE ENTRY LENGTH
	ADDI	S1,(S2)			;PLUS WORDS IN THIS ENTRY
	MOVEM	S1,.CDAFP(C)		;ADJUST FILE POSITION

FILW.4:	AOBJN	P1,FILW.1		;LOOP FOR ALL ENTRIES
	MOVE	S1,.CDAIF(C)		;GET IFN
	$CALL	F%REL			;CLOSE AND RELEASE THE IFN
	SKIPE	S1,.CDPIF(C)		;GET PRIMARY IFN
	$CALL	F%REL			;RELEASE IT
	PUSHJ	P,C$PFIL		;NOW MUST RE-OPEN THE FILE
	PUSHJ	P,C$IOPN		;DO IT
	  POPJ	P,			;FAILED
	JRST	.POPJ1			;AND RETURN

FILW.5:	PUSH	P,S1			;SAVE ERROR CODE
	SKIPE	S1,.CDAIF(C)		;GET IFN
	$CALL	F%RREL			;RELEASE AND FLUSH IFN
	POP	P,S1			;GET ERROR CODE BACK
	JRST	E$AOE			;OUTPUT ERROR OF SOME SORT
SUBTTL	File I/O -- C$CLEN - Clear entry


C$CLEN::MOVSI	S1,0(E)			;START ADDRESS
	HRRI	S1,1(E)			;MAKE A BLT POINTER
	SETZM	(E)			;CLEAR FIRST WORD
	BLT	S1,PAGSIZ-1(E)		;CLEAR ENTIRE BLOCK
	MOVEI	S1,.CTVSL		;GET MINIMUM LENGTH WORD COUNT
	STORE	S1,.CTVFL(E),CT.FEL	;SAVE FILE ENTRY LENGTH
	POPJ	P,			;RETURN
SUBTTL	File I/O -- C$xRFM - Read file format


C$PRFM::TDZA	S1,S1			;PRIMARY DATA FILE
C$ARFM::MOVEI	S1,1			;ALTERNATE DATA FILE
XRFM:	$SAVE	<P1>			;SAVE P1
	MOVE	P1,S1			;COPY INDEX
	MOVE	S1,@IFNTAB(P1)		;GET IFN
	$CALL	F%IBYT			;READ A WORD
	JUMPF	@IERTAB(P1)		;CHECK FOR ERRORS
	MOVEM	S2,@FMTTAB(P1)		;SAVE FILE FORMAT NUMBER
	MOVE	S1,S2			;PUT IN BETTER PLACE
	AOS	@POSTAB(P1)		;ADVANCE POSITION
	JRST	.POPJ1			;AND RETURN
SUBTTL	File I/O -- C$xWFM - Write file format


C$PWFM::TDZA	S1,S1			;PRIMARY DATA FILE
C$AWFM::MOVEI	S1,1			;ALTERNATE DATA FILE
XWFM:	$SAVE	<P1>			;SAVE P1
	MOVE	P1,S1			;COPY INDEX
	MOVE	S1,@IFNTAB(P1)		;GET IFN
	MOVE	S2,@FMTTAB(P1)		;GET FILE FORMAT NUMBER
	$CALL	F%OBYT			;WRITE A WORD
	JUMPF	@OERTAB(P1)		;CHECK FOR ERRORS
	AOS	@POSTAB(P1)		;ADVANCE POSITION
	JRST	.POPJ1			;AND RETURN
SUBTTL	File I/O -- C$xREN - Read entry


C$PREN::TDZA	S1,S1			;PRIMARY DATA FILE
C$AREN::MOVEI	S1,1			;ALTERNATE DATA FILE
XREN:	$SAVE	<P1,P2>			;SAVE P1 AND P2
	MOVE	P1,S1			;SAVE FLAG
	PUSHJ	P,C$CLEN		;CLEAR OUT ENTRY STORAGE
	MOVE	S1,@IFNTAB(P1)		;GET IFN
	MOVE	S2,@POSTAB(P1)		;AND DESIRED POSITION
	$CALL	F%POS			;POSITION FOR INPUT
	JUMPF	XREN.5			;CHECK FOR ERRORS
	PUSHJ	P,XREN.3		;GET A WORD
	  POPJ	P,			;PROPAGATE ERROR BACK
	MOVEM	S1,(E)			;SAVE
	LOAD	S1,S1,CT.FEL		;GET FILE ENTRY LENGTH
	MOVN	P2,S1			;NEGATE
	HRLZS	P2			;PUT IN LH
	HRRI	P2,(E)			;MAKE AN AOBJN POINTER
	MOVE	S1,@FMTTAB(P1)		;GET FILE FORMAT NUMBER
	CAIN	S1,0			;OLD STYLE?
	ADDI	P2,1			;YES
	CAMN	S1,.CDFMT(C)		;CURRENT?
	AOBJN	P2,.+1			;INCREMENT FOR FIRST STORE

XREN.1:	PUSHJ	P,XREN.3		;GET A WORD
	  JRST	XREN.2			;INCOMPLETE ENTRY
	MOVEM	S1,(P2)			;PUT A WORD
	AOBJN	P2,XREN.1		;LOOP
	MOVE	S1,@IFNTAB(P1)		;GET IFN
	$CALL	F%CHKP			;CHECKPOINT
	MOVEM	S1,@POSTAB(P1)		;SAVE CURRENT POSITION
	JRST	.POPJ1			;AND RETURN

XREN.2:	CAIN	S1,EREOF$		;PREMATURE EOF?
	JRST	@PEFTAB(P1)		;YES
	JRST	@PSETAB(P1)		;POSITIONING ERROR

XREN.3:	MOVE	S1,@IFNTAB(P1)		;GET IFN
	$CALL	F%IBYT			;GET A WORD
	JUMPF	XREN.4			;FAILED
	MOVE	S1,S2			;COPY IT
	AOS	@POSTAB(P1)		;ADVANCE POSITION
	AOSA	(P)			;SKIP

XREN.4:	CAIN	S1,EREOF$		;EOF?
	POPJ	P,			;YES
	PJRST	@IERTAB(P1)		;NO--INPUT ERROR

XREN.5:	CAIE	S1,EREOF$		;END OF FILE?
	CAIN	S1,ERIFP$		;ILLEGAL FILE POSITION?
	POPJ	P,			;YES--DONE
	JRST	@PSETAB(P1)		;ELSE PROCESS ERRORS
SUBTTL	Volume-set processing -- C$AVSN - Allocate VSN storage


C$AVSN::MOVEI	S1,0			;INIT COUNTER
	MOVEI	S2,.CTVSN(E)		;POINT TO START OF STRING
	HRLI	S2,(POINT 7,)		;MAKE A BYTE POINTER

AVSN.1:	ILDB	TF,S2			;GET A CHARACTER
	SKIPE	TF			;END OF STRING?
	AOJA	S1,AVSN.1		;LOOP
	ADDI	S1,5			;ROUND UP TO A FULL WORD
	IDIVI	S1,5			;GET WORDS NEEDED FOR THIS STRING
	PUSH	P,S1			;SAVE WORD COUNT
	MOVE	S2,S1			;GET WORD COUNT
	MOVE	S1,.CDCOR(C)		;GET LINKED LIST HANDLE FOR CORE
	$CALL	L%CENT			;CREATE ENTRY
	POP	P,S1			;RESTORE WORD COUNT
	JUMPF	E$COR			;CHECK FOR ERRORS
	MOVSI	TF,.CTVSN(E)		;WHERE STRING RESIDES
	HRRI	TF,(S2)			;WHERE TO COPY IT
	ADDI	S1,(S2)			;COMPUTE END OF BLT
	BLT	TF,-1(S1)		;COPY STRING
	HRLZS	S2			;FOR S%TBLK
	JRST	.POPJ1			;RETURN WITH STRING ADDR IN S2
SUBTTL	Volume-set processing -- C$CVSN - Convert VSN to upper case


C$CVSN::MOVEI	S1,(T3)			;POINT TO START OF STRING
	HRLI	S1,(POINT 7,)		;MAKE A BYTE POINTER

CVSN.1:	ILDB	S2,S1			;GET A CHARACTER
	JUMPE	S2,.POPJ		;RETURN IF END OF VSN
	CAIL	S2,"A"+40		;LOWER
	CAILE	S2,"Z"+40		; CASE?
	SKIPA				;NO
	TRZ	S2,40			;CONVERT TO UPPER CASE
	DPB	S2,S1			;UPDATE
	JRST	CVSN.1			;LOOP THROUGH STRING
SUBTTL	Volume-set processing -- C$MVSN - Find a VSN in a message


C$MVSN::MOVE	P1,C$DSP		;POINT TO START OF DISPATCH VECTORS
	MOVE	S1,.OARGC(M)		;GET COUND OF ARGUMENTS IN MESSAGE
	CAIN	S1,1			;CAN ONLY BE ONE
	PUSHJ	P,C$GBLK		;GET ARGUMENT BLOCK
	  JRST	E$MDA			;ILLEGALY FORMATTED MDA MESSAGE
	CAIE	T1,.CTVSB		;VOLUME-SET BLOCK?
	JRST	E$MDA			;ILLEGALY FORMATTED MDA MESSAGE
	ADDI	T3,.CTVSN		;POINT TO THE VSN
	LOAD	S1,.CTVFL-.CTVSN(T3),CT.TYP ;GET REQUESTED CATALOG TYPE
	JUMPE	S1,MVSN.3		;MUST SEARCH ALL CATALOGS

MVSN.1:	CAMN	S1,.CVTYP(P1)		;A MATCH?
	JUMPN	MVSN.2			;GOT IT
	SKIPE	P1,.CVLNK(P1)		;NO--POINT TO NEXT VECTOR
	JRST	MVSN.1			;SEARCH FOR STR VECTOR

MVSN.2:	MOVE	C,.CVDAT(P1)		;POINT TO A DATA BASE
	TDZA	P1,P1			;CLEAR FOR NEXT TIME THOUGH

MVSN.3:	MOVE	C,.CVDAT(P1)		;POINT TO A DATA BASE
	MOVEI	S1,.CWDNI		;WAIT STATE TO CHECK
	CAMN	S1,.CDWSC(C)		;DATA BASE INITIALIZED?
	JRST	MVSN.4			;NOT AVAILABLE
	PUSHJ	P,C$TBLS		;SEARCH FOR THE VSN
	  JRST	MVSN.5			;VOLUME SET NOT FOUND
	TXNN	S2,TL%EXM		;ONLY ALLOW AN EXACT MATCH HERE
	JRST	MVSN.5			;ABBREVIATIONS ARE ILLEGAL FROM RCAT
	HRRZ	S2,(S1)			;GET FILE POSITION
	MOVEM	S2,.CDPFP(C)		;SAVE
	PUSHJ	P,C$PREN		;READ IN FROM DISK
	  POPJ	P,			;PROPAGATE ERRORS BACK
	JRST	.POPJ1			;RETURN

MVSN.4:	SKIPA	S1,[E$CNA]		;CATALOG NOT AVAILABLE
MVSN.5:	MOVEI	S1,E$VNF		;VOLUME-SET NOT FOUND
	SKIPE	P1			;END OF CHAIN
	SKIPN	P1,.CVLNK(P1)		;POINT TO NEXT
	SKIPA	S2,[SI.FLG]		;ELSE THAT'S AN ERROR
	JRST	MVSN.3			;TRY AGAIN
	TDNN	S2,G$IDX		;SENDER USE A SPECIAL INDEX?
	JRST	(S1)			;ACK WITH ERROR TEXT IF NO ONE SPECIAL
	POPJ	P,			;ELSE JUST RETURN
SUBTTL	Error processing


DEFINE	X	(ABV,FLG,CLS,TXT),<E$'ABV::!	JSP	TF,ERROR>
C$ERR::	ACKTXT

DEFINE	X	(ABV,FLG,CLS,TXT),<XWD	AM.'FLG+.AM'CLS,[ITEXT (<TXT>)]>
ERRTAB:	ACKTXT

DEFINE	X	(NAM,TXT),<XWD	''NAM'',[ITEXT	(<TXT>)]>
ERRTYP:	EXP	0
	ACKCLS

ERROR:	HRRZS	TF			;KEEP ONLY ADDRESS
	SUBI	TF,C$ERR		;CONVERT TO ERROR INDEX
	MOVEM	TF,ERRFLG		;SAVE ERROR CODE
	ADDI	TF,ERRTAB-1		;INDEX INTO ERROR TEXT TABLE
	MOVE	TF,@TF			;GET FLAGS+CLASS,,ITEXT BLOCK ADDRESS
	HLLM	TF,ERRFLG		;SAVE FLAGS+CLASS
	HRRZM	TF,ERRTXT		;SAVE
	MOVEI	TF,<ERRLEN*5>-1		;GET MAX CHARACTER COUNT
	MOVEM	TF,ERRCNT		;SAVE
	MOVE	TF,[POINT 7,ERRBUF]	;BYTE POINTER TO STORAGE
	MOVEM	TF,ERRPTR		;SAVE
	MOVE	TF,[ERRBUF,,ERRBUF+1]	;SET UP BLT
	SETZM	ERRBUF			;CLEAR FIRST WORD
	BLT	TF,ERRBUF+ERRLEN-1	;CLEAR ENTIRE BUFFER
	$TEXT	(<ERRCHR>,<^I/@ERRTXT/^0>) ;BUILD TEXT
	HRRZ	TF,ERRPTR		;GET FINAL ADDRESS FROM BYTE POINTER
	SUBI	TF,ERRBUF-1		;COMPUTE WORD COUNT (ALLOW EXTRA NULL)
	MOVEM	TF,ERRCNT		;UPDATE NOW AS A WORD COUNT
	POPJ	P,			;AND RETURN


ERRCHR:	SOSLE	ERRCNT			;COUNT DOWN
	IDPB	S1,ERRPTR		;STORE CHARACTER
	$RETT				;RETURN
TXTACK::PUSH	P,S1			;SAVE DISPLAY HEADER ITEXT BLOCK
	MOVEI	S1,.OMACS		;OPERATOR ACK
	STORE	S1,.MSTYP(M),MS.TYP	;SET MESSAGE TYPE
	SETZM	.MSFLG(M)		;NO SPECIAL FLAGS
	MOVE	S1,G$COD		;GET ACK CODE
	MOVEM	S1,.MSCOD(M)		;SAVE
	MOVX	S1,WT.SJI!WT.NFO	;NO JOB INFO, NO TEXT RE-FORMATTING
	MOVEM	S1,.OFLAG(P2)		;SAVE WTO FLAGS

; ADD DISPLAY HEADER BLOCK
	AOS	.OARGC(M)		;COUNT THE NEW BLOCK
	MOVEI	S1,.ORDSP		;BLOCK TYPE
	MOVEM	S1,.OHDRS(M)		;SAVE
	MOVEI	S1,.OHDRS(M)		;START ADDR OF TEXT BLOCK
	MOVEM	S1,.CDTXB(C)		;SAVE
	PUSH	P,S1			;SAVE
	$CALL	I%NOW			;GET CURRENT DATE/TIME
	POP	P,S2			;GET ADDRESS BACK
	MOVEM	S1,ARG.DA(S2)		;SAVE
	ADDI	S2,ARG.DA+1		;TEXT BEGINS HERE
	HRLI	S2,(POINT 7,)		;MAKE A BYTE POINTER
	MOVEM	S2,.CDTXP(C)		;SAVE
	HRRZS	S1			;KEEP JUST THE ADDRESS
	MOVE	S2,MSGLEN		;GET REQUESTED MESSAGE LENGTH
	SUBI	S2,.OHDRS+ARG.DA+1	;ACCOUNT FOR OVERHEAD WORDS +1
	IMULI	S2,5			;COMPUTE CHARACTER COUNT
	MOVEM	S2,.CDTXC(C)		;SAVE
	POP	P,S1			;GET ITEXT BLOCK BACK
	$TEXT	(C$TXTC,<^I/(S1)/^0>)	;STORE
	AOS	S1,.CDTXP(C)		;GET FINAL ADDRESS
	SUBI	S1,.OHDRS(M)		;COMPUTE WORD COUNT
	STORE	S1,.OHDRS+ARG.HD(M),AR.LEN ;SAVE

; ADD THE TEXT BLOCK
	AOS	.OARGC(M)		;COUNT THE NEW BLOCK
	HRRZ	S1,.CDTXP(C)		;NEXT BLOCK GOES HERE
	MOVEM	S1,.CDTXB(C)		;SAVE
	MOVEI	S2,.CMTXT		;BLOCK TYPE
	MOVEM	S2,ARG.HD(S1)		;SAVE
	MOVEI	S2,ARG.DA(S1)		;WHERE THE TEXT WILL BEGIN
	HRLI	S2,(POINT 7,)		;MAKE A BYTE POINTER
	MOVEM	S2,.CDTXP(C)		;SAVE
	HRRZS	S1			;KEEP JUST THE ADDRESS
	SUBI	S1,(M)			;COMPUTE WORDS USED SO FAR
	MOVE	S2,MSGLEN		;GET REQUESTED MESSAGE LENGTH
	SUBI	S2,(S1)			;GET WORDS REMAINING
	IMULI	S2,5			;COMPUTE CHARACTER COUNT
	MOVEM	S2,.CDTXC(C)		;SAVE
	POPJ	P,			;RETURN

C$CRLF::MOVEI	S1,.CHCRT		;CARRIAGE RETURN
	PUSHJ	P,C$TXTC		;OUTPUT
	MOVEI	S1,.CHLFD		;LINE FEED

C$TXTC::SKIPE	.CDTXF(C)		;DOING A LISTING?
	JRST	TXTLST			;YES
	SOSLE	.CDTXC(C)		;COUNT DOWN
	IDPB	S1,.CDTXP(C)		;STORE CHARACTER
	$RETT				;RETURN

TXTLST:	PUSH	P,S2			;SAVE S2
	MOVE	S2,S1			;GET CHARACTER
	SKIPG	.CDLPN(C)		;INITIALIZED YET?
	JRST	TXTLS1			;DO IT NOW
	CAIN	S2,.CHLFD		;LINE FEED?
	AOS	.CDLLN(C)		;YES--INCREMENT LINE NUMBER
	MOVE	S1,.CDLLN(C)		;GET LINE NUMBER
	CAIE	S1,LINPPG		;PAGE FULL?
	JRST	TXTLS2			;NOT YET

TXTLS1:	PUSH	P,S2			;SAVE CHARACTER TO OUTPUT
	MOVEI	S2,.CHFFD		;GET A FORM FEED
	PUSHJ	P,TXTLSX		;OUTPUT IT
	  POPJ	P,			;PROPAGATE ERROR BACK
	MOVEI	S2,1			;FIRST LINE
	MOVEM	S2,.CDLLN(C)		;RESET LINE COUNTER
	AOS	.CDLPN(C)		;INCREMENT PAGE NUMBER
	PUSHJ	P,LISTHD		;OUTPUT LISTING HEADER
	POP	P,S2			;RESTORE CHARACTER
	CAIN	S2,.CHLFD		;LINE FEED CAUSE NEW PAGE?
	JRST	TXTLS3			;YES--ALREADY HAVE A NEW LINE

TXTLS2:	MOVE	S1,.CDLIF(C)		;GET IFN
	$CALL	F%OBYT			;OUTPUT
	JUMPF	[HALT .]

TXTLS3:	POP	P,S2			;RESTORE S2
	$RETT				;AND RETURN

TXTLSX:	MOVE	S1,.CDLIF(C)		;GET IFN
	$CALL	F%OBYT			;OUTPUT CHARACTER
	JUMPF	E$LOE			;LISTING OUTPUT ERROR
	JRST	.POPJ1			;RETURN

TXTDON:	MOVEI	S1,.CHNUL		;GET A NUL
	PUSHJ	P,C$TXTC		;STORE
	MOVE	S1,.CDTXB(C)		;STARTING ADDRESS OF TEXT BLOCK
	AOS	S2,.CDTXP(C)		;GET FINAL ADDRESS
	HRRZS	S2			;STRIP OFF JUNK
	SUB	S2,S1			;COMPUTE WORDS USED
	STORE	S2,ARG.HD(S1),AR.LEN	;SAVE LENGTH
	HRRZ	S1,.CDTXP(C)		;GET FINAL ADDRESS AGAIN
	SUBI	S1,(M)			;COMPUTE TOTAL WORDS IN MESSAGE
	STORE	S1,.MSTYP(M),MS.CNT	;SAVE
	POPJ	P,			;RETURN
SUBTTL	End


	END	CATLOG