UNIVERSAL QUEUNV - DEFINITIONS FOR CONDITIONAL ASSEMBLY OF QUEWMU

COMMENT	%

TO ASSEMBLE FOR GALAXY QUEUEING SYSTEM DEFINE FTGALAXY=1
TO ASSEMBLE FOR AN MPB QUEUEING SYSTEM DEFINE FTMPB=1
TO ASSEMBLE A QUEUEING SYSTEM WHICH WILL WORK ON EITHER TOPS10 GALAXY OR MPB,
	DEFINE BOTH FTGALAXY=1 AND FTMPB=1.  THIS IS USEFUL WHEN RUNNING EACH
	SYSTEM PART OF THE TIME, BUT IS TOO BIG FOR LONG TERM USE.

%

IFNDEF	FTGALAXY,<FTGALAXY==0>		;1 IF GALAXY
IFNDEF	FTMPB,<
	IFE FTGALAXY,<FTMPB==1>		;1 FOR MPB
	IFN FTGALAXY,<FTMPB==0>>	;0 FOR NO MPB
IFN FTGALAXY,<
	SEARCH	QSRMAC,SBSMAC
	IFN FTJSYS,<FTMPB==0>		;NO MPB ON TOPS20
>
FTBOTH==FTGALAXY*FTMPB			;WANT BOTH ON TOPS10?
IFE FTGALAXY,<
	IFE FTMPB,<
		PRINTX ?FTGALAXY AND FTMPB CANNOT BOTH BE ZERO
		PASS2
		END
>>

DEFINE IFGALX(LABEL),<		;EXECUTE NEXT BLOCK ONLY IF GALAXY SYSTEM
IFN FTBOTH,<
	IFB <LABEL>,<JUMPGE	F,.+2>
	IFNB <LABEL>,<JUMPGE	F,LABEL>
>
>

DEFINE IFMPB(LABEL),<		;EXECUTE NEXT BLOCK ONLY IF MPB SYSTEM
IFN FTBOTH,<
	IFB <LABEL>,<JUMPL	F,.+2>
	IFNB <LABEL>,<JUMPL	F,LABEL>
>
>

; FLAG BITS IN LH OF F
GALAXY==400000	;FLAG THAT THIS IS A GALAXY SYSTEM. MUST BE SIGN BIT
NEDREN==200000	;FLAG IN $DOFIL THAT A RENAME IS NEEDED
LOGFIL==100000	;FLAG TO DOFIL$ THAT THIS IS THE LOG FILE
CTLFIL==40000	;FLAG TO DOFIL$ THAT THIS IS THE CTL FILE
IFNDEF LANGSW,<LANGSW==0>	;0 = FORTRA
				;1 = COBOL
				;-1 = ALGOL

IFG LANGSW,<	;IF COBOL
	F40LIB==0
	P=17
	DEFINE	HELLO(A),<
	SALL
	ENTRY A
A:
>
	DEFINE	GOODBY(A),<
	POPJ	P,A
>
>

IFL LANGSW,<	;IF ALGOL
	F40LIB==0
	P=17
	.EXIT==1
	DEFINE	HELLO(A),<
	SALL
	EXTERNAL %ALGDR
	ENTRY	A
>
	DEFINE	GOODBY(A),<
	JRST	[MOVE	14,SAVE14#	;RESTORE AN AC
	 	JRST	.EXIT(DL)]
>
>

IF1 <
IFN FTBOTH,<PRINTX ASSEMBLING FOR TOPS10 GALAXY AND MPB>
IFE FTBOTH,<
  IFN FTGALAXY,<
    IFN FTJSYS,<PRINTX ASSEMBLING FOR TOPS20 GALAXY>
    IFE FTJSYS,<PRINTX ASSEMBLING FOR TOPS10 GALAXY>
  >
  IFN FTMPB,<PRINTX ASSEMBLING FOR TOPS10 MPB>
>
IFG LANGSW,<PRINTX ASSEMBLING COBOL CALLING SEQUENCE>
IFE LANGSW,<PRINTX ASSEMBLING FORTRAN-10 CALLING SEQUENCE>
IFL LANGSW,<PRINTX ASSEMBLING ALGOL CALLING SEQUENCE>
>
	PRGEND
	TITLE	PRINTS - ROUTINE TO ENTER FILE IN PRINT QUEUE
	SUBTTL	USAGE INSTRUCTIONS

	SEARCH	MACTEN,UUOSYM,QUEUNV

IFE LANGSW,<SEARCH	FORPRM	;IF COMPILING FOR FORTRA>
IFL LANGSW,<SEARCH ALGPRM,ALGSYS	;IF COMPILING FOR ALGOL>
IFN FTGALAXY,<
	SEARCH	QSRMAC,SBSMAC
IFN FTJSYS,<
	SEARCH	MONSYS		;TOPS20 DEFINITIONS
>
>
IFN FTMPB,<
	SEARCH	QPRM
>

; FORPRM IS UNIVERSAL FILE FROM FOROTS
; ALGPRM IS UNIVERSAL FILE FOR ALGOL
; ALGSYS IS UNIVERSAL FILE FOR ALGOL
; QPRM   IS UNIVERSAL FILE FOR QUEUE DEFINITIONS. SEE ...
; MACTEN IS UNIVERSAL FILE WITH USEFUL MACRO DEFINITIONS SEE ...
; UUOSYM IS UNIVERSAL FILE WITH UUO SYMBOLS DEFINITIONS SEE ...
; QSRMAC IS UNIVERSAL FILE FOR GALAXY
; SBSMAC IS UNIVERSAL FILE FOR GALAXY
; MONSYS IS UNIVERSAL FILE FOR TOPS20

	XLIST
IFE LANGSW,<	;IF FORTRA
	LIST
COMMENT	%

THE PURPOSE OF THIS ROUTINE IS TO ENTER A REQUEST IN THE PRINT(SPOOL)
QUEUE FROM A FORTRAN OR MACRO PROGRAM.

CALLING SEQUENCE
	CALL PRINTS('FILENAME.EXT',IARG1,IARG2,IARG3)
OR
	CALL PRINTS('FILENAME.EXT',IARG1,IARG2,IARG3,IARG4)
WHERE
	FILENAME	6 OR FEWER CHARACTERS.
	EXT		3 OR FEWER CHARACTERS.(MAY BE NULL)
	IARG1		2 IF FILE IS TO BE RENAMED OUT OF AREA.
			(MPB SYSTEMS ONLY. SAME AS 1 ON GALAXY SYSTEMS)
			1 IF FILE IS TO BE DELETED.
			0 IF FILE IS TO BE PRESERVED.
	IARG2		1 IF FORTRAN FORMATTED OUTPUT
			0 IF OTHER THAN FORTRAN FORMATTED OUTPUT
	IARG3		LESS THAN OR EQUAL 0 IMPLIES 1 COPY.
			GREATER THAN 63 IMPLIES 1 COPY.
			1-63 IMPLIES THAT NUMBER OF COPIES.
	IARG4		OPTIONAL PAGE LIMIT.[DEFAULT IF OMITTED IS
			(#BLOCKS WRITTEN)*COPIES+20]

%
	XLIST
>
IFG LANGSW,<	;IF COBOL
	LIST
COMMENT	%

THE PURPOSE OF THIS ROUTINE IS TO ENTER A REQUEST IN THE PRINT(SPOOL)
QUEUE FROM A COBOL PROGRAM.

CALLING SEQUENCE
	ENTER MACRO PRINTS USING FILE-NAME IARG1 IARG2 IARG3 IARG4.
WHERE
	FILE-NAME	9 OR FEWER CHARACTER DISPLAY-6 OR DISPLAY-7.

	ARGS ARE ALL USAGE COMPUTATIONAL OR NUMERIC LITERALS.
	IARG1		2 IF FILE IS TO BE RENAMED OUT OF AREA.
			(MPB SYSTEMS ONLY. SAME AS 1 ON GALAXY SYSTEMS)
			1 IF FILE IS TO BE DELETED.
			0 IF FILE IS TO BE PRESERVED.
	IARG2		2 IF COBOL SIXBIT FORMATTED OUTPUT
			1 IF FORTRAN FORMATTED OUTPUT
			0 IF OTHER THAN FORTRAN FORMATTED OUTPUT
	IARG3		LESS THAN OR EQUAL 0 IMPLIES 1 COPY.
			GREATER THAN 63 IMPLIES 1 COPY.
			1-63 IMPLIES THAT NUMBER OF COPIES.
	IARG4		OPTIONAL PAGE LIMIT.[DEFAULT IF OMITTED IS
			(#BLOCKS WRITTEN)*COPIES+20]

%
	XLIST
>
IFL LANGSW,<	;IF ALGOL
	LIST

COMMENT	%

THE PURPOSE OF THIS ROUTINE IS TO ENTER A REQUEST IN THE PRINT(SPOOL)
QUEUE FROM AN ALGOL PROGRAM.

CALLING SEQUENCE
	PRINTS('FILENAME.EXT',IARG1,IARG2,IARG3);
OR
	PRINTP('FILENAME.EXT',IARG1,IARG2,IARG3,IARG4);
WHERE
	FILENAME	6 OR FEWER CHARACTERS.
	EXT		3 OR FEWER CHARACTERS.(MAY BE NULL)
	IARG1		2 IF FILE IS TO BE RENAMED OUT OF AREA.
			1 IF FILE IS TO BE DELETED.
			0 IF FILE IS TO BE PRESERVED.
	IARG2		1 IF FORTRAN FORMATTED OUTPUT
			0 IF OTHER THAN FORTRAN FORMATTED OUTPUT
	IARG3		LESS THAN OR EQUAL 0 IMPLIES 1 COPY.
			GREATER THAN 63 IMPLIES 1 COPY.
			1-63 IMPLIES THAT NUMBER OF COPIES.
	IARG4		OPTIONAL PAGE LIMIT.[DEFAULT IF OMITTED IS
			(#BLOCKS WRITTEN+20)*COPIES]


%

	XLIST
>

	LIST
	SUBTTL	DATA AND DEFINITIONS
; AC DEFINITIONS
	F=0
	A=1
	S1=A
	B=2
	S2=B
	C=3
	WD=4		;SIXBIT ANSWER FROM ASCSIX
	T1=WD
	BP6=5		;SIXBIT POINTER
	T2=BP6
	BP7=6		;ASCII POINTER
	T3=BP7
	N=7		;NUMBER
	T4=N
	CH=10		;CHARACTER
	T5=CH
	M=T5
	V=11		;POINTER TO ARG VECTOR
	QD=12		;QUE TYPE
	QF=13		;POINTER TO CURRENT FILE BLOCK IN QUE BLOCK
	Q=14		;POINTER TO QUE AREA
	SUBTTL	PRINTS - DO THE WORK
	HELLO	(PRINTS)		;PRINTS ENTRY
IFL LANGSW,<	;IF ALGOL
IFGE <MAJVNO-5>,<
PRTSPM:	Z			;POST-MORTEM BLOCK
	XWD	2,7		;WORDS, CHARACTERS+ "*"
	SIXBIT/PRINTS*/		;SIXBIT NAME PLUS "*"
>
PRINTS:	JSP	AX,PARAM	;4 ARGUMENT ENTRY (DEFAULT PAGE LIMITS)
IFGE <MAJVNO-5>,<
	PRTSPM			;POINTER TO POST MORTEM BLOCK
>
	XWD	0,15
	XWD	$PRO!$N!$SIM,5
	XWD	$VAR!$S!$FOV,3
	XWD	$VAR!$I!$FOV,5
	XWD	$VAR!$I!$FOV,6
	XWD	$VAR!$I!$FOV,7
	SETZM	ARG5#		;NO FIFTH ARG
	JRST	APRNT1		;GO ON

	HELLO	(PRINTP)		;5 ARGUMENT ENTRY
IFGE <MAJVNO-5>,<
PRTPPM:	Z			;POST-MORTEM BLOCK
	XWD	2,7		;WORDS, CHARACTERS + "*"
	SIXBIT/PRINTP*/		;SIXBIT NAME + "*"
>
PRINTP:	JSP	AX,PARAM	;5 ARGUMENT ENTRY(PAGE LIMIT SPECIFIED
IFGE <MAJVNO-5>,<
	PRTPPM			;POINTER TO POST MORTEM BLOCK
>
	XWD	0,15
	XWD	$PRO!$N!$SIM,6
	XWD	$VAR!$S!$FOV,3
	XWD	$VAR!$I!$FOV,5
	XWD	$VAR!$I!$FOV,6
	XWD	$VAR!$I!$FOV,7
	XWD	$VAR!$I!$FOV,10
	SETOM	ARG5#		;HAVE FIFTH ARG
APRNT1:	MOVEM	14,SAVE14#
>	;END IFL LANGSW
	PUSHJ	P,FIRCH$##	;GET THE PRIMARY CHANNEL
	 JRST	NODSK		;IF ERROR, GIVE SECOND MESSAGE
	SETZ	QD,		;MODE IS PRINT QUEUE
	PUSHJ	P,GTINF$##	;GET SOME INFO AND INIT  QUE BLOCK
	PUSHJ	P,OPDSK$##	;OPEN THE DISK
	 JRST	NODSK

IFN FTMPB,<
	IFMPB	PRT1
	HRRZI	A,111000	;SINGLE SPACED ASCII
IFGE LANGSW,<	;IF FORTRA OR COBOL
	SKIPE	B,@2(16)
>
IFL LANGSW,<	;IF ALGOL
	SKIPE	B,6(DL)
>
	MOVEI	A,112000	;MAKE THAT FORTRAN
IFG LANGSW,<	;IF COBOL
	CAIN	B,2		;UNLESS WANTS COBOL FROM COBOL
	MOVEI	A,113000	;GIVE IT TO HIM
>
	MOVEM	A,Q.OMOD(Q)
PRT1:>
IFN FTGALAXY,<
	IFGALX	PRT2
	MOVSI	A,010101	;SINGLE SPACED ASCII
IFGE LANGSW,<	;IF FORTRA OR COBOL
	SKIPE	B,@2(16)
>
IFL LANGSW,<	;IF ALGOL
	SKIPE	B,6(DL)
>
	MOVSI	A,020101	;SINGLE SPACED FORTRAN OUTPUT
IFG LANGSW,<	;IF COBOL
	CAIN	B,2		;WANT COBOL FROM COBOL?
	MOVSI	A,030101	;SINGLE SPACED COBOL OUTPUT
>
	TRO	A,FP.NFH	;NO HEADERS
	MOVEM	A,.FPINF(QF)	;STORE FOR FILE
PRT2:>

	MOVEI	A,^D10		;DEFAULT PRIORITY IS 10
IFN FTMPB,<
	IFMPB
	DPB	A,[POINTR(Q.PRI(Q),QP.PRI)]
>
IFN FTGALAXY,<
	IFGALX
	DPB	A,[POINTR(.EQSEQ(Q),EQ.PRI)]
>

IFN FTMPB,<
	IFMPB	PRT3
	MOVEI	B,.QFDDE	;ASSUME /DISP:DEL
IFGE LANGSW,<	;IF FORTRA OR COBOL
	SKIPG	A,@1(16)	;IS IT /DISP:PRE?
>
IFL LANGSW,<	;IF ALGOL
	SKIPG	A,5(DL)		;IS IT /DISP:PRE?
>
	MOVEI	B,.QFDPR	;YES
	CAIN	A,2		;IS IT /DISP:REN
	MOVEI	B,.QFDRE	;YES
	DPB	B,[POINTR(Q.OMOD(Q),QF.DSP)]
PRT3:>
IFN FTGALAXY,<
	IFGALX	PRT4
	MOVEI	A,FP.DEL	;DELETE BIT
IFGE LANGSW,<	;IF FORTRA OR COBOL
	SKIPE	@1(16)		;DISPOSE:PRESERVE?
>
IFL LANGSW,<	;IF ALGOL
	SKIPG	5(DL)		;DISPOSE:PRESERVE?
>
	IORM	A,.FPINF(QF)	;SET BIT FOR FILE
PRT4:>

	PUSHJ	P,FILNMO
	PUSHJ	P,DOFIL$##	;GO DO THE FILE THINGS
	 JRST	NTFND		;FILE NOT FOUND

IFGE LANGSW,<	;IF FORTRA OR COBOL
	SKIPLE	A,@3(16)	;/COPIES
>
IFL LANGSW,<	;IF ALGOL
	SKIPLE	A,7(DL)		;/COPIES
>
	CAILE	A,^D63
	MOVEI	A,1
IFN FTMPB,<
	IFMPB
	DPB	A,[POINTR(Q.OMOD(Q),QF.COP)]
>
IFN FTGALAXY,<
	IFGALX
	DPB	A,[POINTR(.FPINF(QF),FP.FCY)]
>

	IMUL	A,$RBSIZ##
	MOVE	B,A		;MAKE A COPY
IFN FTMPB,<
	IFMPB	PRT5
	ASH	A,-^D10		;DIVIDE BY 1024
	ADDI	A,1
	HRRM	A,Q.OSIZ(Q)	;QS.BLK
PRT5:>

	IDIVI	B,200
	SKIPE	C
	ADDI	B,1
IFN FTGALAXY,<
	IFGALX	PRT6
	MOVE	A,B		;COPY
IFN FTJSYS,<
	ADDI	A,3		;CONVERT TO PAGES
	LSH	A,-2
>
	HRLM	A,.EQLM2(Q)	;BLOCKS*COPIES
PRT6:>
	ADDI	B,^D20		;FUDGE FACTOR
IFN F40LIB,<
	TLNN	16,-1		;F10?
	 JRST	CHKF10		;YES
	HLRZ	A,4(16)
	TRZ	A,740
	CAIE	A,(JUMP 0)
	JRST	DEFALT
	JRST	F40ARG
>
IFGE LANGSW,<	;IF FORTRA OR COBOL
CHKF10:	HLRE	A,-1(16)
	MOVMS	A
	CAIGE	A,5		;LIMIT ARG?
	JRST	DEFALT		;NO
F40ARG:	SKIPLE	A,@4(16)
>
IFL LANGSW,<	;IF ALGOL
	SKIPN	ARG5		;FIFTH ARGUMENT?
	JRST	DEFALT		;NO
	SKIPLE	A,10(DL)	;YES
>
	MOVE	B,A		;ONLY ACCEPT ESTIMATE IF POSITIVE
	CAILE	B,777776	;LESS THAN MAX?
	MOVEI	B,777776	;NO
DEFALT:
IFN FTMPB,<
	IFMPB
	HRLM	B,Q.OSIZ(Q)	;PAGE LIMIT (QS.LIM)
>
IFN FTGALAXY,<
	IFGALX
	HRRM	B,.EQLM2(Q)	;PAGE LIMIT
>

	PUSHJ	P,$DOQUE##	;ACTUALLY QUE THE FILE
	 JFCL			;ALREADY GAVE ERROR MESSAGE
RETPRT:	PUSHJ	P,XUUO$##	;MAKE SURE WE GIVE BACK PRIMARY CHANNEL
	RELEAS	0,
	GOODBY	200004		;AT LEAST FOUR ARG RETURN

NODSK:	OUTSTR	[ASCIZ\
CANNOT INIT DISK!
\]
	JRST	RETPRT
NTFND:	OUTSTR	[ASCIZ\
FILE NOT FOUND!
\]
	JRST	RETPRT

FILNMO:	SETZB	A,B
IFE LANGSW,<	;IF FORTRAN
	MOVEI	BP7,@(16)
	MOVEI	N,^D9		;NINE POSSIBLE CHARACTERS.
	HRLI	BP7,440700	;MAKE POINTER TO STRING.
>
IFG LANGSW,<	;IF COBOL
	MOVE	T1,(16)		;GET ARG
	MOVE	BP7,(T1)	;GET POINTER
	LDB	C,[POINT 6,BP7,11] ;DISPLAY SIZE
	HRRZ	N,1(T1)		;GET CHARACTER COUNT
	CAILE	N,^D9		;MORE THAN 9?
	MOVEI	N,^D9		;JUST 9
>
IFL LANGSW,<
	MOVE	BP7,3(DL)	;GET BYTE POINTER
IFL <MAJVNO-5>,<
	TLO	BP7,440700	;BE SURE
>
	HRRZ	N,4(DL)		;GET BYTE COUNT
	CAILE	N,^D10		;TOO BIG?
	MOVEI	N,^D10		;YES. SHRINK
>
	MOVE	BP6,[POINT 6,A]
GETCHR:	ILDB	CH,BP7
IFE LANGSW,<	;IF FORTRA
	JUMPE	CH,CPOPJ
	CAIN	CH,"."
	JRST	[MOVEI	N,3
		 MOVE	BP6,[POINT 6,B]
		 JRST	GETCHR]
>
IFG LANGSW,<	;IF COBOL
	CAIN	C,7		;ALREADY SIXBIT?
>
IFL LANGSW,<	;IF ALGOL
	JUMPE	CH,CPOPJ
	CAIN	CH,"."
	 JRST	[CAILE	N,4
		 MOVEI	N,4	;REDUCE TO EXT + 1
		 MOVE	BP6,[POINT 6,B] ;FOR EXT
		 SOJG	N,GETCHR	;ANY EXTENSION?
		 JRST	CPOPJ ]	;NO
>
	SUBI	CH,40
	IDPB	CH,BP6
	SOJG	N,GETCHR
CPOPJ:	POPJ	P,
	PRGEND
	TITLE	QUEOUT - ROUTINES TO MAKE OUTPUT QUEUE ENTRIES
	SUBTTL	USAGE INSTRUCTIONS

	SEARCH	MACTEN,UUOSYM,QPRM,QUEUNV

IFE LANGSW,<SEARCH	FORPRM	;IF COMPILING FOR FORTRA>
IFL LANGSW,<SEARCH ALGPRM,ALGSYS	;IF COMPILING FOR ALGOL>
IFN FTGALAXY,<
	SEARCH	QSRMAC,SBSMAC
IFN FTJSYS,<
	SEARCH	MONSYS		;TOPS20 DEFINITIONS
>
>

; FORPRM IS UNIVERSAL FILE FROM FOROTS
; ALGPRM IS UNIVERSAL FILE FOR ALGOL
; ALGSYS IS UNIVERSAL FILE FOR ALGOL
; QPRM   IS UNIVERSAL FILE FOR QUEUE DEFINITIONS. SEE ...
; MACTEN IS UNIVERSAL FILE WITH USEFUL MACRO DEFINITIONS SEE ...
; UUOSYM IS UNIVERSAL FILE WITH UUO SYMBOLS DEFINITIONS SEE ...
; QSRMAC IS UNIVERSAL FILE FOR GALAXY
; SBSMAC IS UNIVERSAL FILE FOR GALAXY
; MONSYS IS UNIVERSAL FILE FOR TOPS20
	XLIST
IFE LANGSW,<	;IF FORTRA
	LIST
COMMENT	%

USAGE	CALL QUEOUT(DEVICE,FILENAME,QUE,VECTOR,ERROR)

WHERE
	DEVICE - IS DEVICE FILE IS ON. (MUST BE SOME KIND OF DSK)

	FILENAME - IS TWO WORD ASCII FILENAME TO OUTPUT

	QUE      - IS ASCII NAME OF QUEUE TO PUT FILE IN
			(MAY BE LPT, CDP, PTP, OR PLT)

	IERR     - IS ERROR CODE
			VALUE	MEANING
			  0	   OK
			  1	UNDEFINED QUE
			  2	ILLEGAL DEVICE OR OPEN FAILED
			  3	ILLEGAL FILE NAME
			  4	NO SUCH FILE
			  5	ILLEGAL ARGUMENT IN VECTOR
			  6	CANNOT OPEN QUE DEVICE
			  7	CANNOT ENTER QUEUE COMMAND FILE

	VECTOR    - IS A FOURTEEN(14) WORD INTEGER ARRAY OF ARGUMENTS
		VECTOR(1)	/FILE: ARGUMENT
				 1=ASCII (DEFAULT)
				 2=FORTRAN DATA
				 3=COBOL
				 4=CREF(NOT IMPLEMENTED. ASSUMES ASCII)
				 5=RUNOFF(NOT IMPLEMENTED. ASSUMES ASCII)
				 6=ELEVEN
		VECTOR(2)	/LIMIT: ARGUMENT
		VECTOR(3)	/COPIES:N (FROM 1 TO 63)
		VECTOR(4)	/DISP:
				 1=PRESERVE
				 2=RENAME (ONLY FOR MPB SYSTEMS. ON GALAXY
					SYSTEMS EQUIVALENT TO DELETE)

				 3=DELETE
		VECTOR(5)	AFTER SWITCH PART ONE
				TIME OF DAY OR PLUS TIME IN MINUTES
				PLUS TIME IS INDICATED BY A NEGATIVE IN VECTOR(6)
		VECTOR(6)	AFTER SWITCH PART TWO
				DATE IN 15 BIT FORMAT OR ZERO FOR TODAY
				NEGATIVE INDICATES TIME IS PLUS FORMAT
		VECTOR(7)	DEADLINE SWITCH PART ONE. SAME AS AFTER
		VECTOR(8)	DEADLINE SWITCH PART TWO. SAME AS AFTER
		VECTOR(9)	/PRIORITY:(N+1)
				GIVE NUMBER IN RANGE 1 TO 63. ACTUAL
				PRIORITY IS ONE LESS. DEFAULT IS 10
		VECTOR(10)	/PAPER: ARGUMENT
			   VALUE		MEANING
					LPT      CDP      PTP      PLT
				1	ARROW(*) ASCII(*) ASCII(*) IMAGE
				2	ASCII    026      IMAGE    ASCII(*)
				3	OCTAL    BINARY   IMG BIN  BINARY
				4	SUPPRESS D029     BINARY
				5	         IMAGE

		VECTOR(11)	/HEAD:N
				 0=NO HEADER
				 1=FILE HEADER
		VECTOR(12)	/SPACING: ARGUMENT
				 1=SINGLE
				 2=DOUBLE
				 3=TRIPLE
		VECTOR(13)	/FORMS:NAME
				 FIRST FIVE CHARACTERS
		VECTOR(14)	  REMAINING CHARACTER TO FORMS NAME
				ASCII NAME OF SPECIAL FORMS TO USE

%
	XLIST
>
IFG LANGSW,<	;IF COBOL
	LIST
COMMENT	%

USAGE	ENTER MACRO QUEOUT USING DEVICE,FILENAME,QUE,VECTOR,ERROR.

WHERE
	DEVICE - IS DEVICE FILE IS ON. (MUST BE SOME KIND OF DSK)
			DISPLAY-6 OR DISPLAY-7.

	FILENAME - IS NAME OF FILE TO OUTPUT
			DISPLAY-6 OR DISPLAY-7.

	QUE      - IS NAME OF QUEUE TO PUT FILE IN
			(MAY BE LPT, CDP, PTP, OR PLT)
			DISPLAY-6 OR DISPLAY-7.

	ERROR     - IS ERROR CODE (COMPUTATIONAL.)
			VALUE	MEANING
			  0	   OK
			  1	UNDEFINED QUE
			  2	ILLEGAL DEVICE OR OPEN FAILED
			  3	ILLEGAL FILE NAME
			  4	NO SUCH FILE
			  5	ILLEGAL ARGUMENT IN VECTOR
			  6	CANNOT OPEN QUE DEVICE
			  7	CANNOT ENTER QUEUE COMMAND FILE

	VECTOR    - IS A THIRTEEN(13) WORD INTEGER ARRAY OF ARGUMENTS
		VECTOR(1)	/FILE: ARGUMENT
				 1=ASCII (DEFAULT)
				 2=FORTRAN DATA
				 3=COBOL
				 4=CREF(NOT IMPLEMENTED. ASSUMES ASCII)
				 5=RUNOFF(NOT IMPLEMENTED. ASSUMES ASCII)
				 6=ELEVEN
		VECTOR(2)	/LIMIT: ARGUMENT
		VECTOR(3)	/COPIES:N (FROM 1 TO 63)
		VECTOR(4)	/DISP:
				 1=PRESERVE
				 2=RENAME (ONLY FOR MPB SYSTEMS. ON GALAXY
					SYSTEMS EQUIVALENT TO DELETE)

				 3=DELETE
		VECTOR(5)	AFTER SWITCH PART ONE
				TIME OF DAY OR PLUS TIME IN MINUTES
				PLUS TIME IS INDICATED BY A NEGATIVE IN VECTOR(6)
		VECTOR(6)	AFTER SWITCH PART TWO
				DATE IN 15 BIT FORMAT OR ZERO FOR TODAY
				NEGATIVE INDICATES TIME IS PLUS FORMAT
		VECTOR(7)	DEADLINE SWITCH PART ONE. SAME AS AFTER
		VECTOR(8)	DEADLINE SWITCH PART TWO. SAME AS AFTER
		VECTOR(9)	/PRIORITY:(N+1)
				GIVE NUMBER IN RANGE 1 TO 63. ACTUAL
				PRIORITY IS ONE LESS. DEFAULT IS 10
		VECTOR(10)	/PAPER: ARGUMENT
			   VALUE		MEANING
					LPT      CDP      PTP      PLT
				1	ARROW(*) ASCII(*) ASCII(*) IMAGE
				2	ASCII    026      IMAGE    ASCII(*)
				3	OCTAL    BINARY   IMG BIN  BINARY
				4	SUPPRESS D029     BINARY
				5	         IMAGE

		VECTOR(11)	/HEAD:N
				 0=NO HEADER
				 1=FILE HEADER
		VECTOR(12)	/SPACING: ARGUMENT
				 1=SINGLE
				 2=DOUBLE
				 3=TRIPLE
		VECTOR(13)	/FORMS:NAME
				NAME OF SPECIAL FORMS TO USE
				MUST BE ZERO OR DISPLAY-6 NAME.

%
	XLIST
>
IFL LANGSW,<	;IF ALGOL
	LIST
COMMENT	%

USAGE	QUEOUT(DEVICE,FILENAME,QUE,VECTOR,ERRCOD);

WHERE
	DEVICE - IS DEVICE FILE IS ON. (MUST BE SOME KIND OF DSK)
			STRING VARIABLE (ASCII).

	FILENAME - IS NAME OF FILE TO OUTPUT
			STRING VARIABLE (ASCII).

	QUE      - IS NAME OF QUEUE TO PUT FILE IN
			(MAY BE LPT, CDP, PTP, OR PLT)
			STRING VARIABLE (ASCII).

	ERRCOD     - IS ERROR CODE (INTEGER.)
			VALUE	MEANING
			  0	   OK
			  1	UNDEFINED QUE
			  2	ILLEGAL DEVICE OR OPEN FAILED
			  3	ILLEGAL FILE NAME
			  4	NO SUCH FILE
			  5	ILLEGAL ARGUMENT IN VECTOR
			  6	CANNOT OPEN QUE DEVICE
			  7	CANNOT ENTER QUEUE COMMAND FILE

	VECTOR    - IS A FOURTEEN(14) WORD INTEGER ARRAY OF ARGUMENTS
		VECTOR(1)	/FILE: ARGUMENT
				 1=ASCII (DEFAULT)
				 2=FORTRAN DATA
				 3=COBOL
				 4=CREF(NOT IMPLEMENTED. ASSUMES ASCII)
				 5=RUNOFF(NOT IMPLEMENTED. ASSUMES ASCII)
				 6=ELEVEN
		VECTOR(2)	/LIMIT: ARGUMENT
		VECTOR(3)	/COPIES:N (FROM 1 TO 63)
		VECTOR(4)	/DISP:
				 1=PRESERVE
				 2=RENAME (ONLY FOR MPB SYSTEMS. ON GALAXY
					SYSTEMS EQUIVALENT TO DELETE)

				 3=DELETE
		VECTOR(5)	AFTER SWITCH PART ONE
				TIME OF DAY OR PLUS TIME IN MINUTES
				PLUS TIME IS INDICATED BY A NEGATIVE IN VECTOR(6)
		VECTOR(6)	AFTER SWITCH PART TWO
				DATE IN 15 BIT FORMAT OR ZERO FOR TODAY
				NEGATIVE INDICATES TIME IS PLUS FORMAT
		VECTOR(7)	DEADLINE SWITCH PART ONE. SAME AS AFTER
		VECTOR(8)	DEADLINE SWITCH PART TWO. SAME AS AFTER
		VECTOR(9)	/PRIORITY:(N+1)
				GIVE NUMBER IN RANGE 1 TO 63. ACTUAL
				PRIORITY IS ONE LESS. DEFAULT IS 10
		VECTOR(10)	/PAPER: ARGUMENT
			   VALUE		MEANING
					LPT      CDP      PTP      PLT
				1	ARROW(*) ASCII(*) ASCII(*) IMAGE
				2	ASCII    026      IMAGE    ASCII(*)
				3	OCTAL    BINARY   IMG BIN  BINARY
				4	SUPPRESS D029     BINARY
				5	         IMAGE

		VECTOR(11)	/HEAD:N
				 0=NO HEADER
				 1=FILE HEADER
		VECTOR(12)	/SPACING: ARGUMENT
				 1=SINGLE
				 2=DOUBLE
				 3=TRIPLE
		VECTOR(13)	/FORMS:NAME
				NAME OF SPECIAL FORMS TO USE
				(ASCII IN INTEGER FIELD?)
		VECTOR(14)	REST OF NAME

%
	XLIST
>
	LIST

	SUBTTL	DEFINITIONS AND DATA

; BITS THAT WE MUST DEFINE BECAUSE FORPRM AND UUOSYM DISAGREE
DV.DSK==1B1		;DEVICE IS A DSK
DV.TTY==1B14		;DEVICE IS A TTY

; AC DEFINITIONS
	F=0
	A=1
	S1=A
	B=2
	S2=B
	C=3
	WD=4		;SIXBIT ANSWER FROM ASCSIX
	T1=WD
	BP6=5		;SIXBIT POINTER
	T2=BP6
	BP7=6		;ASCII POINTER
	T3=BP7
	N=7		;NUMBER
	T4=N
	CH=10		;CHARACTER
	T5=CH
	M=T5
	V=11		;POINTER TO ARG VECTOR
	QD=12		;QUE TYPE
	QF=13		;POINTER TO CURRENT FILE BLOCK IN QUE BLOCK
	Q=14		;POINTER TO QUE AREA
IFE LANGSW,<	;IF FORTRA
QUENAM:	ASCII/LPT  /
	ASCII/CDP  /
	ASCII/PTP  /
	ASCII/PLT  /
>
IFN LANGSW,<	;IF COBOL OR ALGOL
QUENAM:	SIXBIT/LPT/
	SIXBIT/CDP/
	SIXBIT/PTP/
	SIXBIT/PLT/
>
QUESZ==.-QUENAM

; TABLE OF MAXIMUM LEGAL PAPER MODES BY DEVICE
MAXPAP:	%QFLSU		;LPT
	%QFCIM		;CDP
	%QFTBI		;PTP
	%QFPBI		;PLT

; TABLE OF DIVISORS FOR CALCULATING DEFAULT LIMITS
LIMDIV:	1		;LPT
	1		;CDP
	1		;PTP
	^D20		;PLT

; TABLE OF ADDITIONAL QUANTA FOR CALCULATING DEFAULT LIMITS
LIMADD:	^D20		;LPT
	^D100		;CDP
	^D20		;PTP
	^D5		;PLT

; TABLE OF DEFAULT MODES FOR CDP(LH),PTP(RH)
PUNMOD:	XWD %QFCAS,%QFTAS
	XWD %QFCAS,%QFTAS
	XWD     77,    77
	XWD     77,    77
	XWD     77,    77
	XWD     77,    77
	XWD     77,    77
	XWD     77,    77
	XWD %QFCIM,%QFTIM
	XWD     77,    77
	XWD     77,    77
	XWD %QFCIM,%QFTIB
	XWD %QFCBI,%QFTBI
	XWD     77,%QFTBI
	XWD %QFCBI,%QFTBI
	XWD %QFCBI,%QFTBI

FILDEV:	BLOCK	1		;DEVICE FILE IS ON
FILNAM:	BLOCK	2		;FILE NAME
FILEXT=FILNAM+1			;EXTENSION
	SUBTTL	QUEOUT - INITIALIZATION CODE

	HELLO	(QUEOUT)	;ENTRANCE
IFL LANGSW,<	;IF ALGOL
IFGE <MAJVNO-5>,<
QOUTPM:	Z			;POST-MORTEM BLOCK
	XWD 2,7			;WORDS, CHARACTERS+ "*"
	SIXBIT/QUEOUT*/	;SIXBIT NAME PLUS "*"
>
QUEOUT:	JSP	AX,PARAM	;ENTRY
IFGE <MAJVNO-5>,<
	QOUTPM		;POINTER TO POST-MORTEM BLOCK
>
	XWD	0,16
	XWD	$PRO!$N!$SIM,6
	XWD	$VAR!$S!$FOV,3
	XWD	$VAR!$S!$FOV,5
	XWD	$VAR!$S!$FOV,7
	XWD	$ARR!$I!$FON,11
	XWD	$VAR!$I!$FON,13
	MOVEM	14,SAVE14#	;SAVE AN AC
>
IFE LANGSW,<	;IF FORTRA
	SKIPN	A,@2(16)	;SPECIFYING OUTPUT QUEUE?
>
IFN LANGSW,<	;IF COBOL OR ALGOL
IFG LANGSW,<	;IF COBOL
	MOVE	BP7,2(16)	;QUEUE ARG
>
IFL LANGSW,<	;IF ALGOL
	MOVE	BP7,7(DL)	;QUEUE ARG
>
	PUSHJ	P,ASC6.6##	;GET WORD
	 JFCL			;IGNORE ERRORS
	SKIPN	A,WD		;ARG GIVEN?
>
	MOVE	A,QUENAM	;NO. ASSUME LPT
	MOVSI	QD,-QUESZ	;FIND IT IN TABLE
	CAME	A,QUENAM(QD)	;MATCH?
	 AOBJN	QD,.-1		;NO. TRY NEXT
	JUMPGE	QD,NOSUCH	;ANY MATCH?
	TLZ	QD,-1		;JUST KEEP INDEX
	PUSHJ	P,FIRCH$##	;GET PRIMARY CHANNEL
	 JRST	ILLDEV		;GIVE SECOND ERROR
	PUSHJ	P,GTINF$##	;GET QUE DEVICE, OTHER INFO
	PUSHJ	P,GETDEV	;GET THE DEVICE NAME
	 JRST	ILLDEV		;ILLEGAL
	PUSHJ	P,GETNAM	;GET THE FILE NAME
	 JRST	ILLNAM		;ILLEGAL
	MOVEI	A,16		;DUMP MODE
	MOVE	B,FILDEV	;DEVICE
	SETZ	C,		;NO BUFFERS
	PUSHJ	P,XUUO$##	;DO NEXT LINE WITH APPROPRIATE CHANNEL
	OPEN	0,A		;OPEN DEVICE
	 JRST	ILLDEV		;CAN'T
	SUBTTL	QUEOUT - PICK UP VECTOR ARGUMENTS
IFGE LANGSW,<	;IF FORTRA OR COBOL
	MOVEI	V,@3(16)	;SET ADDRESS OF ARG VECTOR
IFG LANGSW,<	;IF COBOL
	LDB	A,[POINT 4,3(16),12]
	CAIN	A,15		;IS IT SIXBIT/ASCII (IE LEVEL 01)?
	HRRZ	V,(V)		;YES. GET REAL ADDRESS
>
>
IFL LANGSW,<	;IF ALGOL
	HRRZ	V,11(DL)	;VECTOR ADDRESS
	ADDI	V,1		;POINT RIGHT TO IT
>
	SKIPG	A,(V)		;GET FILE:XX ARG
	MOVEI	A,.QFFAS	;DEFAULT IS ASCII
	CAILE	A,.QFF11	;LEGAL ARG?
	 JRST	ILLARG		;NO. ERROR
	CAIE	A,.QFFCR	;CREF?
	CAIN	A,.QFFRU	;RUNOFF?
	 MOVEI	A,.QFFAS	;TREAT AS ASCII
IFN FTMPB,<
	IFMPB
	DPB	A,[POINTR(Q.OMOD(Q),QF.FFM)]
>
IFN FTGALAXY,<
	IFGALX
	DPB	A,[POINTR(.FPINF(QF),FP.FFF)]
>

	SKIPG	A,2(V)		;GET /COPIES:N
	 MOVEI	A,1		;DEFAULT ONE COPY
	CAILE	A,^D63		;LEGAL NUMBER?
	 MOVEI	A,^D63		;NO. MAXIMUM
	MOVEM	A,COPIES#	;REMEMBER
IFN FTMPB,<
	IFMPB
	DPB	A,[POINTR(Q.OMOD(Q),QF.COP)]
>
IFN FTGALAXY,<
	IFGALX
	DPB	A,[POINTR(.FPINF(QF),FP.FCY)]
>

	SKIPG	A,3(V)		;GET /DISP:
	 MOVEI	A,.QFDPR	;DEFAULT IS PRESERVE
	CAILE	A,.QFDDE	;LEGAL DISPOSITION?
	 JRST	ILLARG		;NO. ERROR
IFN FTMPB,<
	IFMPB
	DPB	A,[POINTR(Q.OMOD(Q),QF.DSP)]
>
IFN FTGALAXY,<
	IFGALX	OUT1
	MOVEI	B,FP.DEL	;DELETE BIT
	CAIE	A,.QFDPR	;PRESERVE?
	IORM	B,.FPINF(QF)	;NO. DELETE
OUT1:>

	DMOVE	A,4(V)		;GET /AFTER WORDS
	PUSHJ	P,DDAFT$##	;CONVERT TO PROPER FORMAT
IFN FTMPB,<
	IFMPB
	MOVEM	C,Q.AFTR(Q)	;STORE
>
IFN FTGALAXY,<
	IFGALX
	MOVEM	C,.EQAFT(Q)	;STORE
>

	DMOVE	A,6(V)		;GET /DEADLINE WORDS
	PUSHJ	P,DDAFT$##	;CONVERT TO PROPER FORMAT
IFN FTMPB,<
	IFMPB
	MOVEM	C,Q.DEAD(Q)	;STORE
>
IFN FTGALAXY,<
	IFGALX
	MOVEM	C,.EQDED(Q)	;STORE
>

	SKIPG	A,^D8(V)	;GET /PRIORITY:N
	MOVEI	A,^D11		;DEFAULT IS 10
	CAILE	A,^D63		;LEGAL?
	MOVEI	A,^D63		;MAXIMUM
	SUBI	A,1		;REAL RANGE IS 0-62
IFN FTMPB,<
	IFMPB
	DPB	A,[POINTR(Q.PRI(Q),QP.PRI)]
>
IFN FTGALAXY,<
	IFGALX
	DPB	A,[POINTR(.EQSEQ(Q),EQ.PRI)]
>

	SKIPG	A,^D9(V)	;GET /PAPER:XXX SWITCH (PRINT,PLOT,PUNCH,TAPE)
	PUSHJ	P,DEFPAP	;GET DEFAULT PAPER MODE
	CAMLE	A,MAXPAP(QD)	;LEGAL?
	 JRST	ILLARG		;NO. ERROR
IFN FTMPB,<
	IFMPB
	DPB	A,[POINTR(Q.OMOD(Q),QF.PFM)]
>
IFN FTGALAXY,<
	IFGALX
	DPB	A,[POINTR(.FPINF(QF),FP.FPF)]
>

IFN FTMPB,<
	IFMPB	OUT2
	MOVSI	A,(QF.NFH)	;GET /HEAD:N
	SKIPLE	^D10(V)		;WANT A HEADER?
	IORM	A,Q.OMOD(Q)	;YES. SET IT
OUT2:>
IFN FTGALAXY,<
	IFGALX	OUT3
	MOVEI	A,FP.NFH	;GET /HEAD:N
	SKIPG	^D10(V)		;WANT A HEADER?
	IORM	A,.FPINF(QF)	;NO. DON'T GIVE IT TO HIM
OUT3:>

	SKIPG	A,^D11(V)	;GET /SPACE:XXX
	MOVEI	A,1		;DEFAULT IS SINGLE
	CAILE	A,3		;LEGAL?
	 JRST	ILLARG		;NO. ERROR
IFN FTMPB,<
	IFMPB
	DPB	A,[POINTR(Q.OMOD(Q),QF.SPC)]
>
IFN FTGALAXY,<
	IFGALX
	DPB	A,[POINTR(.FPINF(QF),FP.FSP)]
>

IFLE LANGSW,<	;IF FORTRA OR ALGOL
	MOVEI	BP7,^D12(V)	;GET /FORMS SWITCH
	PUSHJ	P,ASC6.6##	;WHICH IS IN ASCII
	 JFCL			;ANY TERMINATOR OK
>
IFG LANGSW,<	;IF COBOL
	MOVE	WD,^D12(V)	;GET /FORMS SWITCH
>
IFN FTMPB,<
	IFMPB
	MOVEM	WD,Q.OFRM(Q)	;STORE IT
>
IFN FTGALAXY,<
	IFGALX
	MOVEM	WD,.EQLM1(Q)	;STORE IT
>

	DMOVE	A,FILNAM	;GET FILE NAME
				;AND EXTENSION
	PUSHJ	P,DOFIL$##	;DO NECESSARY THINGS TO FILE
	 JRST	NOFILE		;FILE NOT FOUND

	MOVE	A,COPIES	;GET COPIES BACK
	IMUL	A,$RBSIZ##	;COMPUTE BLOCKS*COPIES/8
IFN FTMPB,<
	IFMPB	OUT4
	IDIVI	A,^D1024
	ADDI	A,1
	HRRM	A,Q.OSIZ(Q)	;QS.BLK
OUT4:>
IFN FTGALAXY,<
	IFGALX	OUT5
	IDIVI	A,200		;TO BLOCKS
	SKIPE	B
	ADDI	A,1
IFN FTJSYS,<
	ADDI	A,3		;CONVERT TO PAGES
	LSH	A,-2
>
	HRLM	A,.EQLM2(Q)	;STORE
OUT5:>

	SKIPG	A,1(V)		;GET /LIMIT:N
	 PUSHJ	P,DEFLIM	;GET DEFAULT LIMIT BASED ON FILE SIZE
	CAILE	A,777776	;LEGAL SIZE?
	MOVEI	A,777776	;NO. MAKE MAXIMUM
IFN FTMPB,<
	IFMPB
	HRLM	A,Q.OSIZ(Q)	;QS.LIM
>
IFN FTGALAXY,<
	IFGALX
	HRRM	A,.EQLM2(Q)	;STORE LIMIT
>

	PUSHJ	P,$DOQUE##	;GO ACTUALLY DO THE QUEING
	 JRST	ERRRET		;ERROR RETURN
	SETZ	1,		;NO ERROR
	JRST	ERRRET		;TO STORE IT
	SUBTTL	SUBROUTINE TO STORE COMPLEX DEFAULTS
DEFPAP:	JUMPE	QD,DFPAPL	;LPT.
	LDB	B,[POINT 4,$RBPRV##,12] ;GET FILE MODE
	CAIN	QD,3		;PLOTTER?
	 JRST	DFPAPP		;YES
	CAIN	QD,1		;CDP?
	 JRST	DFPAPC		;YES
DFPAPT:	HRRZ	A,PUNMOD(B)	;PTP. GET /TAPE BASED ON FILE MODE
	POPJ	P,
DFPAPP:	MOVEI	A,%QFPAS	;PLOT. ASSUME DEFAULT IS ASCII
	CAILE	B,1		;IS IT ASCII FILE?
	MOVEI	A,%QFPIM	;NO. USE OTHER MODE
	POPJ	P,
DFPAPC:	HLRZ	A,PUNMOD(B)	;CDP. GET /PUNCH BASED ON FILE MODE
	POPJ	P,
DFPAPL:	MOVEI	A,%QFLAR	;LPT. DEFAULT IS ARROW
	POPJ	P,

DEFLIM:	MOVE	A,$RBSIZ##	;GET FILE SIZE IN WORDS
	IMUL	A,COPIES	;TIMES COPIES
	IDIVI	A,^D128		;CONVERT TO BLOCKS
	SKIPE	B
	ADDI	A,1		;AND FRACTION
	IDIV	A,LIMDIV(QD)	;CALCULATE LIMIT
	ADD	A,LIMADD(QD)	;BASED ON DEVICE
	POPJ	P,		;RETURN
	SUBTTL	SUBROUTINES TO READ ASCII ARGS
GETNAM:
IFE LANGSW,<	;IF FORTRA
	MOVEI	BP7,@1(16)	;GET ADDRESS OF ARGUMENT
	PUSHJ	P,ASC6.6##	;READ THE FILE NAME
	 JRST	GETNM1		;FUNNY TERMINATOR
	ILDB	CH,BP7		;GET THE TERMINATOR
GETNM1:	JUMPE	WD,CPOPJ	;ERROR
	MOVEM	WD,FILNAM	;STORE FILE NAME
	SETZM	FILEXT
	CAIG	CH," "		;NO EXTENSION?
	 JRST	CPOPJ1		;YES. OK
	CAIE	CH,"."		;EXTENSION COMING?
	 POPJ	P,		;NO. ERROR
	MOVEI	N,3		;NOW GET EXTENSION
	PUSHJ	P,ASC6.C##	;CONTINUING ON
	 JRST	GETNM3		;TERMINATOR
GETNM2:	HLLZM	WD,FILEXT	;STORE EXTENSION
>
IFG LANGSW,<	;IF COBOL
	SETZM	FILNAM		;CLEAR FILE NAME
	SETZM	FILEXT		;AND EXTENSION
	MOVE	BP6,[POINT 6,FILNAM]
	MOVE	B,1(16)		;PREPOINTER TO ARG
	MOVE	BP7,(B)		;POINTER
	HRRZ	N,1(B)		;CHARACTERS
	CAILE	N,^D9		;MORE THAN 9?
	MOVEI	N,^D9		;YES. JUST TAKE 9
	PUSHJ	P,ASC6.C##	;DO CONVERSION
	 JRST	GETNM3		;TERMINATOR
GETNM2:>
IFL LANGSW,<	;IF ALGOL
	SETZM	FILNAM		;ZERO FILE NAME
	SETZM	FILEXT		;AND EXTENSION
	MOVE	BP7,5(DL)	;GET POINTER
IFL <MAJVNO-5>,<
	TLO	BP7,440700	;BE SURE
>
	HRRZ	N,6(DL)		;GET BYTE COUNT
	CAILE	N,6		;MAX SIX TO START
	MOVEI	N,6
	PUSHJ	P,ASC6.C##	;GET NAME
	 JRST	GETNM0		;FUNNY TERMINATOR
	JUMPE	WD,CPOPJ	;ERROR IF NONE
	MOVEM	WD,FILNAM	;STORE NAME
	HRRZ	N,6(DL)		;GET TOTAL COUNT AGAIN
	SUBI	N,6		;MINUS THE SIX WE PROCESSED
	JUMPLE	N,CPOPJ1	;DONE?
	ILDB	CH,BP7		;GET NEXT (TERMINATOR)
	JRST	GETNM1		;CONTINUE
GETNM0:	JUMPE	WD,CPOPJ	;ERROR IF NO NAME
	MOVEM	WD,FILNAM	;STORE THE NAME
	HRRZ	T1,6(DL)	;GET BYTE COUNT AGAIN
	ADD	N,T1		;ADD COUNT TO REMAINDER
	CAILE	T1,6		;MIN WITH 6
	MOVEI	T1,6
	SUB	N,T1		;MINUS ORIGINAL
GETNM1:	SUBI	N,1		;COUNT TERMINATOR
	CAIG	CH," "		;VALID END?
	 JRST	CPOPJ1		;YES. DONE
	CAIE	CH,"."		;EXTENSION COMING?
	 POPJ	P,		;NO. ERROR
	CAILE	N,3		;MAX OF THREE
	MOVEI	N,3
	JUMPLE	N,CPOPJ1	;OK IF STOPPED WITH .
	PUSHJ	P,ASC6.C##	;GET IT
	 JRST	GETNM3		;TERMINATOR OK?
GETNM2:	HLLZM	WD,FILEXT	;STORE EXTENSION
>
CPOPJ1:	AOS	(P)		;SKIP RETURN. GOOD NAME
CPOPJ:	POPJ	P,
GETNM3:	CAIG	CH," "		;VALID TERMINATOR FOR EXT?
	 JRST	GETNM2		;YES. STORE IT
	POPJ	P,		;NO. ERROR

GETDEV:
IFE LANGSW,<	;IF FORTRA
	MOVEI	BP7,@0(16)	;GET ADDRESS OF ARGUMENT
	PUSHJ	P,ASC6.5##	;FIVE CHARACTERS
	 JRST	GETDV2		;IGNORE COLON IF PRESENT
>
IFG LANGSW,<	;IF COBOL
	MOVE	BP7,0(16)	;POINTER TO ARG
	PUSHJ	P,ASC6.6##
>
IFL LANGSW,<	;IF ALGOL
	MOVE	BP7,3(DL)	;GET POINTER
	HRRZ	N,4(DL)		;BYTE COUNT
	CAILE	N,6
	MOVEI	N,6		;MIN WITH 6
	PUSHJ	P,ASC6.C##	;TRANSLATE
	 JRST	GETDV2		;TERMINATOR
>
GETDV1:	JUMPN	WD,.+2		;GIVE A DEVICE?
	MOVSI	WD,'DSK'	;NO. ASSUME DISK
	MOVEM	WD,FILDEV
	DEVCHR	WD,		;GET CHARACTERISTICS
	TLNN	WD,(DV.TTY)	;IS IT A REAL DISK?
	TLNN	WD,(DV.DSK)	;SINCE NUL: HAS DV.DSK SET TOO
	 POPJ	P,		;NO. ERROR
	JRST	CPOPJ1		;GOOD DEVICE
GETDV2:	CAIE	CH," "		;END WITH SPACE
	CAIN	CH,":"		;OR COLON?
	 JRST	GETDV1		;YES. OK
	POPJ	P,		;NO. ERROR
	SUBTTL	ERROR ROUTINES
NOSUCH:	MOVEI	1,1		;UNDEFINED QUEUE
ERRRET:	PUSHJ	P,XUUO$##	;MAKE SURE RELEASE PRIMARY CHANNEL
	RELEAS	0,

IFGE LANGSW,<
	MOVEM	1,@4(16)	;STORE ERROR CODE
>
IFL LANGSW,<
	MOVE	0,1		;MOVE IT
	XCT	14(DL)		;RETURN IT
>
	GOODBY	(5)		;RETURN

ILLDEV:	MOVEI	1,2		;ILLEGAL DEVICE
	JRST	ERRRET		;RETURN

ILLNAM:	MOVEI	1,3		;ILLEGAL FILE NAME
	JRST	ERRRET		;RETURN

NOFILE:	MOVEI	1,4		;NO SUCH FILE
	JRST	ERRRET		;RETURN

ILLARG:	MOVEI	1,5		;ILLEGAL ARGUMENT IN VECTOR
	JRST	ERRRET		;RETURN
	PRGEND
	TITLE	SUBMIT - ROUTINES TO MAKE INPUT QUEUE ENTRIES
	SUBTTL	USAGE INSTRUCTIONS

	SEARCH	MACTEN,UUOSYM,QUEUNV

IFE LANGSW,<SEARCH	FORPRM	;IF COMPILING FOR FORTRA>
IFL LANGSW,<SEARCH ALGPRM,ALGSYS	;IF COMPILING FOR ALGOL>
IFN FTGALAXY,<
	SEARCH	QSRMAC,SBSMAC
IFN FTJSYS,<
	SEARCH	MONSYS		;TOPS20 DEFINITIONS
>
>
IFN FTMPB,<
	SEARCH	QPRM
>

; FORPRM IS UNIVERSAL FILE FROM FOROTS
; ALGPRM IS UNIVERSAL FILE FOR ALGOL
; ALGSYS IS UNIVERSAL FILE FOR ALGOL
; QPRM   IS UNIVERSAL FILE FOR QUEUE DEFINITIONS. SEE ...
; MACTEN IS UNIVERSAL FILE WITH USEFUL MACRO DEFINITIONS SEE ...
; UUOSYM IS UNIVERSAL FILE WITH UUO SYMBOLS DEFINITIONS SEE ...
; QSRMAC IS UNIVERSAL FILE FOR GALAXY
; SBSMAC IS UNIVERSAL FILE FOR GALAXY
; MONSYS IS UNIVERSAL FILE FOR TOPS20
	XLIST
IFE LANGSW,<	;IF FORTRA
	LIST
COMMENT	%

USAGE		CALL SUBMIT(VECTOR)
	OR	CALL SUBMIT(VECTOR,IERR)

	WHERE		VECTOR IS AN 19 WORD SINGLE PRECISION ARRAY CONTAINING
		VECTOR(1)	NAME OF CTL FILE. MAX. OF FIVE CHARACTERS ASCII.
				EXT IS ALWAYS .CTL
		VECTOR(2)	NAME OF LOG FILE. MAX. OF FIVE CHARACTERS ASCII.
				EXT IS ALWAYS .LOG. DEFAULT IS SAME AS CTL FILE
		VECTOR(3)	DISPOSITION FOR CTL FILE.
				0=PRESERVE
				1=DELETE
		VECTOR(4)	DISPOSITION FOR LOG FILE.
				0=PRESERVE
				1=DELETE
		VECTOR(5)	TIME LIMIT IN SECONDS. DEFAULT IS 60.
		VECTOR(6)	PAGE LIMIT. DEFAULT IS 200
		VECTOR(7)	CARD LIMIT. DEFAULT IS 0
		VECTOR(8)	PAPER TAPE LIMIT. DEFAULT IS 0
		VECTOR(9)	PLOTER LIMIT. DEFAULT IS 0
		VECTOR(10)	CORE LIMIT. DEFAULT IS CORMAX
		VECTOR(11)	RESTARTABLITY.
				0=YES
				1=NO
		VECTOR(12)	UNIQUENESS.
				0=RUN ANY NUMBER OF JOBS UNDER PPN
			    OTHER=GUARANTEE UNIQUE UNDER PPN
		VECTOR(13)	PRIORITY (1-62) STANDARD IS 10
		VECTOR(14)	OUTPUT SWITCH (0,1,2,3,4)
				FOR GALAXY SYSTEM, ZERO IS /OUTPUT:NOLOG
					ALL OTHERS ARE /OUTPUT:LOG
		VECTOR(15)	DEPENDENCY SWITCH (0-177777)
		VECTOR(16)	AFTER SWITCH PART ONE
				TIME OF DAY OR PLUS TIME IN MINUTES
				PLUS TIME IS INDICATED BY A NEGATIVE IN VECTOR(17)
		VECTOR(17)	AFTER SWITCH PART TWO
				DATE IN 15 BIT FORMAT OR ZERO FOR TODAY
				NEGATIVE INDICATES TIME IS PLUS FORMAT
		VECTOR(18)	DEADLINE SWITCH PART ONE. SAME AS AFTER
		VECTOR(19)	DEADLINE SWITCH PART TWO. SAME AS AFTER

			IERR - IS AN OPTIONAL ERROR CODE RETURNED
		VALUE	MEANING
		  0	NO ERROR - JOB SUBMITTED
		  2	OPEN FAILED ON DSK
		  3	ILLEGAL FILE NAME
		  4	FILE NOT FOUND
		  6	CANNOT OPEN QUE DEVICE
		  7	CANNOT ENTER QUEUE COMMAND FILE
%
	XLIST
>
IFG LANGSW,<	;IF COBOL
	LIST
COMMENT	%

USAGE		ENTER MACRO SUBMIT USING CTLFIL,LOGFIL,VECTOR.
	OR	ENTER MACRO SUBMIT USING CTLFIL,LOGFIL,VECTOR,IERR.

	WHERE		CTLFIL	IS FILE NAME OF CTL FILE. EXT IS ALWAYS .CTL
				(DISPLAY-6 OR DISPLAY-7)
			LOGFIL	IS FILE NAME OF LOG FILE. EXT IS ALWAYS LOG.
				DEFAULT IS SAME AS CTL FILE.
				(DISPLAY-6 OR DISPLAY-7)
			VECTOR IS AN 17 WORD COMPUTATIONAL ARRAY CONTAINING
		VECTOR(1)	DISPOSITION FOR CTL FILE.
				0=PRESERVE
				1=DELETE
		VECTOR(2)	DISPOSITION FOR LOG FILE.
				0=PRESERVE
				1=DELETE
		VECTOR(3)	TIME LIMIT IN SECONDS. DEFAULT IS 60.
		VECTOR(4)	PAGE LIMIT. DEFAULT IS 200
		VECTOR(5)	CARD LIMIT. DEFAULT IS 0
		VECTOR(6)	PAPER TAPE LIMIT. DEFAULT IS 0
		VECTOR(7)	PLOTER LIMIT. DEFAULT IS 0
		VECTOR(8)	CORE LIMIT. DEFAULT IS CORMAX
		VECTOR(9)	RESTARTABLITY.
				0=YES
				1=NO
		VECTOR(10)	UNIQUENESS.
				0=RUN ANY NUMBER OF JOBS UNDER PPN
			    OTHER=GUARANTEE UNIQUE UNDER PPN
		VECTOR(11)	PRIORITY (1-63) STANDARD IS 10
		VECTOR(12)	OUTPUT SWITCH (0,1,2,3,4)
		VECTOR(13)	DEPENDENCY SWITCH (0-777777)
		VECTOR(14)	AFTER SWITCH PART ONE
				TIME OF DAY OR PLUS TIME IN MINUTES
				PLUS TIME IS INDICATED BY A NEGATIVE IN VECTOR(15)
		VECTOR(15)	AFTER SWITCH PART TWO
				DATE IN 15 BIT FORMAT OR ZERO FOR TODAY
				NEGATIVE INDICATES TIME IS PLUS FORMAT
		VECTOR(16)	DEADLINE SWITCH PART ONE. SAME AS AFTER
		VECTOR(17)	DEADLINE SWITCH PART TWO. SAME AS AFTER

			IERR - IS AN OPTIONAL ERROR CODE RETURNED (COMPUTATIONAL)
		VALUE	MEANING
		  0	NO ERROR - JOB SUBMITTED
		  2	OPEN FAILED ON DSK
		  3	ILLEGAL FILE NAME
		  4	FILE NOT FOUND
		  6	CANNOT OPEN QUE DEVICE
		  7	CANNOT ENTER QUEUE COMMAND FILE
%
	XLIST
>
IFL LANGSW,<	;IF ALGOL
	LIST
COMMENT	%

USAGE		 SUBMIT(CTLFIL,LOGFIL,VECTOR);
	OR	 SUBMIT(CTLFIL,LOGFIL,VECTOR,IERR);

	WHERE		CTLFIL	IS FILE NAME OF CTL FILE. EXT IS ALWAYS .CTL
				STRING VARIABLE (ASCII).
			LOGFIL	IS FILE NAME OF LOG FILE. EXT IS ALWAYS LOG.
				DEFAULT IS SAME AS CTL FILE.
				STRING VARIABLE (ASCII).
			VECTOR IS AN 17 WORD INTEGER ARRAY CONTAINING
		VECTOR(1)	DISPOSITION FOR CTL FILE.
				0=PRESERVE
				1=DELETE
		VECTOR(2)	DISPOSITION FOR LOG FILE.
				0=PRESERVE
				1=DELETE
		VECTOR(3)	TIME LIMIT IN SECONDS. DEFAULT IS 60.
		VECTOR(4)	PAGE LIMIT. DEFAULT IS 200
		VECTOR(5)	CARD LIMIT. DEFAULT IS 0
		VECTOR(6)	PAPER TAPE LIMIT. DEFAULT IS 0
		VECTOR(7)	PLOTER LIMIT. DEFAULT IS 0
		VECTOR(8)	CORE LIMIT. DEFAULT IS CORMAX
		VECTOR(9)	RESTARTABLITY.
				0=YES
				1=NO
		VECTOR(10)	UNIQUENESS.
				0=RUN ANY NUMBER OF JOBS UNDER PPN
			    OTHER=GUARANTEE UNIQUE UNDER PPN
		VECTOR(11)	PRIORITY (1-63) STANDARD IS 10
		VECTOR(12)	OUTPUT SWITCH (0,1,2,3,4)
		VECTOR(13)	DEPENDENCY SWITCH (0-777777)
		VECTOR(14)	AFTER SWITCH PART ONE
				TIME OF DAY OR PLUS TIME IN MINUTES
				PLUS TIME IS INDICATED BY A NEGATIVE IN VECTOR(15)
		VECTOR(15)	AFTER SWITCH PART TWO
				DATE IN 15 BIT FORMAT OR ZERO FOR TODAY
				NEGATIVE INDICATES TIME IS PLUS FORMAT
		VECTOR(16)	DEADLINE SWITCH PART ONE. SAME AS AFTER
		VECTOR(17)	DEADLINE SWITCH PART TWO. SAME AS AFTER

			IERR - IS AN OPTIONAL ERROR CODE RETURNED (INTEGER)
		VALUE	MEANING
		  0	NO ERROR - JOB SUBMITTED
		  2	OPEN FAILED ON DSK
		  3	ILLEGAL FILE NAME
		  4	FILE NOT FOUND
		  6	CANNOT OPEN QUE DEVICE
		  7	CANNOT ENTER QUEUE COMMAND FILE
%
	XLIST
>
	LIST
	SUBTTL	DEFINITIONS AND DATA

; BITS THAT WE MUST DEFINE BECAUSE FORPRM AND UUOSYM DISAGREE
DV.DSK==1B1		;DEVICE IS A DSK
DV.TTY==1B14		;DEVICE IS A TTY

; AC DEFINITIONS
	F=0
	A=1
	S1=A
	B=2
	S2=B
	C=3
	WD=4		;SIXBIT ANSWER FROM ASCSIX
	T1=WD
	BP6=5		;SIXBIT POINTER
	T2=BP6
	BP7=6		;ASCII POINTER
	T3=BP7
	N=7		;NUMBER
	T4=N
	CH=10		;CHARACTER
	T5=CH
	M=T5
	V=11		;POINTER TO ARG VECTOR
	QD=12		;QUE TYPE
	QF=13		;POINTER TO CURRENT FILE BLOCK IN QUE BLOCK
	Q=14		;POINTER TO QUE AREA
	SUBTTL	SUBMIT - INITIALIZATION CODE
	HELLO	(SUBMIT)
IFL LANGSW,<	;IF ALGOL
IFGE <MAJVNO-5>,<
SUBMPM:	Z			;POST-MORTEM BLOCK
	XWD	2,7		;WORDS, CHARACTER+ "*"
	SIXBIT/SUBMIT*/		;SIXBIT NAME PLUS "*"
>
	XWD	DL,13		;WORD FOR VARIABLE LENGTH
SUBMIT:	JSP	AX,PAR0		;VARIABLE LENGTH CALL
IFGE <MAJVNO-5>,<
	SUBMPM			;POINTER TO POST MORTEM BLOCK
>
	XWD	0,14
	XWD	$PRO!$N!$SIM,5
	XWD	$VAR!$S!$FOV,3
	XWD	$VAR!$S!$FOV,5
	XWD	$ARR!$I!$FON,7
	XWD	$VAR!$I!$FON,11
	MOVEM	14,SAVE14#	;SAVE AN AC
>
	PUSHJ	P,FIRCH$##	;GET PRIMARY CHANNEL
	 JRST	NODSK		;GIVE SECOND ERROR MESSAGE
	MOVEI	QD,4		;INP QUEUE
	PUSHJ	P,GTINF$##	;GET QUE DEVICE, OTHER INFO
IFE LANGSW,<	;IF FORTRA
	MOVEI	V,@0(16)	;GET ADDRESS OF ARGUMENT VECTOR
>
IFG LANGSW,<	;IF COBOL
	MOVEI	V,@2(16)	;GET POSSIBLE VECTOR ADDRESS
	LDB	A,[POINT 4,2(16),12];GET ARG TYPE
	CAIN	A,15		;IS IT SIXBIT/ASCII (IE LEVEL 01)?
	HRRZ	V,(V)		;YES. GET REAL ADDRESS
	SUBI	V,2		;NOW MAKE IT LOOK LIKE THE FORTRAN CALL
>
IFL LANGSW,<	;IF ALGOL
	MOVE	V,7(DL)		;GET VECTOR ADDRESS
	SUBI	V,1		;MINUS TWO PLUS ONE FOR OFFSET
>
IFN FTMPB,<
	IFMPB	SUB1
	MOVEI	A,111301	;SET DEFAULT BITS ON CTL,LOG FILE MODES
	MOVEM	A,Q.CMOD(Q)
	TLO	A,(QF.LOG)	;SET LOG BIT TOO
	MOVEM	A,Q.LMOD(Q)
SUB1:>
IFN FTGALAXY,<
	IFGALX	SUB2
	MOVE	A,[XWD 010101,FP.NFH+1] ;SET DEFAULT BITS ON CTL, LOG FILE MODES
	MOVEM	A,.FPINF(QF)	;CTL FILE
	TRO	A,FP.FLG	;LOG BT
	MOVEM	A,LOGFB$##+.FPINF ;LOG FILE
SUB2:>
IFE LANGSW,<	;IF FORTRA
	MOVEI	BP7,(V)		;GET ADDRESS OF CTL NAME
>
IFG LANGSW,<	;IF COBOL
	MOVE	BP7,0(16)	;GET FIRST ARGUMENT
>
IFL LANGSW,<	;IF ALGOL
	MOVE	BP7,3(DL)	;GET STRING POINTER
>
	PUSHJ	P,ASC6.5##	;FIVE CHARACTERS
	 JFCL			;IGNORE TERMINATOR
	JUMPE	WD,ERRNAM	;ZERO NAME ILLEGAL
	MOVE	A,WD
	MOVSI	B,'CTL'
IFN FTMPB,<
	IFMPB
	MOVEI	QF,Q.CSTR(Q)	;ADDRESS OF CTL FILE BLOCK
>
IFN FTGALAXY,<
	IFGALX
	MOVEI	QF,CTLFB$##	;ADDRESS OF CTL FILE BLOCK
>
	PUSHJ	P,OPDSK$##	;OPEN UP THE DISK
	 JRST	NODSK		;OOPS
	TLO	F,CTLFIL	;CTL FILE
	PUSHJ	P,DOFIL$##	;DO THE FILE THINGS
	 JRST	NTFND		;OOPS
	TLZ	F,CTLFIL	;NOT CTL FILE NOW
IFE LANGSW,<	;IF FORTRA
	MOVEI	BP7,1(V)	;GET ADDRESS OF LOG FILE NAME
>
IFG LANGSW,<	;IF COBOL
	MOVE	BP7,1(16)	;GET SECOND ARGUMENT
>
IFL LANGSW,<
	MOVE	BP7,5(DL)	;GET STRING POINTER
>
	PUSHJ	P,ASC6.5##	;FIVE CHARACTERS
	 JFCL
IFN FTMPB,<
	IFMPB	SUB18
	SKIPN	A,WD		;NOW DO THIS FILE
	MOVE	A,Q.LNAM(Q)	;DEFAULT IS CTL NAME
SUB18:>
IFN FTGALAXY,<
	IFGALX	SUB19
	SKIPN	A,WD		;NOW DO THIS FILE
	MOVE	A,.EQJOB(Q)	;DEFAULT IS CTL NAME
SUB19:>
	MOVSI	B,'LOG'		;SET EXTENSION
	PUSHJ	P,OPDSK$##	;OPEN UP THE DISK
	 JRST	NODSK		;OOPS
	TLO	F,LOGFIL	;LOG NOW
IFN FTMPB,<
	IFMPB
	MOVEI	QF,Q.LSTR(Q)	;ADDRESS OF LOG FILE BLOCK
>
IFN FTGALAXY,<
	IFGALX
	MOVEI	QF,LOGFB$##	;ADDRESS OF CTL FILE BLOCK
>
	PUSHJ	P,DOFIL$##	;DO THE FILE THINGS
	 JRST	NTFND		;ERROR IF LOG DOESN'T EXIST AND CAN'T MAKE ONE
	TLZ	F,LOGFIL	;NOT LOG FILE NOW
IFN FTMPB,<
	IFMPB	SUB3
	MOVE	A,Q.PPN(Q)	;ASSUME NO SFDS
	MOVEM	Q.IDDI(Q)	;IN DEFAULT PATH
SUB3:>
IFN FTGALAXY,<
	IFGALX	SUB4
IFN FTUUOS,<
	MOVE	A,.EQOWN(Q)	;ASSUME NO SFDS
	MOVEM	A,.EQPAT(Q)	;IN DEFAULT PATH
>
SUB4:>
	HRLO	A,THSJB$##	;GET OUR DEFAULT PATH
	MOVEM	A,PTHBL$##
	MOVE	A,[XWD ^D8,PTHBL$##]
	PATH.	A,
	 JRST	SUBARG		;JUST PPN
	MOVSI	A,PTHBL$##+2	;MOVE IT
IFN FTMPB,<
	IFMPB	SUB5
	HRRI	A,Q.IDDI(Q)
	BLT	A,Q.IDDI+5(Q)
SUB5:>
IFN FTGALAXY,<
	IFGALX	SUB6
IFN FTUUOS,<
	HRRI	A,.EQPAT(Q)
	BLT	A,.EQPAT+5(Q)
>
SUB6:>
	SUBTTL	SUBMIT - PICK UP VECTOR ARGUMENTS
SUBARG:	SKIPL	A,2(V)		;/DISPOSE .CTL
	CAILE	A,1		;LEGAL?
	MOVEI	A,1		;DEFAULT IS DELETE
IFN FTMPB,<
	IFMPB	SUB7
	MOVEI	B,.QFDDE
	SKIPN	A		;DELETE?
	MOVEI	B,.QFDPR	;PRESERVE
	DPB	B,[POINTR(Q.CMOD(Q),QF.DSP)]
SUB7:>
IFN FTGALAXY,<
	IFGALX	SUB8
	MOVEI	B,FP.DEL	;DELETE BIT
	SKIPE	A		;PRESERVE?
	IORM	B,.FPINF(QF)	;NO. SET DELETE
SUB8:>

	SKIPL	A,3(V)		;/DISPOSE .LOG
	CAILE	A,1		;LEGAL?
	MOVEI	A,1		;NO
IFN FTMPB,<
	IFMPB	SUB9
	MOVEI	B,.QFDDE
	SKIPN	A		;DELETE?
	MOVEI	B,.QFDPR	;PRESERVE
	DPB	B,[POINTR(Q.LMOD(Q),QF.DSP)]
SUB9:>
IFN FTGALAXY,<
	IFGALX	SUB10
	MOVEI	B,FP.DEL	;DELETE BIT
	SKIPE	A		;PRESERVE
	IORM	B,LOGFB$##+.FPINF ;NO. SET DELETE
SUB10:>

	SKIPG	A,4(V)		;GET /TIME
	MOVEI	A,^D60		;DEFAULT IS 60 SECONDS
	TLNE	A,-1		;TOO LONG?
	MOVEI	A,777777	;YES
IFN FTMPB,<
	IFMPB
	HRRM	A,Q.ILIM(Q)
>
IFN FTGALAXY,<
	IFGALX
	HRRM	A,.EQLM2(Q)
>

	SKIPG	A,5(V)		;GET /PAGES
	MOVEI	A,^D200		;DEFAULT IS 200 PAGES
	TLNE	A,-1		;TOO LARGE
	MOVEI	A,777777	;YES
IFN FTMPB,<
	IFMPB
	HRLM	A,Q.ILM2(Q)
>
IFN FTGALAXY,<
	IFGALX
	HRLM	A,.EQLM3(Q)
>

	SKIPG	A,6(V)		;GET /CARDS
	MOVEI	A,0		;USE DEFAULT LIMITS
	TLNE	A,-1		;TOO LARGE?
	MOVEI	A,777777	;YES
IFN FTMPB,<
	IFMPB
	HRRM	A,Q.ILM2(Q)
>
IFN FTGALAXY,<
	IFGALX
	HRRM	A,.EQLM3(Q)
>

	SKIPG	A,7(V)		;GET /FEET (PAPER TAPE)
	MOVEI	A,0		;USE DEFAULT LIMITS
	TLNE	A,-1		;TOO LARGE?
	MOVEI	A,777777	;YES
IFN FTMPB,<
	IFMPB
	HRLM	A,Q.ILM3(Q)
>
IFN FTGALAXY,<
	IFGALX
	HRLM	A,.EQLM4(Q)
>

	SKIPG	A,^D8(V)	;GET /TPLOT (PLOT TIME)
	MOVEI	A,0		;USE DEFAULT LIMITS
	TLNE	A,-1		;TOO LARGE?
	MOVEI	A,777777	;YES
IFN FTMPB,<
	IFMPB
	HRRM	A,Q.ILM3(Q)
>
IFN FTGALAXY,<
	IFGALX
	HRRM	A,.EQLM4(Q)
>

	SKIPG	A,^D9(V)	;GET /CORE
	 PUSHJ	P,DEFCOR	;GET DEFAULT LIMIT
	CAIGE	A,^D512		;AT LEAST ONE PAGE?
	LSH	A,^D10		;NO. MUST MEAN K
	TLNE	A,-1		;TOO BIG?
	MOVEI	A,777777	;YES
IFN FTMPB,<
	IFMPB
	HRLM	A,Q.ILIM(Q)
>
IFN FTGALAXY,<
	IFGALX	SUB11
	ADDI	A,1		;CONVERT WORDS TO PAGES
	LSH	A,-^D9		;ROUNDING
	HRLM	A,.EQLM2(Q)	;STORE
SUB11:>

IFN FTMPB,<
	IFMPB	SUB12
	SKIPE	A,^D10(V)	;RESTARTABLE?
	MOVSI	A,(QI.NRS)	;NO. SAY SO
	IORM	A,Q.IDEP(Q)
SUB12:>
IFN FTGALAXY,<
	IFGALX	SUB13
	SKIPE	A,^D10(V)	;RESTARTABLE?
	MOVSI	A,(EQ.NRS)	;NO. SAY SO
	IORM	A,.EQLM1(Q)
SUB13:>

IFN FTMPB,<
	IFMPB	SUB14
	SKIPE	A,^D11(V)	;UNIQUENESS
	MOVEI	A,.QIUSD	;NO. USE DEFAULT
	DPB	A,[POINTR(Q.IDEP(Q),QI.UNI)]
SUB14:>
IFN FTGALAXY,<
	IFGALX	SUB15
	SKIPE	A,^D11(V)	;UNIQUENESS
	MOVEI	A,1		;NO. USE DEFAULT
	DPB	A,[POINTR(.EQLM1(Q),EQ.UNI)]
SUB15:>

	SKIPLE	A,^D12(V)	;/PRIORITY
	CAILE	A,^D62		;LEGAL?
	MOVEI	A,^D10		;NO. USE DEFAULT
IFN FTMPB,<
	IFMPB
	DPB	A,[POINTR(Q.PRI(Q),QP.PRI)]
>
IFN FTGALAXY,<
	IFGALX
	DPB	A,[POINTR(.EQSEQ(Q),EQ.PRI)]
>

IFN FTMPB,<
	IFMPB	SUB16
	SKIPL	A,^D13(V)	;/OUTPUT
	CAILE	A,.QIOAL
	MOVEI	A,.QIOAL	;INVALID. USE DEFAULT
	DPB	A,[POINTR(Q.IDEP(Q),QI.OUT)]
SUB16:>
IFN FTGALAXY,<
	IFGALX	SUB17
	SKIPL	A,^D13(V)	;/OUTPUT
	CAILE	A,4		;LEGAL?
	MOVEI	A,4		;NO. DEFAULT
	MOVEI	B,%EQOLG	;CONVERT TO QUASAR
	SKIPN	A
	MOVEI	B,%EQONL	;NO LOG ONLY IF /OUTPUT:0
	DPB	B,[POINTR(.EQLM1(Q),EQ.OUT)]
SUB17:>

	SKIPG	A,^D14(V)	;DEPENDENCY
	MOVEI	A,0		;DEFAULT IS ZERO
	CAILE	A,177777	;LEGAL?
	MOVEI	A,177777	;USE MAX IF ILLEGAL
IFN FTMPB,<
	IFMPB
	DPB	A,[POINTR(Q.IDEP(Q),QI.DEP)]
>
IFN FTGALAXY,<
	IFGALX
	HRRM	A,.EQLM1(Q)	;DEPENDENCY
>

	DMOVE	A,^D15(V)	;GET TWO WORDS OF /AFTER
	PUSHJ	P,DDAFT$##	;CONVERT TO INTERNAL FORMAT
IFN FTMPB,<
	IFMPB
	MOVEM	C,Q.AFTR(Q)	;STORE AFTER TIME
>
IFN FTGALAXY,<
	IFGALX
	MOVEM	C,.EQAFT(Q)	;STORE AFTER TIME
>

	DMOVE	A,^D17(V)	;GET TWO WORDS OF /DEAD
	PUSHJ	P,DDAFT$##	;CONVERT TO INTERNAL FORMAT
IFN FTMPB,<
	IFMPB
	MOVEM	C,Q.DEAD(Q)	;STORE DEADLINE TIME
>
IFN FTGALAXY,<
	IFGALX
	MOVEM	C,.EQDED(Q)	;STORE DEADLINE TIME
>

	PUSHJ	P,$DOQUE##	;GO ACTUALLY DO THE QUEING
	 JRST	ERRXIT		;ERROR RETURN
	SETZ	1,		;NO ERROR
	JRST	RETCOD
	SUBTTL	SUBROUTINE TO STORE COMPLEX DEFAULTS
DEFCOR:	MOVE	A,[%NSCMX]	;GET CORMAX
	GETTAB	A,
	 MOVEI	A,^D26*^D1024	;DEFAULT IS 26 K
	SETO	B,		;LESS ONE PAGE IF KI OR KL
	AOBJN	B,.+1
	SKIPN	B		;KA?
	 SUBI	A,^D512		;KI OR KL
	POPJ	P,
	SUBTTL	ERROR ROUTINES
NTFND:	OUTSTR	[ASCIZ/
% FILE NOT FOUND IN SUBMIT!
/]
	MOVEI	1,4		;FILE NOT FOUND ERROR CODE
RETCOD:
ERRXIT:	PUSHJ	P,XUUO$##	;EXECUTE RELEASE WITH CHANNEL
	RELEAS	0,
IFGE LANGSW,<	;IF FORTRA OR COBOL
IFN F40LIB,<
	TLNN	16,-1		;F40 CALL?
	 JRST	CHKF10		;NO. F10
	HLRZ	0,1(16)		;GET NEXT INSTRUCTION
	TRZ	0,740		;CLEAR AC FIELD
	CAIE	0,(JUMP 0)	;ARG?
	 GOODBY	1		;NO. DONE
	JRST	STOCOD
>
CHKF10:	HLRE	0,-1(16)	;GET ARG COUNT
	MOVM	0,0		;PLUS
IFE LANGSW,<	;IF FORTRA
	CAIGE	0,2		;TWO ARGS?
>
IFG LANGSW,<	;IF COBOL
	CAIGE	0,4		;FOUR ARGS?
>
	 GOODBY	1		;NO
>
STOCOD:
IFE LANGSW,<	;IF FORTRA
	MOVEM	1,@1(16)	;STORE ERROR CODE
>
IFG LANGSW,<	;IF COBOL
	MOVEM	1,@3(16)	;STORE ERROR CODE
>
IFL LANGSW,<	;IF ALGOL
	MOVE	0,1		;COPY ERROR CODE
	MOVE	1,13(DL)	;GET ARG COUNT
	CAILE	1,4		;ERROR ARG GIVEN?
	XCT	12(DL)		;YES. RETURN ERROR CODE
>
	GOODBY	400001

NODSK:	OUTSTR	[ASCIZ/
% CANNOT OPEN DISK!
/]
	MOVEI	1,2		;BAD DEVICE ERROR
	JRST	ERRXIT

ERRNAM:	OUTSTR	[ASCIZ/% FILE NAME ILLEGAL. JOB NOT SUBMITTED.
/]
	MOVEI	1,3		;ILLEGAL FILE NAME
	JRST	RETCOD		;RETURN CODE
	PRGEND
	TITLE	MISC. - DO /DEADLINE , /AFTER , CONVERT ASCII TO SIXBIT
	SUBTTL	DEFINITIONS AND DATA

	SEARCH	QUEUNV

IFE LANGSW,<SEARCH	FORPRM	;IF COMPILING FOR FORTRA>
IFL LANGSW,<SEARCH ALGPRM,ALGSYS	;IF COMPILING FOR ALGOL>
IFN FTGALAXY,<	SEARCH	QSRMAC,SBSMAC
IFN FTJSYS,<	SEARCH	MONSYS>
>

	ENTRY	DDAFT$

; FORPRM IS UNIVERSAL FILE FROM FOROTS
; ALGPRM IS UNIVERSAL FILE FOR ALGOL
; ALGSYS IS UNIVERSAL FILE FOR ALGOL

; AC DEFINITIONS
	F=0
	A=1
	S1=A
	B=2
	S2=B
	C=3
	WD=4		;SIXBIT ANSWER FROM ASCSIX
	T1=WD
	BP6=5		;SIXBIT POINTER
	T2=BP6
	BP7=6		;ASCII POINTER
	T3=BP7
	N=7		;NUMBER
	T4=N
	CH=10		;CHARACTER
	T5=CH
	M=T5
	V=11		;POINTER TO ARG VECTOR
	QD=12		;QUE TYPE
	QF=13		;POINTER TO CURRENT FILE BLOCK IN QUE BLOCK
	Q=14		;POINTER TO QUE AREA
	SUBTTL	SUBROUTINES TO DO /DEADLINE AND /AFTER

DDAFT$::SETZ	C,		;ASSUME NO TIME
	JUMPL	A,CPOPJ		;NEGATIVE TIME IS ILLEGAL
	DATE	T1,		;GET DATE
	MSTIME	T2,		;AND TIME
	IDIVI	T2,^D1000*^D60	;IN MINUTES
	JUMPL	B,PLSTIM	;NEGATIVE DATE IS FLAG FOR PLUS TIME
	JUMPN	B,DEDAF1	;ANY DATE GIVEN?
	JUMPE	A,CPOPJ		;NO. ANY ARG AT ALL?
	MOVE	B,T1		;NO DATE. USE TODAY
DEDAF1:	PUSHJ	P,CNVDAT	;CONVERT DATE TO INTERNAL FORMAT
	HRLZ	C,T3		;AND STORE IN C
	MOVE	T3,A		;GET TIME
	MUL	T3,[1000000]	;* 2^18
	DIVI	T3,^D24*^D60	;/MINUTES PER DAY
	ADD	C,T3		;ALLOW TO OVERFLOW INTO DAYS
IFN FTGALAXY,<
IFN FTJSYS,<
	MOVE	S2,C		;DO TOPS20 CONVERSIONS
	MOVX	T2,IC%DSA+IC%UTZ	;LOAD FORMAT FLAGS
	ODCNV			;BREAK UP THE DATE
	TLZ	T2,-1		;CLEAR THE FLAGS
	IDCNV			;RE-COMBINE
	  JFCL			;IGNORE HTE ERROR
	MOVE	C,S2		;PUT ANSWER IN PLACE
>>
CPOPJ:	POPJ	P,

PLSTIM:	MOVE	B,T1		;TODAYS DATE
	ADD	A,T2		;TIME PLUS CURRENT TIME
	JRST	DEDAF1		;AND PROCESS THAT
RADIX	10
	DATOFS==38395
CNVDAT:	PUSH	P,T1
	PUSH	P,T2
	MOVE	T2,B		;GET DATE
	IDIVI	T2,12*31	;T2=YEARS-1964
	IDIVI	T3,31		;T3=MONTHS-JAN, T4=DAYS-1
	ADD	T4,DAYTAB(T3)	;T4=DAYS-JAN 1
	MOVEI	T5,0		;LEAP YEAR ADDITIVE IF JAN,FEB
	CAIL	T3,2		;CHECK MONTH
	MOVEI	T5,1		;ADDITIVE IF MAR-DEC
	MOVE	T1,T2		;SAVE YEARS FOR REUSE
	ADDI	T2,3		;MAKE LEAP YEARS COME OUT RIGHT
	IDIVI	T2,4		;HANDLE REGULAR LEAP YEARS
	CAIE	T3,3		;SEE IF THIS IS LEAP YEAR
	MOVEI	T5,0		;NO--WIPE OUT ADDITIVE
	ADDI	T4,DATOFS(T2)
	MOVE	T2,T1		;RESTORE YEARS SINCE 1964
	IMULI	T2,365		;DAYS SINCE 1964
	ADD	T4,T2		;T4 = DAYS EXCEPT FOR 100 YR. FUDGE
	HRREI	T2,64-99(T1)	;T2=YEARS SINCE 2000
	JUMPLE	T2,CNVDT1	;ALL DONE IF NOT YET 2000
	IDIVI	T2,100		;GET CENTURIES SINCE 2000
	SUB	T4,T2		;ALLOW FOR LOST LEAP YEARS
	CAIE	T3,99		;SEE IF THIS IS A LOST L.Y.
CNVDT1:	ADD	T4,T5		;ALLOW FOR LEAP YEAR THIS YEAR
	MOVE	T3,T4		;RETURN IN T3
	POP	P,T2		;RESTORE T2
	POP	P,T1		;T1
	POPJ	P,

DAYTAB:	EXP	0,31,59,90,120,151,181,212,243,273,304,334

RADIX	8
	SUBTTL	SUBROUTINES TO READ ASCII ARGS
IFLE LANGSW,<	;IF FORTRA OR ALGOL
	ENTRY	ASC6.5,ASC6.6,ASC6.C
ASC6.5::SKIPA	N,[5]		;GET FIVE CHARACTERS
ASC6.6::MOVEI	N,6		;GET SIX CHARACTERS
	HRLI	BP7,440700	;SET UP ASCII BYTE POINTER
ASC6.C::SETZ	WD,		;START WITH A BLANK
	MOVE	BP6,[POINT 6,WD]
ASCSIX:	ILDB	CH,BP7		;GET A CHARACTER
	CAIG	CH," "		;BREAK?
	MOVEI	CH," "		;MAKE IT A SPACE
	CAIL	CH,140		;LOWER CASE?
	CAILE	CH,172		;...
	 CAIA			;NO
	SUBI	CH,40		;YES. MAKE UPPER
	CAIL	CH,"0"		;ALPHANUMERIC?
	CAILE	CH,"Z"		;...
	 POPJ	P,		;NO.
	CAILE	CH,"9"		;...
	CAIL	CH,"A"		;...
	 TRCA	CH,40		;YES. CONVERT TO SIXBIT
	  POPJ	P,		;NO. ERROR
	TLNE	BP6,770000	;IF THERE IS ROOM,
	IDPB	CH,BP6		;STORE IT
	SOJG	N,ASCSIX	;LOOP FOR N CHARACTERS
	AOS	(P)		;GIVE GOOD RETURN
	POPJ	P,
>
IFG LANGSW,<	;IF COBOL
	ENTRY	ASC6.5,ASC6.6,ASC6.C
ASC6.C::PUSH	P,B
	PUSH	P,C
	LDB	C,[POINT 6,BP7,11] ;DISPLAY TYPE
	JRST	ASCSIX

ASC6.5::
ASC6.6::PUSH	P,B		;SAVE SOME SPACE
	PUSH	P,C
	MOVE	B,BP7		;COPY ARG POINTER
	MOVE	BP7,0(B)	;GET POINTER
	HRRZ	N,1(B)		;GET CHAR COUNT
	CAILE	N,^D6		;SIX MAXIMUM
	MOVEI	N,^D6
	LDB	C,[POINT 6,BP7,11] ;DISPLAY TYPE
	SETZ	WD,		;START CLEAR
	MOVE	BP6,[POINT 6,WD]
ASCSIX:	ILDB	CH,BP7		;GET A CHARACTER
	CAIN	C,6		;SIXBIT?
	ADDI	CH,40		;YES. MAKE ASCII
	CAIN	CH," "		;IMBEDDED SPACE?
	JRST	ASCSX1		;YES. OK
	CAIG	CH," "		;BREAK?
	MOVEI	CH," "		;MAKE IT A SPACE
	CAIL	CH,140		;LOWER CASE?
	CAILE	CH,172		;...
	 CAIA			;NO
	SUBI	CH,40		;YES. MAKE UPPER
	CAIL	CH,"0"		;ALPHANUMERIC?
	CAILE	CH,"Z"		;...
	 JRST	ACPOPJ		;NO.
	CAILE	CH,"9"		;...
	CAIL	CH,"A"		;...
ASCSX1:	 TRCA	CH,40		;YES. CONVERT TO SIXBIT
	  JRST	ACPOPJ		;NO. ERROR
	IDPB	CH,BP6		;STORE IT
	SOJG	N,ASCSIX	;LOOP FOR N CHARACTERS
	AOS	-2(P)		;GIVE GOOD RETURN
ACPOPJ:	POP	P,C		;RESTORE ACS
	POP	P,B
	POPJ	P,
>

	PRGEND
	TITLE	QUEUES - ROUTINES TO MAKE INPUT/OUTPUT QUEUE ENTRIES
	SUBTTL	DEFINITIONS AND DATA

	SEARCH	MACTEN,UUOSYM,QUEUNV

IFE LANGSW,<SEARCH	FORPRM	;IF COMPILING FOR FORTRA>
IFL LANGSW,<SEARCH ALGPRM,ALGSYS	;IF COMPILING FOR ALGOL>
IFN FTGALAXY,<
	SEARCH	QSRMAC,SBSMAC
IFN FTJSYS,<
	SEARCH	MONSYS		;TOPS20 DEFINITIONS
>
>
IFN FTMPB,<
	SEARCH	QPRM
>

; FORPRM IS UNIVERSAL FILE FROM FOROTS
; ALGPRM IS UNIVERSAL FILE FOR ALGOL
; ALGSYS IS UNIVERSAL FILE FOR ALGOL
; QPRM   IS UNIVERSAL FILE FOR QUEUE DEFINITIONS. SEE ...
; MACTEN IS UNIVERSAL FILE WITH USEFUL MACRO DEFINITIONS SEE ...
; UUOSYM IS UNIVERSAL FILE WITH UUO SYMBOLS DEFINITIONS SEE ...
; QSRMAC IS UNIVERSAL FILE FOR GALAXY
; SBSMAC IS UNIVERSAL FILE FOR GALAXY
; MONSYS IS UNIVERSAL FILE FOR TOPS20

	ENTRY	DOFIL$,GTINF$,OPDSK$,$DOQUE

; BITS THAT WE MUST DEFINE BECAUSE FORPRM AND UUOSYM DISAGREE
DV.DSK==1B1		;DEVICE IS A DSK
DV.TTY==1B14		;DEVICE IS A TTY

; AC DEFINITIONS
	F=0
	A=1
	S1=A
	B=2
	S2=B
	C=3
	WD=4		;SIXBIT ANSWER FROM ASCSIX
	T1=WD
	BP6=5		;SIXBIT POINTER
	T2=BP6
	BP7=6		;ASCII POINTER
	T3=BP7
	N=7		;NUMBER
	T4=N
	CH=10		;CHARACTER
	T5=CH
	M=T5
	V=11		;POINTER TO ARG VECTOR
	QD=12		;QUE TYPE
	QF=13		;POINTER TO CURRENT FILE BLOCK IN QUE BLOCK
	Q=14		;POINTER TO QUE AREA
DEFINE	FAIL(MSG)<
	JRST	[MOVEI	T1,[ASCIZ\MSG\]
		JRST	FAIL.]
>  ;END OF DEFINE FAIL
;	MACRO SAME AS FAIL BUT NOT SKIPABLE

DEFINE	FAIL1(MSG)<
	MOVEI	T1,[ASCIZ\MSG\]
	XLIST
	JRST	FAIL.
	LIST
	SALL
>  ;END OF DEFINE FAIL1
QUESIX:	SIXBIT/LPT/
	SIXBIT/CDP/
	SIXBIT/PTP/
	SIXBIT/PLT/
	SIXBIT/INP/

IFN FTGALAXY,<
FBSIZE==FPXSIZ+FDXSIZ		;THE LARGEST FD/FP WE CAN BUILD
FBAREA==FBSIZE		;THE LARGEST FILE BLOCK/MESSAGE NEEDED
>

IFN FTMPB,<
SPLNAM:	SIXBIT/LPTSPL/
	SIXBIT/CDPSPL/
	SIXBIT/PTPSPL/
	SIXBIT/PLTSPL/
	SIXBIT/BATCON/

Q.LGTO==Q.OMOD		;LENGTH OF OUTPUT QUE
Q.LGTI==Q.LMOD		;LENGTH OF INPUT QUE
Q.LGTH==Q.LMOD		;LENGTH OF MAXIMUM QUE RECORD
>

IFN FTBOTH,<
QLEN==Q.LGTH+1			;ASSUME GMANGR BIGGER
IFL <QLEN-<.EQPSZ+2*FBAREA>>,<QLEN==.EQPSZ+2*FBAREA>	;GALAXY BIGGER?
>
IFE FTBOTH,<
IFN FTMPB,<QLEN==Q.LGTH+1>
IFN FTGALAXY,<QLEN==.EQPSZ+2*FBAREA>
>

QHEAD:	BLOCK	QLEN		;ROOM FOR QUEUE ENTRY
QEND==.-1			;LAST WORD TO ZERO
IFN FTMPB,<
QUEBLK=QHEAD+1			;ACTUAL RECORD FOR QMANGR

OLIST:	IOWD	Q.LGTH,QUEBLK
	0

QUEDIR:	BLOCK	1		;PPN FOR QUE
QUESTR:	BLOCK	1		;STR FOR QUE
>

IFN FTGALAXY,<

IFN FTUUOS,<
CTLFB$=:QHEAD+.EQPSZ	;WHERE CONTROL FILE (FIRST FILE) IS
>
IFN FTJSYS,<
CTLFB$=:QHEAD+EQHSIZ	;WHERE CONTROL FILE (FIRST FILE) IS
>
LOGFB$=:CTLFB$+FBAREA
SAVEP:	BLOCK	1
SAVREL:	BLOCK	1
PAGTAB:	BLOCK	3
IFN FTJSYS,<
MYPID:	BLOCK	1		;MY PID (NECESSARY FOR SEND/RECEIVE)
>
QSRPID:	BLOCK	1		;PID OF SYSTEM QUASAR
FBTEMP:	BLOCK	FBAREA		;LARGEST FILE BLOCK THAT CAN BE BUILT FROM MPB DATA
				;ALSO USED TO SEND/RECEIVE "SHORT" MESSAGES
STRBLK:	BLOCK	5		;AREA FOR DETERMINING STR FROM UNIT
				;ALSO USED FOR SOME SCRATCH STORAGE
>

RTYCNT:	BLOCK	1		;RETRY COUNTER WHEN SEND TO QUASAR FAILS
				;OR ENTER TO QUE AREA FAILS
THSJB$::BLOCK	1
CHAN:	BLOCK	2

$RBBLK::.RBDEV		;INCLUDE FILE STR/UNIT ARG
	BLOCK	.RBDEV	;ROOM FOR ARGUMENTS
$RBPPN=:$RBBLK+.RBPPN
$RBNAM=:$RBBLK+.RBNAM
$RBEXT=:$RBBLK+.RBEXT
$RBPRV=:$RBBLK+.RBPRV
$RBSIZ=:$RBBLK+.RBSIZ
$RBVER=:$RBBLK+.RBVER
$RBSPL=:$RBBLK+.RBSPL
$RBEST=:$RBBLK+.RBEST
$RBALC=:$RBBLK+.RBALC
$RBPOS=:$RBBLK+.RBPOS
$RBFT1=:$RBBLK+.RBFT1
$RBNCA=:$RBBLK+.RBNCA
$RBMTA=:$RBBLK+.RBMTA
$RBDEV=:$RBBLK+.RBDEV

PTHBL$::BLOCK	10

IFN FTMPB,<
	SUBTTL	COMMON CODE FOR OUTPUT, SUBMIT

$DOQUE::IFMPB	DOQUEG		;DO GALAXY QUEUE IF NOT MPB
	MOVE	A,QUESIX(QD)	;GET GENERIC OUTPUT DEVICE
	MOVEM	A,Q.DEV(Q)	;AND STORE THAT
	CAIN	QD,4		;INP: ?
	MOVSI	A,'LPT'		;USE LPT FOR BATCH
	WHERE	A,		;FIND STATION FOR REQUEST
	 SETZ	A,		;ASSUME CENTRAL
	HRRM	A,Q.DEV(Q)	;STORE IT
	SETOM	RTYCNT		;WANT TO TRY ENTER TWICE
DOQUER:	MOVE	A,[XWD 400000,16]	;PHYSICAL OPEN
	MOVE	B,QUESTR	;QUE DEVICE
	SETZ	C,		;NO BUFFERS
	PUSHJ	P,XUUO$		;EXECUTE THE OPEN WITH CHANNEL
	OPEN	0,A		;OPEN IT
	 JRST	NOQUE		;CAN'T
	MOVSI	T3,'QUE'	;EXTENSION FOR UNINAM
	PUSHJ	P,UNINAM	;GET A UNIQUE NAME
	 LOOKUP	0,T2		;CHANNEL ZERO. T2-T5
	MOVSI	T4,177000	;NOW ENTER IT AND PROTECT IT
	PUSHJ	P,XUUO$		;EXECUTE ENTER
	ENTER	0,T2		;ENTER IT
	 JRST	[AOSG RTYCNT	;FIRST TRY?
		 JRST DOQUER	;YES. TRY AGAIN
		 JRST NOENT ]	;NO, GIVE ERROR
	MOVNI	A,Q.LGTO	;NEGATIVE LENGTH OF OUTPUT ENTRY
	CAIN	QD,4		;INP:?
	MOVNI	A,Q.LGTI	;NEGATIVE LENGTH OF INPUT ENTRY
	HRLM	A,OLIST		;FIX IOWD
	PUSHJ	P,XUUO$		;EXECUTE OUTPUT
	OUTPUT	0,OLIST		;WRITE IT
	PUSHJ	P,XUUO$		;EXECUTE RELEASE
	RELEAS	0,		;RELEAS IT
	MOVE	A,[%NSHJB]	;GET HIGHEST JOB NUMBER
	GETTAB	A,
	 MOVEI	A,^D64		;??
	MOVEI	B,1
CREDN2:	HRLZ	C,B		;LOOK AT JOB NAMES
	HRRI	C,.GTPRG	;IN MONITOR
	GETTAB	C,
	 JRST	CPOPJ1
	CAME	C,SPLNAM(QD)	;WHO WE QUEUED FOR?
	 JRST	CREDN3		;NO. LOOK AT MORE
	MOVE	C,B		;WAKE HIM
	WAKE	C,
	 JFCL			;OH WELL
CREDN3:	CAIGE	B,(A)		;LOOKED AT ALL JOBS?
	AOJA	B,CREDN2	;NO. CONTINUE
	JRST	CPOPJ1		;SKIP RETURN TO USER
	SUBTTL	SUBROUTINES TO DO COMMON THINGS FOR INPUT/OUTPUT

; GET COMMON INFO
GTINF$::MOVEI	Q,QHEAD		;SET ADDRESS OF QUEUE BLOCK
	SETZB	F,QHEAD		;START WITH NO FLAGS
	MOVE	T1,[XWD QHEAD,QHEAD+1]
	BLT	T1,QEND		;CLEAR QUEUE BLOCK
	MOVX	T4,%CNST2	;IS THIS GALAXY OR MPB SYSTEM
	GETTAB	T4,
	 SETZ	T4,		;ASSUME MPB
	TXNN	T4,ST%GAL	;GALAXY?
	 JRST	GTINF1		;NO.
	MOVX	T4,%SIQSR	;MAYBE. CHECK MORE
	GETTAB	T4,
	 SETZ	T4,
	JUMPE	T4,GTINF1	;GALAXY? (NONZERO PID)
IFE FTBOTH,<
	 FAIL (<CMQ Cannot do MPB QUEUE on GALAXY system.>)
>
IFN FTBOTH,<
	TLO	F,GALAXY	;SET GALAXY BIT
	IFMPB	GTINFG		;DO GALAXY QUEUE IF NOT MPB
>
GTINF1:	MOVEI	QF,Q.OSTR(Q)	;ASSUME OUTPUT, FIRST FILE. SUBMIT WILL CORRECT
	MOVE	A,[BYTE (9).QOHED,Q.FMOD+1(18)1] ;ASSUME OUTPUT REQUEST
	CAIN	QD,4		;INP REQUEST?
	MOVE	A,[BYTE(9).QIHED,Q.FMOD+1(18)2] ;INP REQUEST
	MOVEM	A,Q.LEN(Q)	;STORE QUE HEADER
	MOVEI	A,12001		;VERSION 1, US, CREATE
	MOVEM	A,Q.OPR(Q)	;STORE IT
	HRROI	A,.GTNM1	;GET USER NAME
	GETTAB	A,
	 SETZ	A,
	MOVEM	A,Q.USER(Q)	;REMEMBER IT
	HRROI	A,.GTNM2	;GET REST OF USER NAME
	GETTAB	A,
	 SETZ	A,
	MOVEM	A,Q.USER+1(Q)	;REMEMBER THAT TOO
	HRROI	A,.GTCNO	;GET CHARGE NUMBER
	GETTAB	A,
	 SETZ	A,
	MOVEM	A,Q.CNO(Q)	;REMEMBER THAT
	MOVE	A,[%LDSTP]	;GET STANDARD PROTECTION
	GETTAB	A,
	 MOVSI	A,055000	;DEFAULT
	LSH	A,-^D27		;REALIGN
	DPB	A,[POINTR(Q.PRI(Q),QP.PRO)]
	PJOB	A,		;GET OUR JOB NUMBER
	MOVEM	A,THSJB$	;REMEMBER IT
	GETPPN	A,		;GET OUR PPN
	 JFCL			;JUST IN CASE
	MOVEM	A,Q.PPN(Q)	;STORE IT IN QUE BLOCK
	MOVSI	A,'QUE'		;FIND QUE DEVICE
	DEVCHR	A,		;SEE WHAT IT IS
	TLNE	A,(DV.DSK)	;REAL DISK?
	TLNE	A,(DV.TTY)	;MAYBE
	 JRST	PUBQUE		;NO
	MOVSI	A,'QUE'		;GET PPN ASSOCIATED
	DEVPPN	A,
	 MOVE	A,Q.PPN(Q)
	CAME	A,Q.PPN(Q)	;IS IT HIMSELF?
	 JRST	PUBQUE		;NO. PUBLIC QUEUE
	MOVSI	B,'QUE'		;GET ASSOCIATED STR
	DEVNAM	B,
	 MOVSI	B,'DSK'
	JRST	STOQUE		;STORE QUE
PUBQUE:	MOVE	A,[%LDQUE]	;GET QUE PPN
	GETTAB	A,
	 MOVE	A,[XWD 3,3]	;DEFAULT
	MOVE	B,[%LDQUS]	;GET QUE STR
	GETTAB	B,
	 MOVSI	B,'DSK'
STOQUE:	MOVEM	A,QUEDIR	;STORE QUE PPN
	MOVEM	B,QUESTR	;STORE QUE STR
	POPJ	P,
DOFIL$::SETZM	$RBPPN		;CLEAR UUO BLOCK
	MOVE	T1,[XWD $RBPPN,$RBNAM]
	BLT	T1,$RBDEV
	MOVEM	A,$RBNAM	;SET NAME TO FIND
	MOVEM	B,$RBEXT	;EXTENSION TOO
	IFMPB	DOFILG		;DO GALAXY QUEUE IF NOT MPB
	MOVEM	A,Q.FNAM(QF)	;AND IN QUE BLOCK
	MOVEM	A,Q.JOB(Q)	;STORE AS NAME OF JOB
				;(MAKES DEFAULT JOB NAME LOG NAME)
	MOVEM	B,Q.FEXT(QF)	;AND IN QUE BLOCK
	HRRZ	B,CHAN+0
	LSH	B,-5		;GET PPN ASSOCIATED WITH DEVICE
	DEVPPN	B,
	 MOVE	B,Q.PPN(Q)	;ASSUME SELF
	MOVEM	B,$RBPPN	;PPN OF FILE
	MOVEM	B,Q.FDIR(QF)	;AND IN QUE BLOCK
	MOVEI	A,.QFDPR
	CAME	B,Q.PPN(Q)	;IS IT HIS PPN?
	DPB	A,[POINTR(Q.FMOD(QF),QF.DSP)] ;NO. MAKE IS DISP:PRES
HISFIL:	TLZ	F,NEDREN	;ASSUME NO RENAME NEEDED
	MOVEI	A,1		;START AT BEGINNING
	DPB	A,[POINTR(Q.FBIT(QF),QB.SLN)]
; MAY COME BACK HERE IF DIS:REN FAILS
REFILE:	PUSHJ	P,XUUO$		;EXECUTE LOOKUP
	LOOKUP	0,$RBBLK	;IS FILE THERE?
	 JRST	[		;NOT THERE. MAY BE NEW LOG
		TLNN	F,LOGFIL	;LOG FILE?
		 POPJ	P,		;NO. ERROR
		MOVSI	A,(QF.DEF)	;FILE DOESN'T EXIST YET
		IORM	A,Q.LMOD(Q)	;ONLY ON LOG
		JRST	REL0		;RELEAS CHANNEL AND SKIP RETURN
	]
	MOVE	A,$RBDEV	;GET DEVICE FILE IS ON
	MOVEM	A,Q.FSTR(QF)	;STORE IT
	SETZM	PTHBL$		;SET ARG TO PATH
	MOVE	A,[XWD ^D8,PTHBL$]
	PATH.	A,		;GET FULL PATH TO FILE
	 JRST	NOPTHM		;JUST PPN
	MOVSI	A,PTHBL$+2	;GET PPN AND SFDS
	HRRI	A,Q.FDIR(QF)	;INTO FILE DESCRIPTION
	BLT	A,Q.FDIR+5(QF)	;JUST SIX WORDS
NOPTHM:	MOVSI	A,Q.CSTR(Q)
	HRRI	A,Q.LSTR(Q)
	TLNE	F,CTLFIL	;IS THIS THE CTL FILE
	BLT	A,Q.LNAM(Q)	;DEFAULT WHERE TO FIND LOG
				; INCLUDED STR,PATH,NAME. NOT EXT
	LDB	A,[POINT 9,$RBPRV,8]
	MOVEI	B,177		;MAKE SURE FILE IS PROTECTED IF WE RENAME
	DPB	B,[POINT 9,$RBPRV,8]
	TRNE	A,700		;IS IT PROTECTED?
	 JRST	PROTOK		;YES
	TLO	F,NEDREN	;FLAG TO DO A RENAME
	MOVSI	A,(QB.APF)	;MARK ARTIFICIALLY PROTECTED
	IORM	A,Q.FBIT(QF)
PROTOK:	LDB	A,[POINTR(Q.FMOD(QF),QF.DSP)]
	CAIE	A,.QFDRE	;IS IT DISPOSE RENAME?
	 JRST	NOCROS		;NO. SKIP THIS
	PUSHJ	P,NEXCH$	;GET SECONDARY CHANNEL
	 JRST	NOREN		;NO RENAME IF NO CHANNEL
	MOVE	A,[XWD 400000,16]
	MOVE	B,$RBDEV
	SETZ	C,
	PUSHJ	P,XUUO$		;EXECUTE THE OPEN
	OPEN	1,A		;OPEN THE STR
	 JRST	NOREN		;CAN'T. THEREFORE NO DIS:REN
	MOVSI	T3,'QUD'	;EXTENSION FOR UNINAM
	PUSHJ	P,UNINAM	;FIND UNIQUE NAME VIA NEXT LOOKUP
	LOOKUP	1,T2		;SECONDARY CHANNEL
	PUSHJ	P,XUUO$		;EXECUTE THE RELEAS
	RELEAS	1,		;SECONDARY CHANNEL
	HRR	T3,$RBEXT	;GET BLOCK WAY WE WANT IT
	MOVE	T4,$RBPRV	;INCLUDING DATES, PROTECTIONS, ETC
	PUSHJ	P,XUUO$		;EXECUTE LOOKUP
	RENAME	0,T2		;RENAME ACROSS DIRECTORIES
	 JRST	NOREN		;FAILED
	MOVEM	T2,Q.FRNM(QF)	;STORE RENAMED NAME
REL0:	PUSHJ	P,XUUO$		;EXECUTE RELEASE
	RELEAS	0,
	JRST	CPOPJ1		;SKIP RETURN
NOREN:	OUTSTR	[ASCIZ/
% Cannot do DISPOSE:RENAME. DISPOSE:DELETE assumed.
/]
	MOVEI	A,.QFDDE	;CHANGE DISP TO DELETE
	DPB	A,[POINTR(Q.FMOD(QF),QF.DSP)]
	TLNN	F,NEDREN	;NEED RENAME?
	JRST	REL0		;NO. WE'RE DONE
	JRST	REFILE		;YES. GET FILE BACK

NOCROS:	TLNN	F,NEDREN	;NEED RENAME?
	JRST	REL0		;NO. WE'RE DONE
	PUSHJ	P,XUUO$		;EXECUTE RENAME
	RENAME	0,$RBBLK	;YES. DO IT
	 JFCL			;OOPS?
	JRST	REL0		;DONE
; SUBROUTINE TO FIND A UNIQUE QUE NAME
; CALL IS
;		MOVSI	T3,'EXT'
;		PUSHJ	P,UNINAM
;		 LOOKUP	CHAN,T2
;		   RETURNS HERE ALWAYS
;		WITH NAME IN T2, EXT IN T3, QUEDIR IN T5
;		USES A, T1-T5

UNINAM:	MOVE	T1,@(P)		;GET THE LOOKUP
	MOVEM	T1,UNINMX	;STORE IT
	MSTIME	T1,		;FIND A UNIQUE NAME
	IDIVI	T1,^D100
UNINM1:	MOVE	T2,QUESIX(QD)	;QUE NAME
	MOVE	A,[POINT 6,T2,11]
	ADD	T1,THSJB$
	MOVE	T4,T1
UNINM2:	IDIVI	T4,^D10
	ADDI	T5,'0'
	IDPB	T5,A
	TLNE	A,(77B5)	;FILLED OUT SIX CHAR NAME YET?
	JRST	UNINM2		;NO
	TRZ	T3,-1		;JUST THE EXTENSION
	SETZ	T4,
	MOVE	T5,QUEDIR
	PUSHJ	P,XUUO$		;EXECUTE THE RIGHT LOOKUP
UNINMX:	HALT	.		;MODIFIED FOR RIGHT LOOKUP
	 TRNE	T3,-1		;NO SUCH FILE?
	JRST	UNINM1		;IT EXISTS
	MOVE	T5,QUEDIR	;NAME IS UNIQUE. RETURN PPN
	JRST	CPOPJ1
>

; SUBROUTINE TO OPEN DSK, CHANNEL ZERO
OPDSK$::MOVEI	T1,16		;OPEN DSK IN DUMP MODE
	MOVSI	T2,'DSK'
	SETZ	T3,
	PUSHJ	P,XUUO$		;EXECUTE OPEN
	OPEN	0,T1
	 POPJ	P,
CPOPJ1:	AOS	(P)		;SKIP RETURN TO USER
CPOPJ:	POPJ	P,
; SUBROUTINES TO FIND FREE CHANNELS, AND TO DO IO OPS ON THEM
FIRCH$::MOVEI	A,20
	MOVEM	A,TRYCHN#
	SETOM	CHAN		;SAY CHANNELS NOT IN USE
	SETOM	CHAN+1
	TDZA	A,A
NEXCH$::MOVEI	A,1
NEYCHN:	SOSGE	B,TRYCHN
	JRST	NOCHN
	DEVCHR	B,
	JUMPN	B,NEYCHN
	MOVE	B,TRYCHN
	LSH	B,5
	MOVEM	B,CHAN(A)
	JRST	CPOPJ1

;ROUTINE TO EXECUTE UUO WITH PROPER CHANNEL INSERTED
XUUO$::	PUSH	P,F		;SAVE A REGISTER TO WORK
	MOVE	F,@-1(P)
	TLZN	F,(17B12)
	JRST	XUUO0		;DO CHANNEL 0
	SKIPGE	CHAN+1		;IN USE?
	 JRST	FPOPJ1		;NO. RETURN
	TLO	F,@CHAN+1
	JRST	XUUO2		;CONTINUE AND DO IT
XUUO0:	SKIPGE	CHAN+0		;IN USE?
	 JRST	FPOPJ1		;NO. RETURN
	TLO	F,@CHAN
XUUO2:	AOS	-1(P)
	XCT	F
	SOS	-1(P)
FPOPJ1:	POP	P,F		;RESTORE REGISTER
	JRST	CPOPJ1

NOCHN:	OUTSTR	[ASCIZ/NO FREE CHANNELS!
/]
	POPJ	P,

IFN FTMPB,<
	SUBTTL	ERROR ROUTINES
NOQUE:	MOVEI	1,6		;CAN'T OPEN QUE DEVICE
	OUTSTR	[ASCIZ/
% CANNOT OPEN QUEUE DEVICE!
% PLEASE NOTIFY OPERATOR!
/]
	POPJ	P,		;RETURN

NOENT:	MOVEI	1,7		;CAN'T ENTER QUEUE FILE
	OUTSTR	[ASCIZ/
% CANNOT ENTER QUEUE REQUEST IN QUE UFD!
% PLEASE NOTIFY OPERATOR!
/]
	POPJ	P,		;RETURN ERROR.
>	;END IFN FTMPB
IFN FTGALAXY,<
	SUBTTL	COMMON CODE FOR OUTPUT, SUBMIT

IFN FTBOTH,<DOQUEG:>
IFE FTBOTH,<$DOQUE::>
	PUSH	P,.JBFF##	;SAVE .JBFF
	MOVEM	P,SAVEP		;SAVE PDL
	MOVE	T1,.JBREL##	;SAVE .JBREL
	MOVEM	T1,SAVREL
	ADDI	T1,1		;GET A PAGE
	MOVE	M,T1		;FROM MONITOR
	CORE	T1,
	 FAIL	(<CGC Cannot get core for QUEUE message>)
	MOVE	T1,M		;COPY MESSAGE ADDRESS
	HRLI	T1,QHEAD	;WHERE HEADER IS
	HLRZ	T2,.MSTYP(Q)	;LENGTH OF HEADER
	ADD	T2,M		;UPPER ADDRESS PLUS ONE
	BLT	T1,-1(T2)	;MOVE HEADER
	MOVE	T1,T2		;WHERE NEXT GROUP GOES
	HRLI	T1,CTLFB$	;FROM
	HRRZ	T3,CTLFB$	;COMPUTE LENGTH
	ADDI	T3,FPXSIZ
	ADD	T2,T3
	BLT	T1,-1(T2)	;MOVE THIS BLOCK
	CAIE	QD,4		;INP QUE?
	 JRST	DOQUE1		;NO. DONE
	MOVE	T1,T2		;YES. GET LOG FILE
	HRLI	T1,LOGFB$	;FORM
	HRRZ	T3,LOGFB$	;COMPUTE LENGTH
	ADDI	T3,FPXSIZ
	ADD	T2,T3
	BLT	T1,-1(T2)	;MOVE IT
DOQUE1:	SUB	T2,M		;TOTAL LENGTH
	HRLM	T2,.MSTYP(M)	;STORE IT AWAY
	MOVSI	T1,(1B0)	;SET ACK REQUEST
	IORM	T1,(M)		;IN MESSAGE
	TLO	M,(1B0)		;AND PAGE MODE MESSAGE IN M
	PUSHJ	P,MSGSND	;SEND THE MESSAGE
	PUSHJ	P,RCVACK	;GET ACK
IFN FTJSYS,<
	SKIPN	T2,MYPID		;DO I OWN A PID
	  JRST	QMRX.1			;NO, JUST RETURN
	MOVEI	S1,2			;TWO WORDS
	MOVEI	S2,T1			;IN T1 AND T2
	MOVEI	T1,.MUDES		;DESTROY PID IN T2
	MUTIL				;EXECUTE IT
	  JFCL				;NICE TRY
>
	PUSHJ	P,XUUO$		;EXECUTE RELEASE
	RELEAS	0,
	PUSHJ	P,CHKCOR	;CLEAN UP OUR CORE
	POP	P,.JBFF		;RESTORE .JBFF
	JRST	CPOPJ1
	SUBTTL	SUBROUTINES TO DO COMMON THINGS FOR INPUT/OUTPUT

;GET COMMON INFO
IFE FTBOTH,<
GTINF$::MOVX	T4,%CNST2		;GET SECOND STATES WORD
	GETTAB	T4,			;TO LOOK FOR GALAXY-10
	  ZERO	T4			;WHAT!!
	TXNN	T4,ST%GAL		;SYSTEM HAVE SUPPORT FOR GALAXY-10
	  FAIL(<NGS No GALAXY-10 Support in this monitor>)
	MOVEI	Q,QHEAD		;ADDRESS OF QUEUE AREA
	SETZB	F,QHEAD		;CLEAR IT OUT
	MOVE	T1,[XWD QHEAD,QHEAD+1]
	BLT	T1,QEND
>
IFN FTBOTH,<GTINFG:>
	MOVEI	QF,CTLFB$	;ADDRESS OF FIRST FILE BLOCK
	PJOB	A,		;COPY JOB NUMBER
	MOVEM	A,THSJB$	;TO MEMORY
	MOVE	T1,[XWD EQHSIZ,.QOCRE]	;ASSUME OUTPUT REQUEST
	CAIN	QD,4		;INP REQUEST?
IFN FTUUOS,<
	HRLI	T1,.EQPSZ	;SIZE OF INP REQUEST
>
IFN FTJSYS,<
	HRLI	T1,EQHSIZ	;SIZE OF INP REQUEST
>
	MOVEM	T1,.MSTYP(Q)

IFN FTUUOS,<
	MOVE	T1,[XWD %%.QSR,.EQPSZ]	;LENGTH WORD
	CAIE	QD,4			;INP?
	HRRI	T1,EQHSIZ		;NO
>
IFN FTJSYS,<
	MOVE	T1,[XWD %%.QSR,EQHSIZ]	;LENGTH WORD
>
	MOVEM	T1,.EQLEN(Q)

	MOVE	T1,QUESIX(QD)		;QUEUE DEVICE
	MOVEM	T1,.EQRDV(Q)

	HRROI	T1,.GTLOC		;GET LAST LOCATE(EVEN IF NO LPT!)
	GETTAB	T1,
	 SETZ	T1,
	DPB	T1,[POINTR(.EQSEQ(Q),EQ.DSN)]

	MOVE	T1,[%LDSTP]		;GET DEFAULT SYSTEM PROTECTION
	GETTAB	T1,
	 MOVSI	T1,055000		;DEFAULT
	LSH	T1,-^D27		;RIGHT JUSTIFY
	DPB	T1,[POINTR(.EQSPC(Q),EQ.PRO)]

	MOVEI	T1,1			;DEFAULT NUMBER OF FILES
	CAIN	QD,4			;UNLESS INP
	MOVEI	T1,2			;TWO FOR THAT
	DPB	T1,[POINTR(.EQSPC(Q),EQ.NUM)]

IFN FTUUOS,<
	HRROI	T1,.GTNM1		;GET USER NAME
	GETTAB	T1,
	 SETZ	T1,
	MOVEM	T1,.EQUSR(Q)
	HRROI	T1,.GTNM2
	GETTAB	T1,
	 SETZ	T1,
	MOVEM	T1,.EQUSR+1(Q)

	GETPPN	T1,			;GET PPN
	 JFCL
	MOVEM	T1,.EQOWN(Q)

	PUSHJ	P,QUEFLS		;FLUSH THE RECEIVE QUEUE FIRST
>
IFN FTJSYS,<
	PUSHJ	P,DOACCT	;FILL THE ACCOUNTING STRING
>
	POPJ	P,

IFN FTJSYS,<
DOACCT:	PUSH	P,S1			;SAVE S1
	PUSH	P,S2			;SAVE S2
	SETO	S1,			;MY JOB
	HRROI	S2,.EQACT(M)		;POINT TO BLOCK FOR STRING
	GACCT				;GET ACCOUNT FOR MY JOB
	TXC	S2,5B2			;FLIP THOSE BITS
	TXNE	S2,5B2			;IF THEY ARE BOTH 0 THEY WERE 1
	JRST	DOAC.2			;TWAS A STRING, RETURN
	MOVE	S1,[POINT 7,.EQACT(M)]	;ELSE MAKE A BYTE POINTER
	MOVE	T1,S2			;GET ACCOUNT NUMBER
	PUSHJ	P,DOAC.1		;CONVERT TO STRING
DOAC.2:	POP	P,S2			;RESTORE S2
	POP	P,S1			;RESTORE S1
	POPJ	P,			;AND RETURN

DOAC.1:	IDIVI	T1,12			;GET DIGIT MOD 10
	PUSH	P,T2			;STACK IT
	SKIPE	T1			;DONE IF 0
	PUSHJ	P,DOAC.1		;ELSE, RECURSE
	POP	P,T1			;GET THE DIGIT BACK
	ADDI	T1,"0"			;CONVERT TO ASCII
	IDPB	T1,S1			;DEPOSIT IT
	POPJ	P,			;AND RETURN
>
IFE FTBOTH,<
DOFIL$::SETZM	$RBPPN		;CLEAR LOOKUP BLOCK
	MOVE	T1,[XWD $RBPPN,$RBPPN+1]
	BLT	T1,$RBDEV
	MOVEM	A,$RBNAM	;SAVE NAME IN LOOKUP BLOCK
	MOVEM	B,$RBEXT	;SAVE EXTENSION IN LOOKUP BLOCK
>
IFN FTBOTH,<DOFILG:>
	MOVEM	A,.EQJOB(Q)	;ALSO JOB NAME (MAKES SAME AS LOG FILE)
IFN FTUUOS,<
	MOVEM	A,FPXSIZ+.FDNAM(QF)
	HLLZM	B,FPXSIZ+.FDEXT(QF)
>
	HRRZ	B,CHAN+0
	LSH	B,-5		;CHANNEL FOR PRIMARY
	DEVPPN	B,		;PPN OF FILE DEVICE
IFN FTUUOS,<
	 MOVE	B,.EQOWN(Q)	;US
>
IFN FTJSYS,<
	 SETZ	B,		;??
>
	MOVEM	B,$RBPPN	;FOR LOOKUP
IFN FTUUOS,<
	MOVEM	B,FPXSIZ+.FDPPN(QF) ;FILE BLOCK
	MOVEI	A,FP.DEL	;DELETE BIT
	CAME	B,.EQOWN(Q)	;SELF?
	ANDCAM	A,.FPINF(QF)	;NO. CLEAR DELETE REQUEST
>
REFILG:	PUSHJ	P,XUUO$		;EXECUTE THE LOOKUP
	LOOKUP	0,$RBBLK	;LOOKUP FOR FILE
	 JRST	MAKFIL		;OOPS
IFN FTUUOS,<
	MOVE	T1,$RBDEV	;GET STR
	MOVEM	T1,STRBLK+.DCNAM ;SET UP DSKCHR
	MOVE	T1,[XWD 5,STRBLK]
	DSKCHR	T1,		;DO IT
	 JRST	REFIL1		;OOPS
	JUMPE	T1,REFIL1	;NUL!
	SKIPA	T1,STRBLK+.DCSNM ;REAL STR NAME
REFIL1:	MOVE	T1,$RBDEV	;JUST AS LOOKUP UP
	MOVEM	T1,FPXSIZ+.FDSTR(QF) ;STORE STR NAME
	SETZM	PTHBL$		;GET PATH
	MOVEI	B,FDMSIZ	;MINIMUM BLOCK SIZE
	MOVE	A,[XWD ^D8,PTHBL$]
	PATH.	A,		;GET PATH
	 JRST	NOPTHG		;OOPS
	MOVSI	T1,-5		;COPY IT ALL
REFIL2:	MOVE	A,PTHBL$+3(T1)	;GET AN SFD
	JUMPE	A,NOPTHG	;DONE ON ZERO
	MOVEM	A,FPXSIZ+.FDPAT(T1)
	ADDI	B,1		;ONE LONGER FILE BLOCK
	AOBJN	T1,REFIL2	;LOOP
NOPTHG:	HRLI	B,FPXSIZ	;SET UP HEADER
	MOVEM	B,.FPSIZ(QF)	;STORE
>
IFN FTJSYS,<
	MOVEI	T3,.FPSTG(QF)	;WHERE TO STORE STRING
	HRLI	T3,(POINT 7,0)	;BYTE POINTER
	MOVE	A,[4,,T1]	;LENGTH,,ARGS
	MOVEI	T1,3		;FUNCTION 3, PPN TO STRING
	MOVE	T2,$RBPPN	;THE PPN, BYTE POINTER IS IN T3
	MOVE	T4,$RBDEV	;GET STRUCTURE
	COMPT.	A,
	 FAIL	(<CDD Cannot determine directory of file owner>)
	MOVEI	T1,$RBNAM	;FILE NAME
	PUSHJ	P,BLDSTG	;INTO THE STRING
	STCHR	<".">		;MORE PUNCTUATION
	HLLZS	$RBEXT		;JUST EXTENSION
	MOVEI	T,$RBEXT	;NOW POINT TO IT
	PUSHJ	P,BLDSTG	;INTO THE STRING
	STCHR	0		;ADD A NULL TO TERMINATE THE STRING
	HRRZS	T3		;NOW COMPUT THE LENGTH
	SUBI	T3,.FPSTG-1(QF)	;THE NUMBER OF WORDS IN THE STRING
	HRLI	T3,.FPXSIZ	;PARAMETER LENGTH
	MOVEM	T3,.FPSIZ(QF)	;STORE
>
	PUSHJ	P,XUUO$		;EXECUTE RELEASE
	RELEAS	0,		;FREE DEVICE
	JRST	CPOPJ1

MAKFIL:	TLNN	F,LOGFIL	;LOG FILE?
	 JRST	RELERR		;NO. ERROR
	HRRZ	T1,$RBEXT	;GET ERROR
	JUMPN	T1,RELERR	;ERROR IF EXISTS
	PUSHJ	P,XUUO$		;EXECUTE THE ENTER
	ENTER	0,$RBBLK	;MAKE THE FILE
	 JRST	RELERR		;OOPS!
	PUSHJ	P,XUUO$		;EXECUTE THE CLOSE
	CLOSE	0,		;CLOSE IT
	JRST	REFILG		;NOW DO IT

RELERR:	PUSHJ	P,XUUO$		;EXECUTE THE RELEASE
	RELEAS	0,		;FREE DEVICE
	POPJ	P,

IFN FTJSYS,<
; SIXBIT TO ASCII CONVERSION UTILITY

BLDSTG:	HRLI	T1,(POINT 6,0)		;A SIXBIT BYTE
BLSTG1:	ILDB	T2,T1			;GET ONE
	JUMPE	T2,CPOPJ		;DONE ON A NULL (SPACE)
	ADDI	T2," "			;ASCII-IZE IT
	IDPB	T2,T3			;INTO CURRENT STRING
	TLNE	T1,770000		;OFF THE END YET
	  JRST	BLSTG1			;NO, GET ANOTHER
	POPJ	P,			;RETURN WITH CHRS AND BP UPDATED

>  ;END OF IFN FTJSYS
> ;END IFN FTGALAXY
SUBTTL	Subroutines

;SUBROUTINE TO TYPE OUT A MESSAGE AND BOMB.. CALLED BY THE 'FAIL' & 'FAIL1' MACROS

FAIL.:	PUSHJ	P,TTCRLF		;START THE LINE
	OUTSTR	[ASCIZ/?QMR/]		;ADD PREFIX
	OUTSTR	(T1)			;OUTPUT SUFFIX AND MESSAGE AFTER PREFIX
	PUSHJ	P,TTCRLF		;END THE LINE
FAIEXI:	EXIT	1,			;EXIT AFTER THE OUTPUT
	FAIL1(<CNC Can't CONTINUE -- try REENTER>)

;TTY OUTPUT SUBROUTINES

TTCRLF:	OUTSTR	[BYTE (7) .CHCRT, .CHLFD, 0]
	POPJ	P,

IFN FTGALAXY,<
TTYSIX:	MOVE	T2,[POINT 6,T1]		;THE INITIAL BYTE POINTER
TYSIX1:	ILDB	T3,T2			;GET A CHARACTER
	JUMPE	T3,CPOPJ		;STOP AT A NULL (BLANK)
	ADDI	T3," "			;ASCII-IZE IT
	OUTCHR	T3			;DUMP IT OUT
	TLNE	T2,770000		;END OF THE WORD
	  JRST	TYSIX1			;NO, GET ANOTHER
	POPJ	P,			;ALL DONE

; CORE MANIPULATION ROUTINES
CHKCOR:	MOVE	T1,.JBREL##	;GET CURRENT .JBREL
	CAMG	T1,SAVREL	;GREATER THAN SHOULD BE?
	 POPJ	P,		;NO. DONE
	LSH	T1,-^D9		;GET PAGE NUMBER
	TLO	T1,(1B0)	;SET DELETE BIT
	MOVEM	T1,PAGTAB+1	;AND PAGE
	MOVEI	T1,1		;ONE PAGE TO DELETE
	MOVEM	T1,PAGTAB
	MOVE	T1,[XWD .PAGCD,PAGTAB]
	PAGE.	T1,
	 JRST	.+2		;OOPS
	JRST	CHKCOR		;SKRINK MORE?
	MOVE	T1,SAVREL	;CAN'T DO PAGE.
	CORE	T1,		;SO DO CORE - SHOULD BE SAFE
	 FAIL	(<CCC Cannot cutback core.>)
	POPJ	P,		;RETURN
;SUBROUTINES TO FLUSH THE RECEIVE QUEUE (NEEDED FOR TOPS10 ONLY)

IFN FTUUOS,<

QUEFLS:	PUSHJ	P,QUEQRY		;QUERY THE QUEUE
	PJUMPE	S2,CPOPJ		;RETURN WHEN EMPTY
	PUSHJ	P,QUEIGN		;IGNORE THE ENTRY
	JRST	QUEFLS			;AND KEEP GOING

QUEQRY:	SETZB	T1,T2			;CLEAR QUERY BLOCK
	SETZB	T3,T4			;FOR GOOD MEASURE
	MOVE	S2,[4,,T1]		;LENGTH,,ARGUMENTS
	IPCFQ.	S2,			;FIND OUT WHATS THERE
	  SETZ	T4,			;NOTHING, CLEAR T4
	MOVE	S2,T4			;COPY QUEUE STATUS INTO S2
	JUMPE	S2,CPOPJ		;RETURN IF NOTHING THERE
	CAMN	T2,QSRPID		;FROM QUASAR
	  POPJ	P,			;YES, RETURN NOW
	PUSHJ	P,QUEIGN		;FLUSH THE JUNK MAIL
	JRST	QUEQRY			;LOOK AGAIN

QUEIGN:	ANDX	T1,IP.CFV		;CLEAR ALL BUT PAGE MODE BIT
	TXO	T1,IP.CFT		;SET TO TRUNCATE
	SETZB	T2,T3			;CLEAR THEM AGAIN
	MOVEI	T4,1			;LENGTH = 0 , LOC = 1
	MOVE	S2,[4,,T1]		;SET UP LENGTH AND BLOCK ADDRESS
	IPCFR.	S2,			;THROW AWAY THE MESSAGE
	  FAIL(<CFR Cannot flush the IPCF receive queue>)
	POPJ	P,			;RETURN

QUEWAT:	PUSHJ	P,QUEQRY		;FIND OUT WHATS THERE
	JUMPN	S2,CPOPJ		;SOMETHING, RETURN
	MOVX	S2,<HB.IPC+^D2000>	;FLAGS,,NAP TIME
	HIBER	S2,			;WAIT FOR A REASONABLE TIME
	  JFCL				;WATCH THIS LOOP
	JRST	QUEWAT			;TRY NOW

>  ;END OF IFN FTUUOS
; SUBROUTINE TO RECEIVE AN EXPECTED "ACK" FROM QUASAR
;	IT RETURNS TO THE CALLER AFTER RECEIVING A "GOOD" ONE
;	ISSUES AN ERROR MESSAGE AND QUITS ON A "BADDY"

RCVACC:	PUSHJ	P,CHKCOR		;CLEAN UP CORE
RCVACK:	MOVEI	M,FBTEMP		;AREA FOR SHORT RECEIVE

IFN FTUUOS,<

	PUSHJ	P,QUEWAT		;WAIT FOR A RETURNED MESSAGE
	ANDX	T1,IP.CFV		;CLEAR ALL BUT THE PAGE MODE BIT
	SETZB	T2,T3			;CLEAR THESE AGAIN
	HRRI	T4,(M)			;WHERE TO RECEIVE INTO
	TXNN	T1,IP.CFV		;IS IT A PAGE
	  JRST	RCVA.1			;NO, GO GET IT
	MOVE	M,.JBREL##		;GET A PAGE TO RECEIVE INTO
	MOVEI	M,777(M)		;ROUND UP
	ADR2PG	M			;CONVERT TO PAGE NUMBER
	HRRI	T4,(M)			;SET THE ADDRESS
	HRLI	T4,1000			;LENGTH OF A PAGE
	PG2ADR	M			;STILL NEED TO POINT TO IT
RCVA.1:	MOVE	S2,[4,,T1]		;READY TO GET IT
	IPCFR.	S2,			;GET THE ACK FROM QUASAR
	  FAIL(<ARF Acknowledgement Receive Failed>)

>  ;END OF IFN FTUUOS

IFN FTJSYS,<

	SETZB	T1,T2			;CLEAR FLAGS, SENDER
	MOVE	T3,MYPID		;RECEIVER
	HRLI	T4,FBAREA		;SIZE OF SHORT MESSAGE
	HRRI	T4,FBTEMP		;TEMPORARY BLOCK
	PUSH	P,S1			;SAVE USER AREA BASE
	MOVEI	S1,4			;FOUR WORDS
	MOVEI	S2,T1			;IN T1-T4
	MRECV				;RECEIVE THE ACK
	  FAIL(<ARF Acknowledgement Receive Failed>)
	POP	P,S1			;RESTORE USER BASE

>  ;END OF IFN FTJSYS

	LOAD	S2,TEX.ST(M)		;GET THE MESSAGE STATUS WORD
	TXNE	S2,TX.NMS		;NORMAL "ACK" (NO MESSAGE ASSOCIATED)
	  JRST	RCVA.3			;YES, SEE IF IT IS TIME TO RETURN
	TXNN	S2,TX.MOR		;FIRST OF MANY
	  JRST	RCVA.4			;NO, OUTPUT THE MESSAGE
	JRST	RCVACC			;THROW THIS AWAY


;FALL ONTO THE NEXT PAGE FOR THE OUTPUT OF THE MESSAGE RECEIVED
;HERE TO OUTPUT THE BODY OF THE ACK MESSAGE

RCVA.4:	MOVEI	T1,"["			;CHARACTER FOR INFORMATIONAL MESSAGES
	TXNN	S2,TX.FAT!TX.WRN	;FATAL OR WARNING
	  JRST	RCVA.2			;NEITHER, JUST REPORT THE TEXT
	MOVEI	T1,"?"			;FATAL CHARACTER
	TXNN	S2,TX.FAT		;WAS IT FATAL
	  MOVEI	T1,"%"			;NO, LOAD WARNING CHARACTER
	OUTCHR	T1			;OUTPUT THE "?" OR "%"
	OUTSTR	[ASCIZ/QSR/]		;OUTPUT "QUASAR" PREFIX
	LOAD	T1,TEX.ST(M),TX.SUF	;GET THE MESSAGE SUFFIX
	HRLZS	T1			;INTO THE OTHER SIDE FOR TTYSIX
	PUSHJ	P,TTYSIX		;OUTPUT THE FULL ERROR CODE
	MOVEI	T1," "			;GET ALIGNMENT CHARACTER
RCVA.2:	OUTCHR	T1			;MAKE THE OUTPUT PRETTY
	OUTSTR	TEX.MS(M)		;AND FINALLY, OUTPUT THE MESSAGE
	TXNN	S2,TX.FAT!TX.WRN	;ANOTHER CHECK
	  OUTCHR ["]"]			;GEE..IT TAKES A LOT TO DO NICE WORK
	PUSHJ	P,TTCRLF		;END THE MESSAGE
	TXNE	S2,TX.FAT		;AGAIN, WAS IT FATAL
	  JRST	FAIEXI			;YES, QUIT NOW
RCVA.3:	TXNE	S2,TX.MOR		;MORE COMING
	  JRST	RCVACC			;YES, DO THIS ALL OVER AGAIN
	JRST	CHKCOR			;CONTINUE PROCESSING
IFN FTUUOS,<

MSGSND:	SETO	T4,			;FLAG INDICATING FIRST TRY
MSGS.1:	MOVX	T3,%SIQSR		;GETTAB FOR PID OF [SYSTEM]QUASAR
	GETTAB	T3,			;SEE IF IT IS RUNNING
	  FAIL(<SGF SYSID. GETTAB failed>)
	MOVEM	T3,QSRPID		;REMEMBER QUASAR'S PID
	SETOM	RTYCNT			;INIT RETRY COUNTER
	JUMPN	T3,MSGGO		;THERE HE IS, SEND THE MESSAGE
	MOVEI	T3,3			;NOT UP YET, TRY A SLEEP
	SLEEP	T3,			;GIVE IT A CHANCE
	AOJN	T4,MSGS.1		;JUMP IF ALREADY GAVE A MESSAGE
	OUTSTR	[ASCIZ/
%QMRWFQ Waiting For [SYSTEM]QUASAR to Start
/]
	JRST	MSGS.1			;TRY NOW
MSGGO:	SETZB	T1,T2			;CLEAR FLAGS,MY PID
	MOVEI	T4,(M)			;MESSAGE ADDRESS, T3 = QSRPID
	LOAD	S2,.MSTYP(M),MS.CNT	;GET THE LENGTH OF THE MESSAGE
	TXNN	M,1B0			;IS THIS A PAGE MODE REQUEST
	  JRST	MSGGO1			;NO, SEND IT
	MOVX	T1,IP.CFV		;INDICATE A PAGE SEND
	LSH	T4,-^D9			;CONVERT 'M' TO A PAGE NUMBER
	MOVEI	S2,1000			;LENGTH MUST BE 1000
MSGGO1:	HRL	T4,S2			;INCLUDE CORRECT SIZE IN HEADER
MSGGO2:	MOVE	S2,[4,,T1]		;ARGUMENT FOR SEND
	IPCFS.	S2,			;SEND THE MESSAGE
	 SKIPA				;FAILED, SEE WHY
	  POPJ	P,			;RETURN TO CALLER
	CAIE	S2,IPCDD%		;QUASAR DISABLED
	 CAIN	S2,IPCRS%		;OR MY QUOTA EXHAUSTED
	  JRST	RETRY			;YES, TRY IT AGAIN
	CAIE	S2,IPCRR%		;QUASAR FULL
	 CAIN	S2,IPCRY%		;OR SYSTEM FULL
	  JRST	RETRY			;YES, TRY IT AGAIN
	FAIL1(<SQF Send to [SYSTEM]QUASAR failed>)
RETRY:	MOVEI	S2,2			;WAIT BEFORE TRYING AGAIN
	SLEEP	S2,			;TAKE A QUICK NAP
	AOSE	RTYCNT			;COUNT THE RETRIES
	  JRST	MSGGO2			;TRY NOW
	OUTSTR	[ASCIZ/
%QMRMBR Send has failed, Message Being Re-sent
/]
	JRST	MSGGO2			;NOW RETRY IT

>  ;END OF IFN FTUUOS
IFN FTJSYS,<

MSGSND:	SETO	T4,			;FLAG INDICATING FIRST TRY
	PUSH	P,S1			;SAVE USER BASE
MSGS.1:	MOVEI	S1,3			;NUMBER OF WORDS
	MOVEI	S2,T1			;USE T1-T3
	MOVEI	T1,.MURSP		;READ SYSTEM PID TABLE
	MOVX	T2,.SPQSR		;WANT PID OF SYSTEM QUASAR
	MUTIL				;READ THE TABLE
	  SETZ	T3,			;ASSUME IT CONTAINS AN INVALID PID
	MOVEM	T3,QSRPID		;REMEMBER QUASAR'S PID
	SETOM	RTYCNT			;INIT RETRY COUNTER
	JUMPN	T3,MSGGO		;JUMP IF QUASAR IS RUNNING
	MOVEI	S1,^D3000		;WAIT FOR IT
	DISMS				;TAKE A NAP
	AOJN	T4,MSGS.1		;JUMP IF ALREADY GAVE A MESSAGE
	OUTSTR	[ASCIZ/
%QMRWFQ Waiting For [SYSTEM]QUASAR to Start
/]
	JRST	MSGS.1			;TRY NOW
MSGGO:	SETZ	T1,			;ASSUME NO FLAGS
	SKIPN	T2,MYPID		;DO I HAVE A PID
	  TXO	T1,IP%CPD		;NO, CREATE ONE ON THIS SEND
	MOVEI	T4,(M)			;POINT TO THE MESSAGE
	LOAD	S2,.MSTYP(M),MS.CNT	;GET THE LENGTH OF THE MESSAGE
	TXNN	M,1B0			;IS THIS PAGED
	  JRST	MSGGO1			;NO, SEND IT
	TXO	T1,IP.CFV		;SET PAGE MODE FLAG
	LSH	T4,-^D9			;CONVERT ADDR TO A PAGE NUMBER
	MOVEI	S2,1000			;LENGTH OF A PAGE
MSGGO1:	HRL	T4,S2			;INCLUDE THE LENGTH
	MOVEI	S1,4			;FOUR WORDS
	MOVEI	S2,T1			;IN T1-T4
	MSEND				;SEND THE PACKET
	  JRST	MSGGO2			;FAILED, SEE WHY
	SKIPN	MYPID			;DO I ALREADY HAVE THE PID
	  MOVEM	T2,MYPID		;NO, SAVE IT
	POP	P,S1			;RESTORE S1
	POPJ	P,			;AND RETURN TO CALLER


;MORE OF THE TOPS20 VERSION ON THE NEXT PAGE
MSGGO2:	CAIE	S1,IPCFX6		;CHECK FOR EXHAUSTED QUOTAS
	 CAIN	S1,IPCFX7		;AND RETRY IF POSSIBLE
	  JRST	RETRY			;IS POSSIBLE
	CAIE	S1,IPCFX8		;ANOTHER RECOVERABLE ERROR
	 CAIN	S1,IPCFX5		;QUASAR DISABLED
	  JRST	RETRY			;YES, TRY AGAIN
	FAIL1(<SQF Send to [SYSTEM]QUASAR failed>)
RETRY:	SKIPN	MYPID			;DO I HAVE A PID
	  MOVEM	T2,MYPID		;NO, MAYBE THIS IS IT
	MOVEI	S1,^D2000		;WAIT BEFORE TRYING AGAIN
	DISMS				;WAIT
	AOSE	RTYCNT			;COUNT THE RETRIES
	  JRST	MSGGO			;TRY NOW
	OUTSTR	[ASCIZ/
%QMRMBR Send has failed, Message Being Re-sent
/]
	JRST	MSGGO			;AND TRY THE SEND AGAIN

>  ;END OF IFN FTJSYS
>	;END IFN FTGALAXY
	END