Google
 

Trailing-Edge - PDP-10 Archives - custsupcuspmar86_bb-x130b-sb - qmangr.mac
There are 29 other files named qmangr.mac in the archive. Click here to see a list.
	Title	QMANGR -- MPB interface to GALAXY

;
;
;        COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982,
;			 1983,1984,1985,1986
;                    DIGITAL EQUIPMENT CORPORATION
;			 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	GLXMAC
TOPS10<	SEARCH	UUOSYM >
TOPS20<	SEARCH	MONSYM >
	SEARCH	ORNMAC,QSRMAC	;GET WTO/QUEUE SYMBOLS

	INTERN	%%.QSR		;VERSION NUMBER OF QUASAR
	INTERN	%%.GLX		;VERSION NUMBER OF GLXMAC

	ENTRY	.QUEER		;CALLABLE ENTRY POINT
	ENTRY	QMANGR		;REAL EXTERNAL ENTRY POINT

	SALL			;CLEAN UP THE LISTING

QMAWHO==0	;LAST EDITOR
QMAVER==105	;VERSION OF QMANGR
QMAMIN==0	;MINOR VERSION NUMBER
QMAEDT==:2263	;EDIT NUMBER

	%%.QMA==VRSN.(QMA)


	LOC	137
	EXP	%%.QMA

	TWOSEG
	RELOC	400000

SUBTTL	TABLE OF CONTENTS

;               TABLE OF CONTENTS FOR QMANGR
;
;
;                        SECTION                                   PAGE
;    1. TABLE OF CONTENTS.........................................   2
;    2. Revision History..........................................   3
;    3. Queue Independent Header..................................   4
;    4. Input Queue Header Extension..............................   6
;    5. Output Queue Header Extension.............................   7
;    6. File Specification Block..................................   8
;    7. Filespec MODIFY Block.....................................   9
;    8. Paper Formats.............................................  10
;    9. Control, Log, and Output File Offsets.....................  11
;   10. Additional Macros.........................................  12
;   11. Entry and Exit Sections...................................  15
;   12. CREATE....................................................  17
;   13. KILL......................................................  23
;   14. MODIFY....................................................  24
;   15. LIST......................................................  27
;   16. DEFER & ZDEFER............................................  29
;   17. Subroutines...............................................  30
;   18. Data Storage..............................................  43
SUBTTL	Revision History

;	2000	This was the version sent with GALAXY-10 Field Test, June 1975.

;	2001	Always include /REPORT in the message to QUASAR
;		Initial code for File Specific Modifies
;		Require Queue Parameter area version 1 during Modify

;	2002	Remainder of File Specific Modifies
;		Insert code for DEFER & ZDEFER functions.
;			This sends the DEFER message to QUASAR-10.

;	2003	GALAXY-10 maintains /CORE in pages, MPB has it in words,
;			convert units is CREATE, LIST, and MODIFY.

;	2004	Become version 101

;	2005	Make a TOPS20 file string out of a TOPS10 name block
;		Re-arrange some of CREATE

;	2006	Provide Path spec (.EQPAT) only if TOPS10, INP: Queue

;	2007	Get Universal time correctly in CNVTIM

;	2010	Watch for TX.MOR on incoming TEXT Messages.
;		Ask for "ACK" on each send during CREATE.

;	2011	Include EQ.NBL in output requests, get it from QS.BLK.

;	2012	Default to DSK: in BLDFDA.
;		Ignore ACKs with TX.MOR set for everybody but QUEUE.

;	2013	Forgot to initialize a field to zeros in CREATE.
;		(Does very bad things when called by SPRINT)

;	2014	Search SBSMAC for new definitions.


;	2050	Make this version 102.  Understand queue format version 2.
;		Remove old MPB restriction of 5 character tags.
;		If not version 2 request, map /OUTPUT into new values.

;	2051	On -20 convert <blocks*copies> field to pages.

;	2052	Start converting CREATE and LIST to
;		version 2 format.

;	2053	If queue format version 2 on -20 and bit 15 is set in
;		Q.FMOD for a file, assume the filespec is a string.

;	2054	On -20, assume that Q.PPN contains address of
;		username string if queue format version 2.

;	2055	On -20 fill in .EQACT with the user's
;		account string.

;	2056	On -20 on CREATE,  if an AFTER parameter is specified,
;		decrement it by 1 hour if daylight savings is in effect [SPR 20-10018].

;	2057	Fix a bug in -20 BLDFDA.

;	2060	Make edit 2056 more general by allowing for time zones
;		and making it all work for /MODIFY also.

;	2061	Fix some problems with edit 2060.

;	2062	Make FTSPLIT work on the -20.

;	2063	ON -20, IF Q.PPN=0, don't try to move user name string.

;;First field-test release of GALAXY release 2, Jan, 1977

;	2064	Remove check for RDE bit in list routines.



;	2200	Make this version 104, April 1977.
;		Insert changes for new FP/FD.

;	2201	Fix a bug in the conversion for edit 2200.

;	2202	Add code to connect to private QUASAR if DEBUGW is non zero

;	2203	Remove file-specific modify code and put f-s parameters
;		into the queue-specific area (see QUASAR edit 206).

;	2204	Fix a minor problem with edit 2203.

;	2205	Use new values for /UNIQUE and /RESTART.

;	2206	Insert code for new CREATE and LIST formats.
;		The LIST function is no longer supported in an MPB
;		compatible format.  The caller is called with ac 1
;		pointing to the listanswer entry in QUASAR format.

;	2207	Move all the QPRM symbol definitions into QMANGR so that
;		QPRM does not have to be shipped with GALAXY.

;	2210	On a CREATE if Q.DEV contains 0,,adr assume that caller
;		has built a ROB at adr.

;	2211	Remove FTSPLIT conditional and all code until the IFN case.


;	2212	FIX BUG IN 10-BLDFDA

;	2213	Add /RDR support so that a user can put requests
;		into the SPRINT queue.

;	2214	Fix a /RDR bug that forced print requests with special
;		forms to default to FILE:COBOL.

;	2215	Add /NOTIFY code

;	2216	Add /REQUEST-ID code

;	2217	Change Debugging Send logic so that if 135 contains
;		a [P,PN] then we try to connect to [P,PN]QUASAR.
;		If 135 = -1, or left half of 135 is 0 then we try
;		to connect to a private QUASAR for this [P,PN].

;	2220	Add code to support batch log type and operator intrvn flag.
;		(switches /BATLOG & /OPRINT)

;	2221	Delete /DEADLINE support.

;	2222	Delete Q.CNO and replace it with Q.RID

;	2223	Add /DEADLINE for /MODIFY; Make it -1.

;	2224	Delete all the %FRRxx card reader formats and replace
;		them with the normal .FPINF codes

;	2225	Add Account String Support for the -10

;	2226	Add support for the /ACCOUNT switch from QUENCH.
;
;	2227	Make QMAEDT external so it can be added to other
;		modules version numbers
;
;	2230	Add Account Validation support to the DOACCT routine
;
;	2231	If no PPN is specified, GETPPN the users PPN and save in .EQOID
;		Add a PPN block to the account validation QUEUE. call
;
;	2232	Modify list routine to handle new LIST message format.
;
;	2233	Implement /DISPOSE:RENAME a little different
;
;	2234	Allow LIST/MODIFY of /DEST and /PROC
;
;	2235	/MODIFY/TAG:abcdef only passes a 5 character label. Old code
;		leftover from ancient MPB/Galaxy mangler must be cleaned up.
;
;	2236	Incorporate missing HOSS edit 2070 that gives more informative
;		error messages when IPCFR. UUOs fail.
;
;	2237	Incorporate missing HOSS edit 2072 that allows QMANGR to be
;		run execute-only.
;
;	2240	Remove definition of Q.ILM4 in limit words and move
;		/BATLOG value to QI.BLG in word Q.IDEP
;
;	2241	Make QMANGR work for null account strings
;
;	2242	If user specified account string is invalid, issue a
;		fatal error and don't create a queue request.
;
;	2243	Change RCVACK ACK typeout now that QUASAR can intermix
;		different types of messages (fatal, warning and comments).
;
;	2244	Allow /DISPOSE:RENAME for batch CTL and LOG files.
;
;	2245	Change HIBER UUO to wake only on IPCF packet available.
;
;	2246	Make /DESTINATION and /PROCESSING work correctly for all flavors
;		of queue listings.
;
;	2247	Don't request ACKs on queue list requests. We're gonna get
;		the list answer message back anyway. THis will cut the IPCF
;		traffic by 1/3 for list requests.
;
;	2250	Make the limits calculation take the spacing into account.
;		Now, DOUBLE and TRIPLE spacing will multiply the limits
;		accordingly.
;
;	2251	In MODIFY code, pass customer word on to QUASAR.
;
;	2252	Don't send .ORNOD block to QUASAR on list requests.  GCO 1417
;
;**; Begin Galaxy 4.1 code maintence
;
;	2253	QMANGR is trashing location 42 in job data area
;		because all references to SPCFCT are not indexed by AC E
;		SPR 10-33033	27-SEP-83/CTK
;
;	2254	QMANGR is not passing QUASAR the correct values
;		for the /OUTPUT: switch.
;		SPRS 10-33512,10-33492	5-MAR-84/CTK
;
;	2255	Add code to support modifing the /ASSIST switch.
;		If this patch is installed QUASAR edit 1214
;		is required or all modify  batch queue messages
;		will be rejected.
;		SPR 10-34294	GCO 10046	14-JUN-84/CTK
;
;	2256	Add ACK codes in messages sent to QUASAR so we can
;		keep in synch and not display text that's not expected.
;		SPR 10-34791	GCO 10059	26-Jul-84 /LWS
;
;	2257	Move COPYRIGHT macro after entry points. ASCIZ doesn't
;		execute very well.
;		GCO 10090 31-Aug-84 /LWS
;
;	2260	Implement /FONT and /GRAPHICS switches as part of
;		lase rprinter support.
;		15-Feb-85 GCO 10147 /NT
;
;	2261	Make sure FPXSIZ gets stored into FP lenght word if
;		/FONT is typed.
;		4-Mar-85 /NT
;
;	2262	Wrong test was being used to check for font file type in.
;		Change a SKIPE to a SKIPN.
;		11-Mar-85 /NT
;
;	2263	Move check for ACK code to after check for packet from
;		IPCC, otherwise can't use debugging feature.
;		18-Apr-85 GCO 10193 /JAD
; End of Revision History
SUBTTL	Queue Independent Header

	LOC 	0

Q.MEM::! BLOCK	1		;USED BY QMANGR
				;WHEN CALLED BY K-QUE,
				;  0-17 CONTAIN ADDRESS OF NEWLOG ROUTINE
				; 18-35 CONTAIN ADDRESS OF CHARACTER TYPER
				;Q.MEM IS NOT WRITTEN INTO THE .QUE FILE
Q.OPR::! BLOCK	1		;REQUEST INFORMATION
	QO.SCH==777777B17	;ADDRESS OF SCHEDULER OR LISTER ROUTINE
	QO.VER==77B23		;PARAMTER AREA FORMAT VERSION NUMBER
	QO.CSP==77B29		;REQUESTING CUSP
		%QOQUE==1	;QUEUE
		%QOCDK==2	;CDRSTK
		%QOBTN==3	;BATCON
		%QOSPL==4	;SPOOL
		%QOBSC==5	;BASIC
		%QOCPD==6	;COPYED
		%QOSPT==7	;SPRINT
		%QOFRS==10	;FOROTS
		%QOSPC==11	;SPACE
	QO.ROP==77B35		;REQUESTED OPERATION
		.QORCR==1	;CREATE
		.QORDF==2	;/DEFER
		.QORZD==3	;/ZDEFER
		.QORLS==4	;LIST
		.QORMD==5	;MODIFY
		.QORKL==6	;KILL
		.QORSC==7	;SCHEDULE
		.QORRL==10	;RELEASE
		.QORRQ==11	;REQEUE
		.QORDL==12	;FAST LIST
		.QORCP==13	;CHECKPOINT
		.QORNX==14	;NEXT-JOB (RELEASE AND SCHEDULE)
Q.LEN::! BLOCK	1		;BLOCK LENGTHS
	QL.HLN==777B8		;LENGTH OF HEADER
	QL.FLN==777B17		;LENGTH OF A FILE SPEC
	QL.NFL==777777		;NUMBER OF FILES
Q.DEV::! BLOCK	1		;GENERIC DESTINATION DEVICE
	QD.GDN==777777B17	;GENERIC DEVICE NAME
	QD.PDS==777777		;PHYSICAL DEVICE SPEC
				;0 IF GENERIC
				;1-77 IF STATION
				;1000-1777 IF PHYSICAL

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

Q.PPN::! BLOCK	1		;PPN OF USER
Q.JOB::! BLOCK	1		;JOB NAME
Q.SEQ::! BLOCK	1		;SEQUENCE NUMBER
Q.PRI::! BLOCK	1		;PRIORITY
				;;0-17 RESERVED TO CUSTOMER
	QP.PRO==777B26		;PROTECTION OF QUEUE REQUEST
	QP.NOT==1B27		;/NOTIFY BIT
				;;28-29 RESERVED TO DEC
	QP.PRI==77		;EXTERNAL PRIORITY

Q.PDEV::! BLOCK	1		;PROCESSING DEVICE
Q.TIME::! BLOCK	1		;START TIME OF JOB
Q.CREA::! BLOCK	1		;CREATION TIME OF JOB
Q.AFTR::! BLOCK	1		;AFTER PARAMETER
Q.FLAG::! BLOCK	1		;SECONDARY QMANGR PARM BLOCK ADDRESS
					;SEE DESCRIPTION BELOW...
Q.RID::! BLOCK	1		;REQUEST ID (USED IN /KILL or /MODIFY)
Q.USER::! BLOCK	2		;USERS NAME (2 WORDS)


;;On MODIFY request:
;;	Q.TIME contains PPN mask
;;	Q.CREA contains Job Name mask

	LOC	Q.TIME
Q.PPNM::! BLOCK	1

	LOC	Q.CREA
Q.JOBM::! BLOCK	1
SUBTTL	Input Queue Header Extension

	LOC	Q.USER+2

;;   !                         ---FORMAT OF Q.IDEP---                          !
;;   !-------------------------------------------------------------------------!
;;   !N !UNI !P!   ! OUT !                 !DMT!        DEPENDENCY             !
;;   !-------------------------------------------------------------------------!


Q.IDEP::! BLOCK	1		;DEPENDENCY WORD
	QI.NRS==1B0		;NO-RESTART BIT
	QI.UNI==3B2		;UNIQUENESS
		.QIUNO==0	;NO UNIQUENESS
		.QIUYS==1	;UNIQUE PPN
		.QIUSD==2	;UNIQUE SUB-DIRECTORY (SFD)
	QI.PAB==1B3		;PRE-ABORTTED OR ILLEGAL RESTART
	QI.MNR==1B3		;ON MODIFY, MODIFY QI.NRS
;**;[2255]ADD SYMBOL AT Q.IDEP:+7L	14-JUN-84/CTK
	QI.AST==3B5		;[2255]/ASSIST SWITCH
	QI.OUT==7B8		;/Z PARAMTER TO KJOB
		.QIONO==0	;/Z:0  NO AUTO-QUEUEING
		.QIOLG==1	;/Z:1  QUEUE THE LOG
		.QIOSP==2	;/Z:2  QUEUE ALL SPOOLED FILES AND LOG
		.QIOLS==3	;/Z:3  /Z:2 + *.LST
		.QIOAL==4	;/Z:4  /Z:3 + ALL DEFERED FILES
	QI.RDR==1B9		;/RDR WAS SPECIFIED
	QI.BLG==3B11		;/BATLOG:value
;**;[2255]ADD SYMBOL AT Q.IDEP:+15L	14-JUN-84/CTK
	QI.MNA==1B12		;[2255]ON MODIFY, MODIFY QI.AST
				;[2255]13-17 RESERVED TO DEC
	QI.DMT==3B19		;DEPENDENCY MODIFY TYPE
		.QIDAB==0	;ABSOLUTE
		.QIDPL==1	;PLUS (ADDITIVE)
		.QIDMI==2	;MINUS
		.QIDNM==3	;NO MODIFY
	QI.DEP==177777		;DEPENDENCY PARAMETER
Q.ILIM::! BLOCK	1		;CORE AND TIME LIMITS
	QM.COR==777777B17	;CORE LIMIT IN WORDS
	QM.TIM==777777		;CPU TIME LIMIT IN SECONDS
Q.ILM2::! BLOCK	1		;LPT AND CDP LIMITS
	QM.LPT==777777B17	;LPT LIMIT (PAGES)
	QM.CDP==777777		;CDP LIMIT (CARDS)
Q.ILM3::! BLOCK	1		;PTP AND PLT LIMITS
	QM.PTP==777777B17	;PTP LIMIT (FEET)
	QM.PLT==777777		;PLOT LIMIT (MINUTES)
Q.IDDI::! BLOCK	6		;FULL PATH TO DEFAULT DIRECTORY


	.QIHED==.-Q.OPR		;LENGTH OF INPUT QUEUE HEADER
SUBTTL	Output Queue Header Extension

	LOC	Q.USER+2

Q.OFRM::! BLOCK	1		;FORMS TYPE
Q.OSIZ::! BLOCK	1		;REQUEST SIZE
	QS.LIM==777777B17	;LIMIT
	QS.BLK==777777		;BLOCKS * COPIES (UNITS OF 8 BLOCKS)
Q.ONOT::! BLOCK	2		;ANNOTATION  (2 WORDS)


	.QOHED==.-Q.OPR		;LENGTH OF OUTPUT QUEUE HEADER
SUBTTL	File Specification Block

	LOC	0

Q.FSTR::! BLOCK	1		;FILE STRUCTURE
Q.FDIR::! BLOCK	6		;FULL PATH TO FILE
Q.FNAM::! BLOCK	1		;FILE NAME
Q.FEXT::! BLOCK	1		;EXTENSION
	QE.EXT==777777B17	;EXTENSION
				;;18-35 RESERVED TO CUSTOMER
Q.FRNM::! BLOCK	1		;RENAMED NAME (QUE::!.QUD[,])
Q.FBIT::! BLOCK	1		;START PARAMETER
	QB.APF==1B0		;ARTIFICIALLY PRESERVED FILE
	QB.TAG==7777777777	;6 CHARACTER (6BIT) TAG FOR BATCON
	QB.SLN==777777		;STARTING LINE NUMBER
				;THE OUTPUT SPOOLERS ALWAYS USE BITS
				; 18-35 AS A STARTING LINE NUMBER
				; IF BITS 6-11 ARE ZERO, BATCON USES
				; 18-35 AS A START LINE NUMBER, ELSE
				; 6-35 ARE A START TAG.


;;   !                         ---FORMAT OF Q.FMOD---                          !
;;   !-------------------------------------------------------------------------!
;;   !I !L !D!   !S!N!R!                   ! SPC ! PFM ! FFM ! DSP !  COPIES   !
;;   !-------------------------------------------------------------------------!


Q.FMOD::! BLOCK	1		;STATUS BITS
	QF.IRP==1B0		;INDIRECT REQUEST POINTER
	QF.LOG==1B1		;THIS IS THE LOG FILE
	QF.DEF==1B2		;FILE DOES NOT YET EXIST
				;;3 RESERVED TO DEC
	QF.SKP==1B4		;SKIP THIS FILE
	QF.NFH==1B5		;NO FILE HEADERS WANTED
	QF.RVC==1B6		;RESTARTED VIA CHKPNT OR REQUE
				;;7-17 RESERVED TO DEC
	QF.SPC==7B20		;SPACING CODE
	QF.PFM==7B23		;PAPER FORMAT (SEE SEPARATE SECTION)
	QF.FFM==7B26		;FILE FORMAT
		.QFFAS==1	;ASCII
		.QFFFO==2	;FORTRAN
		.QFFCO==3	;COBOL
		.QFFRU==5	;RUNOFF
		.QFF11==6	;ELEVEN (PDP-11 PAPER TAPE FORMAT)
	QF.DSP==7B29		;DISPOSITION
		.QFDPR==1	;PRESERVE
		.QFDRE==2	;RENAME
		.QFDDE==3	;DELETE
	QF.COP==77B35		;NUMBER OF COPIES
Q.FRPT::! BLOCK	2		;REPORT SPECIFICATION (2 WORDS)
Q.FONT::! BLOCK	FNMLTH		;FONT NAME IF ANY
SUBTTL	Filespec MODIFY Block

	LOC	0

;The filespec MODIFY block is tacked on the end  of
;the  filespec  during  a  modify  request.   It is
;defined  here  as  0-origin  since  it  may  start
;following  Q.FMOD or Q.FRPT+1 depending on whether
;it is queue format version 0 or 1.

Q.FDRM:!	BLOCK	6		;DIRECTORY MASK
Q.FNMM:!	BLOCK	1		;FILENAME MASK
Q.FEXM:!	BLOCK	1		;FILENAME EXTENSION MASK
	QF.EXM==777777B17	;FILENAME EXTENSION
				;;18-35 RESERVED TO CUSTOMER
Q.FMDM:!	BLOCK	1		;MODIFIER MASK
SUBTTL	Paper Formats

;The  PAPER FORMAT field consists of bits 21, 22, 23 of
;Q.FMOD.  This field is generated by the /PRINT, /PUNCH
;/PLOT, and /TAPE switches to QUEUE.


;PAPER FORMATS FOR LPT QUEUE (/PRINT)
	%QFLAR==1		;ARROW FORMAT
	%QFLAS==2		;ASCII FORMAT
	%QFLOC==3		;OCTAL FORMAT
	%QFLSU==4		;SUPPRESS FORMAT
	%QFGRF==5		;GRAPHICS FORMAT


;PAPER FORMATS FOR PTP QUEUE (/TAPE)
	%QFTAS==1		;ASCII FORMAT
	%QFTIM==2		;IMAGE FORMAT
	%QFTIB==3		;IMAGE BINARY FORMAT
	%QFTBI==4		;BINARY FORMAT


;PAPER FORMATS FOR CDP QUEUE (/PUNCH)
	%QFCAS==1		;ASCII FORMAT
	%QFCBC==2		;026 (BCD) FORMAT
	%QFCBI==3		;BINARY FORMAT
	%QFCIM==5		;IMAGE FORMAT


;PAPER FORMAT FOR PLT QUEUE  (/PLOT)
	%QFPIM==1		;IMAGE FORMAT
	%QFPAS==2		;ASCII FORMAT
	%QFPBI==3		;BINARY FORMAT


	DEFINE	INCR(A,B),<AOS A>
SUBTTL	Control, Log, and Output File Offsets

	LOC	.QIHED+1


;	CONTROL FILE OFFSETS

Q.CSTR::! BLOCK	1		;FILE-STRUCTURE
Q.CDIR::! BLOCK	6		;DIRECTORY
Q.CNAM::! BLOCK	1		;FILE NAME
Q.CEXT::! BLOCK	1		;EXTENSION
Q.CRNM::! BLOCK	1		;RENAMED NAME
Q.CBIT::! BLOCK	1		;START PARAMETER
Q.CMOD::! BLOCK	1		;STATUS BITS



;	LOG FILE OFFSETS

Q.LSTR::! BLOCK	1		;FILE STRUCTURE
Q.LDIR::! BLOCK	6		;DIRECTORY
Q.LNAM::! BLOCK	1		;FILENAME
Q.LEXT::! BLOCK	1		;EXTENSION
Q.LRNM::! BLOCK	1		;RENAMED NAME
Q.LBIT::! BLOCK	1		;START PARAMETER
Q.LMOD::! BLOCK	1		;STATUS BITS



;	OFFSETS FOR FIRST FILE IN AN OUTPUT REQUEST

	LOC	.QOHED+1

Q.OSTR::! BLOCK	1		;FILE STRUCTURE
Q.ODIR::! BLOCK	6		;DIRECTORY
Q.ONAM::! BLOCK	1		;FILE NAME
Q.OEXT::! BLOCK	1		;EXTENSION
Q.ORNM::! BLOCK	1		;RENAMED NAME
Q.OBIT::! BLOCK	1		;START PARAMETER
Q.OMOD::! BLOCK	1		;STATUS BITS


	RELOC			;BACK TO REGULAR COUNTING
SUBTTL	Additional Macros


	;SECONDARY QMANGR ARG BLOCK DESRCIPTION

		LOC	0
.LSTYP:! BLOCK 1		;FIRST WROD IS /LIST FLAG BITS
.LSDES:! BLOCK	1		;LIST DESTINATION NODE
.LSPRC:! BLOCK	1		;LIST PROCESSING NODE
.ACCTS:! BLOCK 10		;ASCIZ ACCOUNT STRING (MAX 39 CHARS)
.ROBLK:! BLOCK ROBSIZ		;REQUESTED OBJECT BLOCK
.DNODE:! BLOCK	1		;/DESTINATION NODE BLOCK
.AG2LN:!			;BLOCK LENGTH
		RELOC


;	MACRO TO ACQUIRE SPACE  --  GCORE  words

DEFINE	GCORE(WORDS)<
	MOVEI	T1,WORDS
	XLIST
	PUSHJ	P,CORGET
	LIST
	SALL
>  ;END OF DEFINE GCORE



;	MACRO TO PRINT OUT AND BOMB OUT (SKIPABLE)

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



;	MACRO TO MOVE DATA AROUND  -- WIPES TF

DEFINE	DATAM(SWRD,SFIELD,DWRD,DFIELD)<
	LOAD(TF,SWRD,SFIELD)
	XLIST
	STORE(TF,DWRD,DFIELD)
	LIST
	SALL
>  ;END OF DEFINE DATAM
;	MACRO TO CHECK FIELD IN "T1" FOR CHANGE BITS, ADJUSTS IT

DEFINE	CKCHNG(FIELD),<
	ANDX(T1,FIELD)
	XLIST
	CAXN(T1,FIELD)
	 TDOA	T1,[-1]
	  LOAD(T1,T1,FIELD)
	LIST
	SALL
>  ;END OF DEFINE CHCHNG



;	MACRO TO CHECK FILE BITS IN MODIFY.
;	SETS T1 = THE NEW VALUE OR -1 IF NO CHANGE
;	EXPECTS T2 = THE FILE BLOCK AND T3 = THE MODIFY BLOCK

DEFINE	MODCHG(FIELD),<
	MOVE	T1,Q.FMDM(T3)
	XLIST
	TXNN(T1,FIELD)
	 TDOA	T1,[-1]
	  LOAD(T1,Q.FMOD(T2),FIELD)
	LIST
	SALL
>  ;END OF DEFINE MODCHG



;	MACRO TO MOVE A WORD DIRECTLY INTO THE MODIFY MESSAGE USING GRPSTO

DEFINE	MOVWRD(WORD),<
	MOVE	T1,WORD
	XLIST
	PUSHJ	P,GRPSTO
	LIST
	SALL
>  ;END OF DEFINE MOVWRD



;	MACRO TO STORE A CHARACTER INTO THE FD STRING USING T1 & T3

DEFINE	STCHR(CHR),<
	MOVEI	T1,CHR
	XLIST
	IDPB	T1,T3
	LIST
	SALL
>  ;END OF DEFINE STCHR
DEFINE DEVICE,<
	X	LPT,.OTLPT,LIQLPT
	X	LL,.OTLPT,LIQLPT
	X	LU,.OTLPT,LIQLPT
	X	PTP,.OTPTP,LIQPTP
	X	CDP,.OTCDP,LIQCDP
	X	PLT,.OTPLT,LIQPLT
	X	INP,.OTBAT,LIQBAT
>  ;END DEFINE DEVICE


	DEFINE	TTYCHR(AC),<
	TOPS10 <OUTCHR AC>
	TOPS20 <PUSH  P,1
	XLIST
		MOVE 1,AC
		PBOUT
		POP P,1>
	LIST>

	DEFINE	TTYSTR(STR),<
	TOPS10 <OUTSTR STR>
	TOPS20 <PUSH P,1
	XLIST
		HRROI 1,STR
		PSOUT
		POP  P,1 >
	LIST>

	PORTAL	QMANGR			;MAKE IT CALLABLE
	PORTAL	QMANGR			;ENTRY PLUS 1
;**;[2257] Put COPYRIGHT macro after entry points. /LWS
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1971,1986.
ALL RIGHTS RESERVED.
\;END OF COPYRIGHT MACRO

DEFINE X(A,B,C),<
	SIXBIT	/A/
>  ;END DEFINE X
DEVTAB:	DEVICE
	NDEVS==.-DEVTAB

DEFINE X(A,B,C),<
	EXP	B
>  ;END DEFINE X
OBJTAB:	DEVICE

DEFINE X(A,B,C),<
	EXP	C
>  ;END DEFINE X
LIQTAB:	DEVICE
;**;[2256] Add definitions for user ACK code fields. /LWS

	ACK.NT==400000,,0		;[2256] Mask for /NOTIFY
	ACK.JB==377400,,0		;[2256] Mask for job number
	ACK.UT==377,,777777		;[2256] Mask for UDT bits

SUBTTL	Entry and Exit Sections

QMANGR:	PUSH	P,.JBFF##		;SAVE ORIGINAL .JBFF
	MOVE	E,.JBFF##		;GET BASE FOR TEMP STORAGE
	GCORE	E.LEN			;GET REQUIRED CORE
	SETZM	MYPID(E)		;CLEAR A WORD
	LDB	T1,[POINT ^D14,S1,^D17]	;GET SIZE OF CALLERS PARAMETER AREA
	CAIG	T1,.QOHED		;MUST BE AT LEAST THIS LONG
	  FAIL(<PTS Parameter area is too short>)

IFN FTUUOS,<
	PUSHJ	P,QUEFLS		;FLUSH THE RECEIVE QUEUE FIRST
>  ;END OF IFN FTUUOS

	PUSHJ	P,GQPID			;GET QUASAR'S PID
	LOAD	T1,Q.OPR(S1),QO.VER	;GET QUEUE FORMAT VERSION
	CAILE	T1,2			;LESS THAN  2?
	  FAIL(<IQF Illegal Queue Format Version>)
	SOS	T1			;MAKE RANGE -1 TO 1
	MOVEM	T1,FORVER(E)		;AND SAVE IT
;**;[2256] Insert 1 line after QMANGR+17L /LWS
	PUSHJ	P,BLDACK		;[2256] GO BUILD AN ACK CODE

IFN FTJSYS,<
	SKIPG	S2,Q.AFTR(S1)		;SEE IF ANY /AFTER
	JRST	QMAN.1			;NONE, CONTINUE ON
	PUSH	P,S1			;SAVE S1
	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 THE ERROR
	POP	P,S1			;RESTORE S1
	MOVEM	S2,Q.AFTR(S1)		;SAVE THE TIME
QMAN.1:
>  ;END IFN FTJSYS

	LOAD	T1,Q.OPR(S1),QO.ROP	;GET REQUEST CODE
	CAIE	T1,.QORLS		;LIST
	 CAIN	T1,.QORDL		;OR FAST LIST
	  JRST	LISTEM			;GO LIST THE QUEUES
	CAIN	T1,.QORCR		;CREATE
	  JRST	CREATE			;YES, DO CREATE
	CAIN	T1,.QORKL		;KILL
	  JRST	KILL			;YES, DO THE KILL MESSAGE
	CAIN	T1,.QORMD		;MODIFY
	  JRST	MODIFY			;YES, DO THE MODIFY MESSAGE
	CAIN	T1,.QORDF		;DEFER RELEASE
	  JRST	DEFER			;YES, RELEASE /DEFER FILES
	CAIN	T1,.QORZD		;DEFER KILL
	  JRST	ZDEFER			;YES, KILL THEM
	FAIL1(<ATR Attempt To Run an MPB Cusp on a GALAXY System>)
GETACK:	PUSHJ	P,RCVACK		;HERE TO GET ACKNOWLEDGEMENT FIRST
QMRXIT:

IFN FTJSYS,<
	SKIPN	T2,MYPID(E)		;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
>  ;END OF IFN FTJSYS

QMRX.1:	POP	P,.JBFF##		;RESTORE ORIGINAL .JBFF
	MOVE	T1,.JBFF##		;GET THE VALUE
	SUBI	T1,1			;BACK OFF FOR THE CORE UUO
	CORE	T1,			;GIVE SOME BACK
	  JFCL				;NICE TRY
	POPJ	P,			;RETURN TO CALLER


; THIS QMANGR CAN BE LOADED WITH A PROGRAM THAT CALLS .QUEER (QUEUER)
;	AS QUEUE DOES.  IF SO, THEN PROVIDE OUR OWN .QUEER ENTRY TO
;	SAVE ALL THE REQS BUT AVOID ALL THE GETSEG'S THAT GO ON

.QUEER:: MOVEM	16,RSA+16		;SAVE AC 16
	MOVEI	16,RSA			;SOURCE = AC0, DESTIN = RSA
	BLT	16,RSA+15		;SAVE 0-15 AS WELL
	PUSHJ	P,QMANGR		;CALL THE REGULAR ENTRY POINT
	MOVSI	16,RSA			;SOURCE = RSA, DESTIN = AC0
	BLT	16,16			;RESTORE 0-16
	POPJ	P,			;RETURN TO CALLER
SUBTTL CREATE

CREATE:	LOAD	H,Q.LEN(S1),QL.HLN	;GET LENGTH OF HEADER
	CAIGE	H,.QOHED		;GOT TO BE THAT BIG
	  FAIL(<HTS Header too short>)
	LOAD	T1,Q.LEN(S1),QL.FLN	;GET LENGTH OF FILE SPECS
	CAIGE	T1,Q.FRPT		;MUST BE AT LEAST THIS LONG
	  FAIL(<ETS Entry Too Short>)
	LOAD	M,Q.DEV(S1),QD.GDN	;GET QUEUE INVOLVED
	CAIE	M,'INP'			;THE INPUT QUEUE
	 TDZA	M,M			;NO, GET A 0 BIT
	  MOVEI	M,1			;YES, GET A 1 BIT
	CAIN	H,.QIHED		;NOW FOR A CONSISTENCY CHACK
	  TRC	M,1			;FLIP THE BIT
	JUMPN	M,E.ILNS		;IF ENDED UP 1, BAD LENGTHS
	MOVE	M,.JBFF##		;CREATE MESSAGES ARE PAGE MODE SO
	MOVEI	M,777(M)		;ALIGN .JBFF ON A PAGE BOUNDRY
	TRZ	M,777			;MAKE IT SO
	MOVEM	M,.JBFF##		;FAKE OUT CORGET
	SETZM	FSTMSG(E)		;CLEAR ADDRESS OF FIRST MESSAGE
	SETZM	NUMANS(E)		;AND NUMBER OF CREATES TO SEND
	LOAD	P4,Q.LEN(S1),QL.NFL	;P4 = NUMBER OF FILES
	JUMPE	P4,E.NOFI		;ERROR IF NONE
	MOVEI	P1,(H)			;COMPUTE FIRST FILE
	ADDI	P1,1(S1)		;P1 = FIRST FILE BLOCK
	LOAD	P2,Q.LEN(S1),QL.FLN	;P2 = SIZE OF MPB FILE BLOCK
CREA.1:	SKIPE	FSTMSG(E)		;FIRST TIME THROUGH
	 CAMGE	P1,FSTMSG(E)		;NO, SEE IF BEYOND REASONABLE BOUNDS
	  SKIPA				;OK SO FAR
	   FAIL(<IAL Impossible Argument Lengths Specified>)
	MOVEI	S2,FBTEMP(E)		;BUILD IN TEMP AREA
	ZERO	.FPINF(S2)		;MAKE SURE UNUSED FIELDS ARE ZERO
	MOVEI	T1,FPMSIZ		;ASSUME SMALL FILE PARMS
	DATAM	Q.FMOD(P1),QF.FFM,.FPINF(S2),FP.FFF
	DATAM	Q.FMOD(P1),QF.PFM,.FPINF(S2),FP.FPF
	DATAM	Q.FMOD(P1),QF.SPC,.FPINF(S2),FP.FSP
;**;[2253]CHANGE 1 LINE AT CREA.1:+10L	27-SEP-83/CTK
	MOVEM	TF,SPCFCT(E)		;[2253] Save the spacing factor
	DATAM	Q.FMOD(P1),QF.LOG,.FPINF(S2),FP.FLG
	DATAM	Q.FMOD(P1),QF.COP,.FPINF(S2),FP.FCY
	LOAD	TF,Q.FMOD(P1),QF.NFH	;GET THE FILE HEADER BIT
	SETCA	TF,			;FLIP
	STORE	TF,.FPINF(S2),FP.NFH
	LOAD	TF,Q.FMOD(P1),QF.DSP	;GET THE /DISP: VALUE
	CAIE	TF,.QFDDE		;WAS IT DELETE
	 TDZA	TF,TF			;NO, ZERO TEMP AND SKIP
	  MOVEI	TF,1			;YES, GET A BIT
	STORE	TF,.FPINF(S2),FP.DEL	;SET THE DELETE BIT CORRECTLY
	MOVE	TF,Q.FBIT(P1)		;GET THE STARTING POINT
	SKIPLE	FORVER(E)		;SKIP IF QFV IS 0 OR 1
	JRST	CREA.2			;QFV=2 MEANS ALLOW 6 CHARS
	TLNE	TF,007777		;A TAG OR A NUMBER
	  LSH	TF,6			;A TAG, POSITION IT LEFT
CREA.2:	MOVEM	TF,.FPFST(S2)		;STORE FOR SPOOLER
	SETZB	T2,T3			;/REPORT = 0
	CAIL	P2,Q.FRPT+2		;/REPORT SPECIFIED
	  DMOVE	T2,Q.FRPT(P1)		;YES, GET VALUE INSTEAD
	DMOVEM	T2,.FPFR1(S2)		;STORE THE CORRECT VALUE OF /REPORT
	SKIPN	Q.FONT(P1)		;User sppecified a font?
	 JRST	CRE.31			;No, don't bother storing it
	HRLI	TF,Q.FONT(P1)		;Get the address of possible font name
	HRRI	TF,.FPFNM(S2)		;And where to store it
	BLT	TF,.FPFNM+FNMLTH-1(S2)	;Store it away in the entry
	MOVEI	T1,FPXSIZ		;Get larger FP size
	STORE	T1,.FPLEN(S2),FP.LEN	;Store this new lenght
CRE.31:	LOAD	TF,Q.FMOD(P1),QF.DSP	;GET DISPOSITION AGAIN
	CAIE	TF,.QFDRE		;/DISPOSE:RENAME ?
	  JRST	CRE.2A			;NO TO EITHER
	MOVX	TF,FP.REN		;GET RENAME BIT
	IORM	TF,.FPINF(S2)		;SET IT FOR QUASAR

CRE.2A:	ADDI	S2,(T1)			;NOW FOR THE FILE DESCRIPTOR
	STORE	T1,FBTEMP+.FPLEN(E),FP.LEN  ;STORE SIZE OF PARAMETERS
	PUSHJ	P,BLDFDA		;BUILD A PROPER FD AREA
	LOAD	P3,FBTEMP+.FPLEN(E),FP.LEN  ;FP AREA LENGTH
	LOAD	S2,.FDLEN(S2),FD.LEN	;GET LEN OF THE FD
	ADDI	P3,(S2)			;P3 = LENGTH OF AREA TO INCLUDE
	MOVE	T4,CURSTR(E)		;GET STRUCTURE FOR THIS FILE
	MOVE	M,FSTMSG(E)		;NOW FIND A MATCHING REQUEST
	MOVE	T1,NUMANS(E)		;NUMBER CURRENTLY BUILT
	JUMPE	T1,CREA.5		;NONE, BUILD PROTOTYPE REQUEST
	CAIN	H,.QIHED		;AN INPUT REQUEST
	  JRST	CREINC			;YES, CANNOT SPLIT THOSE
CREA.3:	LOAD	T2,.MSTYP(M),MS.CNT	;CHECK FOR PAGE OVERFLOW
	ADDI	T2,(P3)			;SIZE IF I INCLUDE THIS FILE
	CAIG	T2,1000			;OVER A PAGE BOUNDRY
	  JRST	CREINC			;NO, INCLUDE THIS FILE
CREA.4:	ADDI	M,1000			;POINT TO THE NEXT MESSAGE
	SOJG	T1,CREA.3		;LOOK AT THE NEXT IF THERE IS ONE
CREA.5:	MOVE	M,.JBFF##		;GET ADDRESS OF A NEW MESSAGE
	GCORE	1000			;GET A PAGE FOR IT
	SKIPN	FSTMSG(E)		;THIS THE FIRST ONE
	  MOVEM	M,FSTMSG(E)		;YES, SAVE ITS ADDRESS
	INCR	NUMANS(E)		;ACCOUNT FOR IT
	SETZM	(M)			;CLEAR THE NEW MESSAGE FIRST
	HRLI	T1,(M)			;SET UP FOR EVENTUAL BLT
	HRRI	T1,1(M)			;DESTINATION
	BLT	T1,777(M)		;GET IT ALL
	STORE	T4,.EQLEN(M)		;SAVE STRUCTURE IN LENGTHS WORD FOR NOW
	MOVX	T1,EQHSIZ		;SIZE WITHOUT PATH (OUTPUT QUEUES)
	MOVEM	T1,LENHDR(E)		;SAVE FOR LATER
	STORE	T1,.MSTYP(M),MS.CNT	;AND AS INITIAL MESSAGE LENGTH
	MOVX	T1,.QOCRE		;FUNCTION CREATE
	STORE	T1,.MSTYP(M),MS.TYP	;AS MESSAGE TYPE

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	MOVE	T1,Q.FLAG(S1)		;PICK UP SECONDARY PARM BLOCK ADDRESS
	TRNE	T1,-1			;ADDRESS MUST BE IN LEFT HALF !!
	 FAIL	(<DPO /DEADLINE Parameter is Obsolete>)
	JUMPN	T1,CRE.5B		;IF THERE,,WE ALREADY HAVE AN ROB
	PUSHJ	P,GETOBJ		;FIND THE OBJECT
	STORE	T1,.EQROB+.ROBTY(M)	;STORE OBJECT TYPE
	CAIN	T1,.OTBAT		;WAS IN A BATCH JOB?
	JRST	CREA.8			;YES, SKIP THIS STUFF
	HLRZ	T1,Q.DEV(S1)		;GET THE DEVICE BACK
	MOVEI	T2,0			;GET SOME ATTRIBUTES
	CAIN	T1,'LL '		;IS IT LL?
	MOVX	T2,%LOWER		;YES,,LOAD LOWER CASE
	CAIN	T1,'LU '		;OR LU?
	MOVX	T2,%UPPER		;YES,,LOAD UPPER CASE
	STORE	T2,.EQROB+.ROBAT(M),RO.ATR ;STORE IT

TOPS10<	HRROI	T2,.GTLOC		;SETUP TO GET MY LOCATION
	GETTAB	T2,			;GET IT
	  MOVEI	T2,0			;LOSE
	MOVE	T1,Q.DEV(S1)		;GET DEVICE ONCE AGAIN
	LDB	T3,[POINT 6,T1,23]	;GET THE 4TH DIGIT
	LDB	T4,[POINT 6,T1,29]	;GET THE 5TH DIGIT
	SUBI	T3,'0'			;MAKE IT BINARY
	SUBI	T4,'0'			;BOTH OF THEM
	IMULI	T3,10			;AND START BUILDING AN OCTAL NUMBER
	ADD	T3,T4			;FINISH THE PROCESS
	TXNE	T1,7700			;WAS THERE A NODE NUMBER THERE?
	MOVE	T2,T3			;YES, USE IT
	STORE	T2,.EQROB+.ROBND(M)	;STORE IT
	MOVE	T1,Q.DEV(S1)		;GET DEVICE ONCE MORE
	LDB	T2,[POINT 6,T1,35]	;GET THE 6TH CHAR
	TXNN	T1,7700			;IS THERE A NODE FIELD?
	LDB	T2,[POINT 6,T1,23]	;NO, GET 4TH DIGIT
	JUMPE	T2,CREA.8		;GO IF NO UNIT
	SUBI	T2,'0'			;ELSE, GET A UNIT
	TXO	T2,RO.PHY		;SET PHYSICAL UNIT BIT
	STORE	T2,.EQROB+.ROBAT(M)	;AND STORE UNIT NUMBER
	JRST	CREA.8			;AND CONTINUE ON
> ;END TOPS10 CONDITIONAL

TOPS20<	SETOM	S1			;WANT THIS JOB
	HRROI	S2,T2			;POINT TO BYTE POINTER
	MOVX	T1,.JILLO		;WANT THIS JOBS LOCATION
	HRROI	T2,T3			;GEN BYTE POINTER
	GETJI				;GET THE LOCATION
	 SETZM	T3			;SHOULD NOT HAPPEN
	MOVE	S1,[POINT 6,.EQROB+.ROBND(M)] ;GET OUTPUT BYTE POINTER
	MOVE	S2,[POINT 7,T3]		;GET INPUT BYTE POINTER
CRE.5A:	ILDB	T1,S2			;GET AN ASCII BYTE
	JUMPE	T1,CREA.8		;NO MORE,,CONTINUE ONWARD
	SUBI	T1,40			;CONVERT TO SIXBIT
	IDPB	T1,S2			;SAVE IT AWAY
	JRST	CRE.5A			;CONVERT ANOTHER BYTE
> ;END TOPS20 CONDITIONAL

CRE.5B:	HLRZ	T1,Q.FLAG(S1)		;GET THE SECONDARY ARG BLOCK ADDRESS
	MOVSI	T1,.ROBLK(T1)		;GET SOURCE ROB,,0
	HRRI	T1,.EQROB(M)		;GET SOURCE,,DESTINATION
	BLT	T1,.EQROB+ROBSIZ-1(M)	;AND MOVE THE ROB
	JRST	CREA.8			;AND CONTINUE
IFN FTUUOS,<
CREA.8:	SKIPN	T1,Q.PPN(S1)		;ANY PPN SPECIFIED ???
	GETPPN	T1,			;NO,,GET OURS
	JFCL				;IGNORE THIS RETURN
	MOVEM	T1,.EQOID(M)		;AND MOVE IT INTO THE EQ
>  ;END IFN FTUUOS

IFN FTJSYS,<
CREA.8:	MOVS	T1,Q.PPN(S1)		;GET SOURCE,,0
	JUMPE	T1,CREA.7		;JUMP IF NO USER OR PPN
	HRRI	T1,.EQOWN(M)		;GET SOURCE,,DEST
	SKIPLE	FORVER(E)		;IF ITS QFV2
	BLT	T1,.EQOWN+7(M)		;THEN BLT IT
>  ;END IFN FTJSYS
CREA.7:	PUSHJ	P,DOACCT		;FILL IN ACCOUNT STRING
	DATAM	Q.JOB(S1),,.EQJOB(M)
	DATAM	Q.SEQ(S1),,.EQSEQ(M),EQ.SEQ
	DATAM	Q.PRI(S1),QP.PRO,.EQSPC(M),EQ.PRO
	DATAM	Q.PRI(S1),QP.PRI,.EQSEQ(M),EQ.PRI
	DATAM	Q.PRI(S1),QP.NOT,.EQSEQ(M),EQ.NOT
	DATAM	Q.AFTR(S1),,.EQAFT(M)	;MOVE THE AFTER PARAMETER
IFN FTUUOS,<
	DATAM	Q.USER(S1),,.EQOWN(M)
	DATAM	Q.USER+1(S1),,.EQOWN+1(M)
>  ;END IFN FTUUOS
	DATAM	Q.IDEP(S1),,.EQLIM(M)	;Store first limit word
	DATAM	Q.ILIM(S1),,.EQLIM+1(M)
	DATAM	Q.ILM2(S1),,.EQLIM+2(M)
	DATAM	Q.ILM3(S1),,.EQLIM+3(M)
	CAIE	H,.QIHED		;INPUT REQUEST
	  JRST	CREA.6			;NO, SKIP COPYING IT

IFN FTUUOS,<
	MOVX	T1,.EQPSZ		;SIZE WHEN PATH IS INCLUDED
	STORE	T1,.MSTYP(M),MS.CNT	;THAT IS INITIAL MESSAE LENGTH
	MOVEM	T1,LENHDR(E)		;SAVE FOR LATER
	HRLI	T1,Q.IDDI(S1)		;SOURCE
	HRRI	T1,.EQPAT(M)		;DESTINATION
	BLT	T1,.EQPAT+5(M)		;MOVE THE WHOLE PATH
	MOVE	T1,Q.FLAG(S1)		;PICK UP SECONDARY PARM BLOCK ADDRESS
	JUMPE	T1,CRE.7A		;NOT THERE,,TRY SOMETHING ELSE
	TRNE	T1,-1			;ADDRESS MUST BE IN LEFT HALF !!
	 FAIL	(<DPO /DEADLINE Parameter is Obsolete>)
	MOVSS	T1			;GET ADDRESS IN RIGHT HALF
	MOVE	T1,.DNODE(T1)		;GET THE /DESTINATION NODE
	CAMN	T1,[-1]			;IS THERE ONE THERE ???
	SETZM	T1			;NO,,MAKE IT ZERO
CRE.7A:	MOVEM	T1,.EQLIM+4(M)		;STORE IT
	JUMPN	T1,CRE.7B		;IF SET,,CONTINUE ONWARD
	HRROI	T1,.GTLOC		;NOT SPECIFIED,,DEFAULT
	GETTAB	T1,			;   TO THE USERS
	  MOVEI	T1,0			;      LOCATION...
	MOVEM	T1,.EQLIM+4(M)		;STORE IT
>  ;END OF IFN FTUUOS

CRE.7B:	LOAD	T1,Q.IDEP(S1),QI.UNI	;GET /UNIQUE
	STOLIM	T1,.EQLIM(M),UNIQ	;AND STORE AWAY
	LOAD	T1,Q.IDEP(S1),QI.BLG	;GET /BATLOG:xxx
	STOLIM	T1,.EQLIM(M),BLOG	;AND STORE AWAY
	SETZM	T1
	STOLIM	T1,.EQLIM(M),BSPR	;CLEAR SPARE BITS
	LOAD	T1,Q.IDEP(S1),QI.NRS	;GET THE "OLD" NO-RESTART BIT
	MOVX	T2,%EQRNO		;ASSUME /REST:NO
	SKIPN	T1			;WAS BIT SET?
	MOVX	T2,%EQRYE		;NO, SO ITS /REST:YES
	STOLIM	T2,.EQLIM(M),REST	;AND STORE IT
	LOAD	T1,Q.ILIM(S1),QM.COR	;GET /CORE:words
	ADDI	T1,777			;ROUND UP TO A PAGE BOUNDRY
	ADR2PG	T1			;CONVERT TO PAGES
	STOLIM	T1,.EQLIM(M),CORE	;STORE /CORE:pages
;**;[2254]REVAMP CODE AT CRE.7B:+15L	5-MAR-84/CTK
	SKIPG	FORVER(E)		;[2254]SKIP IF QFV= 0 OR 1
	JRST	CREINC			;SKIP THE OUTPUT QUEUE STUFF
	LOAD	T1,Q.IDEP(S1),QI.OUT	;GET /OUTPUT
	STOLIM	T1,.EQLIM(M),OUTP	;[2254]AND STORE THE VALUE
	JRST	CREINC			;SKIP LIMIT CALC IF INPUT QUEUE

CREA.6:	LOAD	T1,Q.ILIM(S1),QS.LIM	;GET OUTPUT LIMIT
;**;[2253]CHANGE 2 LINE AT CREA.6:+1L	27-SEP-83/CTK
	SKIPLE	SPCFCT(E)		;[2253] Do we have abnormal spacing?
	 IMUL	T1,SPCFCT(E)		;[2253] Yes, Multiply the limit by it
	STOLIM	T1,.EQLIM(M),OLIM	;AND STORE IT
	LOAD	T1,Q.ILIM(S1),QS.BLK	;GET NUMBER OF BLOCKS * COPIES
IFN FTJSYS,<
	ADDI	T1,3			;ROUND UP TO A PAGE
	LSH	T1,-2			;AND DIVIDE
>  ;END IFN FTJSYS
	STOLIM	T1,.EQLIM(M),NBLK	;STORE FOR QUASAR

; FALL INTO INCLUDE THIS FILE ROUTINE
;CONTINUE WITH REQUEST CREATION

CREINC:	INCR	.EQSPC(M),EQ.NUM	;BUMP NR. FILES IN REQUEST
	LOAD	T1,.MSTYP(M),MS.CNT	;GET CURRENT SIZE
	MOVE	T2,T1			;MAKE A COPY
	ADDI	T1,(M)			;T1 = LOCATION OF THIS FILE IN NEW REQUEST
	HRLI	T1,FBTEMP(E)		;INCLUDE SOURCE FOR BLT BELOW
	ADDI	T2,(P3)			;T2 = LENGTH INCLUDING THIS FILE
	STORE	T2,.MSTYP(M),MS.CNT	;STORE NEW LENGTH
	ADDI	T2,-1(M)		;T2 = LAST LOC OF BLT
	BLT	T1,(T2)			;MOVE THE BLOCK INTO THE REQUEST
	ADDI	P1,(P2)			;POINT TO NEXT MPB FILE SPEC
	SOJG	P4,CREA.1		;GET THEM ALL

;FALL INTO SEND LOOP AFTER PROCESSING ALL THE FILES IN THE MPB REQUEST

CRESND:	SKIPN	NUMANS(E)		;ALL SENT YET
	  JRST	QMRXIT			;YES, RETURN TO CALLER
	MOVE	M,FSTMSG(E)		;GET FIRST MESSAGE ADDRESS
	MOVEI	T1,1000(M)		;THE NEXT ONE
	MOVEM	T1,FSTMSG(E)		;SAVE FOR NEXT GO AROUND
	DECR	NUMANS(E)		;ONE LESS TO SEND
	MOVX	TF,MF.ACK		;GET FLAG FOR ACKNOWLEDGMENT
	MOVEM	TF,.MSFLG(M)		;AND SET IT
	MOVX	TF,%%.QSR		;VERSION NUMBER OF THE MESSAGE
	STORE	TF,.EQLEN(M),EQ.VRS	;STORE FOR QUASAR
	DATAM	LENHDR(E),,.EQLEN(M),EQ.LOH  ;STORE LENGTH OF REQUEST HEADER

	LOAD	T1,.EQROB+.ROBTY(M)	;GET THE QUEUE TYPE
	LOAD	T2,Q.IDEP(S1),QI.RDR	;GET THE /RDR SWITCH BIT
	CAIN	T1,.OTBAT		;WAS IT THE BATCH QUEUE AND
	SKIPN	T2			;   WAS /RDR SET ???
	JRST	SENDIT			;NO,,SEND THE MESSAGE
	MOVX	T1,.OTBIN		;YES,,GET THE SPRINT QUEUE ID
	STORE	T1,.EQROB+.ROBTY(M)	;RESET THE QUEUE TYPE
	LOAD	T1,.EQLEN(M),EQ.LOH	;GET THE HEADER LENGTH
	ADD	T1,M			;POINT TO THE FIRST FP
	MOVX	T2,.FPFSA		;GET 'STREAM ASCII' MODE
	STORE	T2,.FPINF(T1),FP.FFF	;SAVE THE THE FILE FORMAT

SENDIT:	TXO	M,1B0			;SIGN BIT IS PAGE MODE FLAG
	PUSHJ	P,MSGSND		;SEND OFF TO QUASAR
	PUSHJ	P,RCVACK		;GET THE "ACK" NOW
	JRST	CRESND			;SEND ANOTHER IF THERE IS ONE
;HERE TO FILL IN THE ACCOUNT STRING

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
>  ;END IFN FTJSYS

IFN FTUUOS,<
DOACCT:	PUSH	P,S1			;SAVE S1
	PUSH	P,S2			;SAVE S2
	PUSH	P,T1			;SAVE T1
	PUSH	P,T2			;SAVE T2
	PUSH	P,T3			;SAVE T3
	PUSH	P,T4			;SAVE T4
	PUSH	P,P1			;SAVE P1
	MOVX	S2,%CNST2		;WANT SECOND STATES WORD
	GETTAB	S2,			;GET IT
	 FAIL	(<GUF GETTAB UUO Failed>) ;NO,,END NOW
	TXNN	S2,ST%ACV		;IS ACCOUNT VALIDATION BEING DONE ???
	JRST	DOAC.2			;NO,,SKIP THIS
	MOVE	T1,Q.FLAG(S1)		;PICK UP SECONDARY PARM BLOCK ADDRESS
	JUMPE	T1,DOAC.0		;NOT THERE,,DEFAULT THE ACCOUNT STRING
	TRNE	T1,-1			;ADDRESS MUST BE IN LEFT HALF !!
	 FAIL	(<DPO /DEADLINE Parameter is Obsolete>)
	MOVSS	T1			;GET ADDRESS IN RIGHT HALF
	MOVE	S1,.ACCTS(T1)		;DID USER SPECIFY AN ACCOUNT STRING ???
	CAME	S1,[-1]			;LOOK FOR -1 (ACCT NOT SPECIFIED)
	JRST	DOAC.1			;FOUND ONE,,GO PROCESS IT

	;Here to default to user account string

DOAC.0:	MOVE	S1,[1,,S2]		;GET ACCT. PARMS
	MOVEI	S2,2			;GET PARM BLOCK LENGTH
	SETOM	T1			;WANT ACCOUNT STRING FOR THIS JOB
	HRROI	T2,.EQACT(M)		;GET POINTER TO WHERE WE WANT STRING PUT
	ACCT.	S1,			;READ THE ACCOUNT STRING INTO CREATE MSG
	SETZM	.EQACT(M)		;IT FAILED,,ZERO ACCOUNT STRING
	JRST	DOAC.2			;RETURN

	;Here to fill in account string specified by the user

DOAC.1:	MOVSI	T1,.ACCTS(T1)		;GET SOURCE ACCT STRING ADDRESS IN LEFT
	HRRI	T1,.EQACT(M)		;GET DESTINATION BLT ADDRESS IN RIGHT
	BLT	T1,.EQACT+12-1(M)	;COPY IT OVER

	MOVX	S1,QF.RSP+.QUVAL	;WANT RESPONSE+ACCOUNT VALIDATION
	SETZM	S2			;NO NODE
	MOVE	T1,[1,,S1]		;WANT RESPONSE IN S1
	MOVE	T2,[10,,.QBACT]		;GET LENGTH,,TYPE
	MOVEI	T3,.EQACT(M)		;GET ACCOUNT STRING ADDRESS
	MOVX	T4,QA.IMM+.QBOID	;GET PPN BLOCK TYPE
	MOVE	P1,.EQOID(M)		;GET THE OWNERS PPN
	MOVE	TF,[7,,S1]		;GET UUO BLOCK LEN,,ADDRESS
	QUEUE.				;REQUEST ACCOUNT VALIDATION
	  FAIL	(<IAS Invalid account string specified>)

DOAC.2:	POP	P,P1			;RESTORE P1
	POP	P,T4			;RESTORE T4
	POP	P,T3			;RESTORE T3
	POP	P,T2			;RESTORE T2
	POP	P,T1			;AND T1
	POP	P,S2			;AND S2
	POP	P,S1			;AND S1
	POPJ	P,			;AND RETURN
> ;END IFN FTUUOS
SUBTTL	KILL

KILL:	LOAD	H,Q.LEN(S1),QL.HLN	;GET LENGTH OF HEADER
	CAIGE	H,.QOHED		;GOT TO BE THAT BIG
	  FAIL(<HTS Header too short>)
	MOVEI	M,FBTEMP(E)		;USE THE FB BLOCK
	MOVX	T1,<INSVL.(KIL.SZ,MS.CNT)!INSVL.(.QOKIL,MS.TYP)>
	MOVEM	T1,.MSTYP(M)		;STORE IN MESSAGE HEADER
	MOVX	T1,MF.ACK		;SET FOR ACKNOWLEDGEMENT
	MOVEM	T1,.MSFLG(M)		;
KILL.1:	PUSHJ	P,GETOBJ		;GET OBJECT TYPE
	STORE	T1,KIL.OT(M)		;STORE IT
	DATAM	Q.JOB(S1),,KIL.RQ+.RDBJB(M)	;COPY THE JOB NAME
	DATAM	Q.JOBM(S1),,KIL.RQ+.RDBJM(M)	;AND THE MASK
	DATAM	Q.SEQ(S1),,KIL.RQ+.RDBES(M)	;THE SEQUENCE NUMBER IF ANY
	DATAM	Q.RID(S1),,KIL.RQ+.RDBRQ(M)	;THE REQUEST ID IF ANY

IFN FTUUOS,<
	DATAM	Q.PPN(S1),,KIL.RQ+.RDBOI(M)	;THE DIRECTORY
	DATAM	Q.PPNM(S1),,KIL.RQ+.RDBOM(M)	;AND ITS MASK
>  ;END IFN FTUUOS

IFN FTJSYS,<
	MOVS	T1,Q.PPN(S1)		;GET SOURCE,,0
	HRRI	T1,KIL.RQ+.RDBOW(M)	;GET SOURCE,,DEST
	SKIPLE	FORVER(E)		;IF ITS QFV2
	BLT	T1,KIL.RQ+.RDBOW+7(M)	;BLT THE USER NAME
>  ;END IFN FTJSYS

	PUSHJ	P,MSGSND		;SEND THE MESSAGE
	JRST	GETACK			;GET THE ACK AND RETURN TO CALLER
SUBTTL	MODIFY

MODIFY:	LOAD	H,Q.LEN(S1),QL.HLN	;GET LENGTH OF HEADER
	CAIGE	H,.QOHED		;GOT TO BE THAT BIG
	  FAIL(<HTS Header too short>)
	MOVE	M,.JBFF##		;SET THE MESSAGE ADDRESS
	MOVEI	M,777(M)		;MUST BE ON A PAGE BOUNDRY
	TRZ	M,777			;MAKE IT SO
	MOVEM	M,.JBFF##		;FAKE OUT CORGET
	GCORE	1000			;GET A PAGE ALTHOUGH WON'T NEED ALL OF IT
	TXO	M,1B0			;INDICATE PAGE MODE MESSAGE
	MOVX	T1,<INSVL.(MOD.SZ,MS.CNT)!INSVL.(.QOMOD,MS.TYP)>
	MOVEM	T1,.MSTYP(M)		;STORE IN MESSAGE HEADER
	MOVX	T1,MF.ACK		;ASK QUASAR FOR AN
	MOVEM	T1,.MSFLG(M)		;ACKNOWLEDGEMENT
	MOVEI	P1,<MOD.FG+MOD.GN>(M)	;POINT TO THE FIRST GROUP HEADER

;  HERE TO STORE MAJOR QUEUE ITEMS INTO THE MODIFY MESSAGE

	MOVE	P2,P1			;COPY ADDRESS OF GROUP HEADER
	MOVX	T1,<.GPMAJ,,0>		;DO MAJOR REQUEST MODIFIES
	PUSHJ	P,GRPSTO		;STORE AND BUMP COUNTS
	MOVWRD	Q.AFTR(S1)		; *** GRP 0, WRD 0 = AFTER PARAMETER ***;
	MOVE	T1,Q.PRI(S1)		; *** GRP 0, WRD 1 = PRIORITY ***;
	CKCHNG	QP.PRI			;CONVERT CHANGE CODES
	PUSHJ	P,GRPSTO		;STORE /PRIORITY
	MOVWRD	[-1]			; *** GRP 0, WRD 2 = DEADLINE PARM ***
	MOVE	T1,Q.PRI(S1)		; *** GRP 0, WRD 3 = REQUEST PROTECTION ***;
	CKCHNG	QP.PRO			;CONVERT CHANGE CODES
	PUSHJ	P,GRPSTO		;STORE /PROTECTION
	MOVE	S2,Q.FLAG(S1)		;PICK UP SECONDARY PARM BLOCK ADDRESS
	JUMPE	S2,MODI.A		;NOT THERE,,SKIP THIS
	TRNE	S2,-1			;ADDRESS MUST BE IN LEFT HALF !!
	 FAIL	(<DPO /DEADLINE Parameter is Obsolete>)
	MOVSS	S2			;GET ADDRESS IN RIGHT HALF
	MOVWRD	.ROBLK+.ROBAT(S2)	; *** GRP 0, WRD 4 = DEVICE ATTRIBUTES ***
	SKIPN	T1,.ROBLK+.ROBND(S2)	; *** GRP 0, WRD 5 = NODE CHANGE
	 SETOM	T1			;INDICATE NO CHANGE
	PUSHJ	P,GRPSTO		;STORE IT

	SKIPN	T1,.ROBLK+.ROBUA(S2)	; *** GRP 0, WRD 6 = CUSTOMER
	  SETOM	T1			;INDICATE NO CHANGE
	PUSHJ	P,GRPSTO		;STORE IT

;NOW SET UP FOR QUEUE DEPENDENT INFORMATION

MODI.A:	MOVE	P2,P1			;COPY ADDRESS OF GROUP HEADER
	MOVX	T1,<.GPQUE,,0>		;DO QUEUE DEPENDENT MODIFY
	PUSHJ	P,GRPSTO		;STORE AND BUMP COUNTS
	CAIE	H,.QIHED		;INPUT QUEUE
	  JRST	MODI.2			;NO, GO DO OUTPUT MODIFY

; THE INPUT QUEUE

	MOVE	T1,Q.ILIM(S1)		; *** GRP 1, WRD 0 = CORE LIMIT ***;
	CKCHNG	QM.COR			;CONVERT CHANGE CODES
	JUMPL	T1,MODI.0		;SKIP THIS IF IT DIDN'T CHANGE
	ADDI	T1,777			;ROUND UP TO A PAGE BOUNDRY
	ADR2PG	T1			;CONVERT TO PAGES
MODI.0:	PUSHJ	P,GRPSTO		;STORE /CORE
	MOVE	T1,Q.ILIM(S1)		; *** GRP 1, WRD 1 = TIME LIMIT ***;
	CKCHNG	QM.TIM			;CONVERT CHANGE CODES
	PUSHJ	P,GRPSTO		;STORE /TIME
	MOVE	T1,Q.ILM2(S1)		; *** GRP 1, WRD 2 = LPT LIMIT ***;
	CKCHNG	QM.LPT			;CONVERT CHANGE CODES
	PUSHJ	P,GRPSTO		;STORE /PAGES
	MOVE	T1,Q.ILM2(S1)		; *** GRP 1, WRD 3 = CDP LIMIT ***;
	CKCHNG	QM.CDP			;CONVERT CHANGE CODES
	PUSHJ	P,GRPSTO		;STORE /CARDS
	MOVE	T1,Q.ILM3(S1)		; *** GRP 1, WRD 4 = PTP LIMIT ***;
	CKCHNG	QM.PTP			;CONVERT CHANGE CODES
	PUSHJ	P,GRPSTO		;STORE /FEET (/METERS)
	MOVE	T1,Q.ILM3(S1)		; *** GRP 1, WRD 5 = PLT LIMIT ***;
	CKCHNG	QM.PLT			;CONVERT CHANGE CODES
	PUSHJ	P,GRPSTO		;STORE /TPLOT
	MOVE	T1,Q.IDEP(S1)		; *** GRP 1, WRD 6 = DEPENDENCY COUNT ***;
	CKCHNG	QI.DMT			;CONVERT CHANGE CODES
	JUMPL	T1,MODI.1		;JUMP IF NO MODIFY
	LOAD	T1,Q.IDEP(S1),QI.DEP	;GET VALUE
	LOAD	T2,Q.IDEP(S1),QI.DMT	;GET TYPE (+,-,ABSOLUTE)
	HRLI	T1,(T2)			;INCLUDE TYPE CODE
MODI.1:	PUSHJ	P,GRPSTO		;STORE /DEPEND
	MOVE	T1,Q.IDEP(S1)		; *** GRP 1, WRD 7 = UNIQUE ***;
	CKCHNG	QI.UNI			;CHECK IT
	PUSHJ	P,GRPSTO		;STORE /UNIQUE
	LOAD	T2,Q.IDEP(S1),QI.MNR	; *** GRP 1, WRD 8 = RESTART ***;
	SETO	T1,			;SET -1
	JUMPE	T2,MOD.1A		;JUMP IF NO CHANGE
	LOAD	T2,Q.IDEP(S1),QI.NRS	;GET /RESTART:NO BIT
	MOVX	T1,%EQRNO		;ASSUME NO
	SKIPN	T2			;IS IT YES?
	MOVX	T1,%EQRYE		;YES IT IS..
MOD.1A:	PUSHJ	P,GRPSTO		;STORE /RESTART
	MOVE	T1,Q.IDEP(S1)		; *** GRP 1, WRD 9 = OUTPUT (/Z:) ***;
	CKCHNG	QI.OUT			;CONVERT CHANGE CODES
	PUSHJ	P,GRPSTO		;STORE /OUTPUT
	SKIPN	T1,.DNODE(S2)		; *** GRP 1, WRD 10 = /DEST (INP:)
	 SETOM	T1			;INDICATE NO CHANGE
	PUSHJ	P,GRPSTO		;STORE /DEST (INP:)
;**;[2255]ADD 5 LINES AT MOD.1A:+7L	14-JUN-84/CTK
	LOAD	T2,Q.IDEP(S1),QI.MNA	;[2255] *** GRP 1, WRD 11 = /ASSIST ***;
	SETO	T1,			;[2255]SET -1
	SKIPE	T2			;[2255]SKIP IF NO CHANGE
	LOAD	T1,Q.IDEP(S1),QI.AST	;[2255]GET /ASSIST: BITS
	PUSHJ	P,GRPSTO		;[2255]STORE /ASSIST
	JRST	MODI.3			;GO DO FILE SPECIFIC CHANGES NOW

; THE OUTPUT QUEUES

MODI.2:	MOVWRD	Q.OFRM(S1)		; *** GRP 1, WRD 0 = FORMS ***;
	MOVE	T1,Q.OSIZ(S1)		; *** GRP 1, WRD 1 = LIMIT ***;
	CKCHNG	QS.LIM			;CONVERT CHANGE CODES
	PUSHJ	P,GRPSTO		;STORE /LIMIT
	MOVWRD	Q.ONOT(S1)		; *** GRP 1, WRD 2 = ANNOTATION (1ST HALF) ***;
	MOVWRD	Q.ONOT+1(S1)		; *** GRP 1, WRD 3 = ANNOTATION (2ND HALF) ***;

MODI.3:	LOAD	P4,Q.LEN(S1),QL.NFL	;GET NUMBER OF FILE SPECIFIC MODIFIES TO DO
	JUMPE	P4,KILL.1		;NONE, ALL DONE
	LOAD	T4,Q.LEN(S1),QL.FLN	;GET LENGTH OF FILE SPEC
	CAIGE	T4,Q.FRPT+2+Q.FMDM+1	;BETTER BE
	  FAIL(<ETS Entry Too Short>)
	MOVEI	T2,(H)			;COMPUTE FIRST FILE BLOCK
	ADDI	T2,1(S1)		;T2 = FILE BLOCK
	CAIN	H,.QIHED		;IS IT INPUT?
	JRST	FMOD.5			;YES, JUST DO /BEGIN
FMOD.1:	CAIL	T2,(M)			;CHECK FOR THE RIDICULOUS
	  FAIL(<BML Bad MODIFY Lengths>)
	MOVEI	T3,Q.FRPT+2(T2)		;POINT TO MODIFY MASKS


	MODCHG	QF.NFH			; *** OUT-GRP 1, MOD WRD 4 = HEADERS ***;
	SKIPL	T1			;SKIP IF NO CHANGE
	  TRC	T1,1			;FLIP IT FOR GALAXY
	PUSHJ	P,GRPSTO		;STORE /HEADER
	MODCHG	QF.SPC			; *** OUT-GRP 1, MOD WRD 5 = SPACING ***;
	PUSHJ	P,GRPSTO		;STORE /SPACING

	MODCHG	QF.PFM			; *** OUT-GRP 1, MOD WRD 6 = PAPER FORMAT ***;
	PUSHJ	P,GRPSTO		;STORE /PAPER
	MODCHG	QF.FFM			; *** OUT-GRP 1, MOD WRD 7 = FILE FORMAT ***;
	PUSHJ	P,GRPSTO		;STORE /FILE
	MODCHG	QF.DSP			; *** OUT-GRP 1, MOD WRD 10 = DISPOSITION ***;
	JUMPL	T1,FMOD.4		;JUMP IF DIDN'T CHANGE
	CAIN	T1,.QFDPR		;WAS IT /DIS:PRESERVE
	 TDZA	T1,T1			;YES, CLEAR THE DELETE BIT
	  MOVEI	T1,1			;NO, SET THE DELETE BIT
FMOD.4:	PUSHJ	P,GRPSTO		;STORE /DISP
	MODCHG	QF.COP			; *** OUT-GRP 1, MOD WRD 11 = COPY COUNT ***;
	PUSHJ	P,GRPSTO		;STORE /COPIES
	MOVWRD	Q.FRPT(T2)		; *** OUT-GRP 1, MOD WRD 12 = 1ST REPORT WORD ***;
	MOVWRD	Q.FRPT+1(T2)		; *** OUT-GRP 1, MOD WRD 13 = 2ND REPORT WORD ***;
FMOD.5:	MOVE	T1,Q.FBIT(T2)		; *** OUT-GRP 1, MOD WRD 14 = TAG OR BEGIN ***;
	JUMPE	T1,[SETO T1,		;JUMP IF DIDN'T CHANGE
		    JRST FMOD.6]	;GO STORE INDICATOR
	SKIPLE	FORVER(E)		;IS IT VERSION 0 OR 1?
	JRST	FMOD.6			;NO, CONTINUE ON
	TLNE	T1,007777		;A /TAG OR A NUMBER
	  LSH	T1,6			;A TAG, POSITION IS LEFT
FMOD.6:	PUSHJ	P,GRPSTO		;STORE /TAG OR /BEGIN

	JRST	KILL.1			;FILL IN COMMON PART AND SEND MESSAGE
SUBTTL	LIST

LISTEM:	MOVE	M,.JBFF##		;SET THE MESSAGE ADDRESS
	ADDI	M,777			;ROUND UP
	TRZ	M,777			;TO A PAGE
	MOVEM	M,.JBFF##		;FAKE OUT CORGET
	GCORE	1000			;GET A PAGE
	TXO	M,1B0			;INDICATE A PAGE FOR MSGSND
	MOVEI	T1,.OHDRS		;MAKE MESSAGE LENGTH FOR NOW
	STORE	T1,.MSTYP(M),MS.CNT	;AND SAVE IT.
	MOVX	T1,.QOLIS		;GET THE REQUEST TYPE.
	STORE	T1,.MSTYP(M),MS.TYP	;AND SAVE IT.
	SETZM	.OARGC(M)		;NO ARGS YET
	MOVEI	T4,.OHDRS(M)		;POINT TO FIRST FREE LIST BLOCK
	SETZM	.OFLAG(M)		;ZERO THE FLAG WORD.
	SETZM	.MSCOD(M)		;ZERO THE ACK CODE.
	HLLZ	T2,Q.DEV(S1)		;GET GENERIC DEVICE
	SETO	T1,			;ASSUME ALL QUEUES
	JUMPE	T2,LISE.3		;PROPER ASSUMPTION
	MOVSI	T1,-NDEVS		;MAKE AN AOBJN POINTER
LISE.1:	CAMN	T2,DEVTAB(T1)		;MATCH?
	JRST	LISE.2			;YES
	AOBJN	T1,LISE.1		;NO, LOOP
	SETZ	T1,			;LET QUASAR THROUGH IT OUT
	JRST	LISE.3			;STORE RESULT
LISE.2:	MOVE	T1,LIQTAB(T1)		;GET MASK
LISE.3:	MOVEI	T2,.LSQUE		;TYPE (QUEUES TOOTO LIST)
	PUSHJ	P,LSTBLK		;ADD TO LIST BLOCK
	MOVE	T3,Q.FLAG(S1)		;PICK UP SECONDARY PARM BLOCK ADDRESS
	JUMPE	T3,LIS.3A		;NOT THERE,,SKIP THIS
	TRNE	T3,-1			;ADDRESS MUST BE IN LEFT HALF !!
	FAIL	(<DPO /DEADLINE Parameter is Obsolete>)
	MOVSS	T3			;GET ADDRESS IN RIGHT HALF
	SKIPL	T1,.LSTYP(T3)		;GET THE MESSAGE FLAG BITS.
	 MOVEM	T1,.OFLAG(M)		;SAVE THEM IN THE MESSAGE.
	LOAD	T1,.ROBLK+.ROBAT(T3),RO.ATR;GET OBJECT ATTRIBUTES
	CAIE	T1,%PHYCL		;PHYSICAL?
	 JRST	LIS.3A			;NO--NO UNIT THEN
	LOAD	T1,.ROBLK+.ROBAT(T3),RO.UNI;YES--GET THE UNIT
	MOVEI	T2,.LSUNT		;TYPE (UNIT NUMBER)
	PUSHJ	P,LSTBLK		;ADD IT TO LIST BLOCK

LIS.3A:	SKIPN	T1,Q.PPN(S1)		;SEE IF USER ID GIVEN
	 JRST	LIS.3B			;NO
	MOVEI	T2,.LSUSR		;TYPE (USER ID)
	PUSHJ	P,LSTBLK		;ADD TO LIST BLOCK
	MOVE	T1,Q.PPNM(S1)		;GET USER ID MASK
	MOVEI	T2,.LSUSM		;TYPE (USER ID MASK)
	PUSHJ	P,LSTBLK		;ADD TO LIST BLOCK
LIS.3B:	SKIPN	T1,Q.JOB(S1)		;SEE IF JOB NAME GIVEN
	 JRST	LIS.3C			;NO
	MOVEI	T2,.LSJOB		;TYPE (JOB NAME)
	PUSHJ	P,LSTBLK		;ADD TO LIST BLOCK
	MOVE	T1,Q.JOBM(S1)		;GET JOB NAME MASK
	MOVEI	T2,.LSJBM		;TYPE (JOB NAME MASK)
	PUSHJ	P,LSTBLK		;ADD TO LIST BLOCK
LIS.3C:	MOVE	T1,.LSDES(T3)		;GET /DESTINATION
	MOVEI	T2,.LSDND		;BLOCK TYPE
	PUSHJ	P,LSTBLK		;ADD TO MESSAGE
	MOVE	T1,.LSPRC(T3)		;GET /PROCESSING
	MOVEI	T2,.LSPND		;BLOCK TYPE
	PUSHJ	P,LSTBLK		;ADD TO MESSAGE

LIS.4C:	PUSHJ	P,MSGSND		;SEND THE REQUEST
	LOAD	T1,Q.OPR(S1),QO.SCH	;GET ADDRESS OF LISTER
	MOVEM	T1,LISTER(E)		;SAVE FOR LATER PUSHJ'S
;   FALL ONTO THE NEXT PAGE FOR THE LIST ANSWERS


LIST.1:	MOVE	P1,.JBFF##		;NOW FOR THE MESSAGES RETURNED,
	MOVEI	P1,777(P1)		;COMPUTE THE FIRST NON-EX PAGE.
	TRZ	P1,777			;ZERO THE BOTTOM BITS.
	ADR2PG	P1			;CONVERT IT TO A PAGE NUMBER.

IFN FTUUOS,<
	PUSHJ	P,QUEWAT		;WAIT FOR A MESSAGE FROM QUASAR
	MOVX	T1,IP.CFV		;IT'S A PAGED ANSWER
	SETZB	T2,T3			;CLEAR OTHER STUFF
	MOVEI	T4,(P1)			;THE PAGE TO RECEIVE
	HRLI	T4,1000			;COUNT FOR PAGE MODE
	MOVE	S2,[4,,T1]		;LENGTH,,ADDR
	IPCFR.	S2,			;REC, WAIT
	  SKIPA				;CAN'T
	JRST	LIST.0			;ENTER COMMON CODE
	CAXN	S2,IPCUP%		;OUT OF CORE ?
	FAIL(<NCL Not enough core to receive list answer>)
	FAIL(<LRF List answer receive failed>)

>  ;END OF IFN FTUUOS

IFN FTJSYS,<
	GCORE	1000			;MAKE SURE WE HAVE THE CORE
	MOVX	T1,IP.CFV		;IT'S A PAGED ANSWER
	SETZB	T2,T3			;CLEAR OTHER STUFF
	MOVEI	T4,(P1)			;THE PAGE TO RECEIVE
	HRLI	T4,1000			;COUNT FOR PAGE MODE
	PUSH	P,S1			;SAVE BASE OF USER AREA
	MOVE	T3,MYPID(E)		;SET UP MY PID
	MOVEI	S1,4			;FOUR WORDS
	MOVEI	S2,T1			;IN T1-T4
	MRECV				;RECEIVE THE PACKET
	  FAIL(<LRF List answer receive failed>)
	POP	P,S1			;RESTORE USER BASE

>  ;END OF IFN FTJSYS


LIST.0:	PG2ADR	P1			;CONVERT PAGE # TO AN ADDRESS.
	MOVEM	P1,.JBFF##		;RESET THE LAST PAGE ADDRESS.
	AOS	.JBFF##			;BUMP IT BY 1 TO FORCE NEXT PAGE.
;**;[2256] Insert 3 lines after LIST.0+2L /LWS
	MOVE	S2,ACKCOD(E)		;[2256] GET THE CODE WE WANT TO SEE
	CAME	S2,.MSCOD(P1)		;[2256] EXPECTING THIS MESSAGE?
	JRST	LIST.1			;[2256] NO, IGNORE IT
	PUSHJ	P,@LISTER(E)		;GO DUMP THE ANSWER.
	LOAD	S2,.OFLAG(P1)		;GET THE FLAG BITS.
	TXNN	S2,WT.MOR		;WAS THIS THE LAST PAGE ???
	JRST	QMRXIT			;YES,,GO FINISH UP.
	JRST	LIST.1			;NO,,GO GET ANOTHER PAGE.
;LSTBLK -- ROUTINE TO ADD THING TO LIST MESSAGE BLOCK
;CALL:
;	T1/ DATA TO ADD
;	T2/ TYPE CODE
;ASSUMES (AND UPDATES) T4 TO BE POINTER TO NEXT FREE BLOCK

LSTBLK:	MOVEM	T1,ARG.DA(T4)		;STORE THE DATA
	STORE	T2,ARG.HD(T4),AR.TYP	;STORE THE TYPE
	MOVEI	T1,2			;THEY ARE TWO WORDS LONG
	STORE	T1,ARG.HD(T4),AR.LEN	;STORE THE LENGTH
	AOS	.OARGC(M)		;ONE MORE ARG
	ADDI	T4,2			;ADVANCE TO NEXT BLOCK
	LOAD	T1,.MSTYP(M),MS.CNT	;GET MESSAGE COUNT
	ADDI	T1,2			;UPDATE FOR WHAT WE STORED
	STORE	T1,.MSTYP(M),MS.CNT	;AND REMEMBER
	POPJ	P,			;RETURN
SUBTTL	DEFER & ZDEFER

DEFER:	SKIPA	T1,[.DFREL]		;RELEASE SPOOLED FILES
ZDEFER:	MOVEI	T1,.DFKIL		;KILL SPOOLED FILES
	MOVEI	M,FBTEMP(E)		;WHERE TO BUILD THE MESSAGE
	STORE	T1,DFR.JB(M),DF.FNC	;STORE THE DEFER FUNCTION
	MOVX	T1,<INSVL.(DFR.SZ,MS.CNT)!INSVL.(.QODFR,MS.TYP)>
	MOVEM	T1,.MSTYP(M)		;STORE MESSAGE AND LENGTH
	MOVX	T1,MF.ACK		;ASK QUASAR FOR AN
	MOVEM	T1,.MSFLG(M)		;ACKNOWLEDGEMENT
	PJOB	T1,			;FOR THIS JOB NUMBER
	STORE	T1,DFR.JB(M),DF.JOB	;STORE THE JOB NUMBER
	SKIPE	T1,Q.DEV(S1)		;SKIP IF HE WANTS ALL QUEUES
	PUSHJ	P,GETOBJ		;GET THE OBJECT
	MOVEM	T1,DFR.OT(M)		;STORE THE OBJECT
	PUSHJ	P,MSGSND		;SEND OFF THE MESSAGE
	JRST	GETACK			;GET ACK AND RETURN TO CALLER
SUBTTL	Subroutines

;SUBROUTINE TO GET SOME CORE.. T1 = AMOUNT NEEDED, KEEPS .JBFF STRAIGHT

CORGET:	ADDB	T1,.JBFF##		;BUMP HIGHEST, GET SAME
	SUBI	T1,1			;BACK OFF BY ONE
	CAMG	T1,.JBREL##		;ALREADY HAVE ENOUGH
	  POPJ	P,			;YES, CAN SAVE A CORE UUO
	CORE	T1,			;ACQUIRE THE CORE
	  FAIL(<NEC Not enough core>)
	POPJ	P,			;AND RETURN

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

FAIL.:	PUSHJ	P,TTCRLF		;START THE LINE
	TTYSTR	[ASCIZ/?QMR/]		;ADD PREFIX
	TTYSTR	(<(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>)
E.NOFI:	FAIL1(<NFC No files in CREATE request>)
E.NOQS:	FAIL1(<NQS No queue specified>)
E.ILNS:	FAIL1(<IHL Illegal Header Length for Queue>)

;SUBROUTINE TO ADD A MODIFY ELEMENT TO THE MESSAGE BEING BUILT

;	T1 = THING TO STORE
;	P1 = CURRENT POINTER (WILL INCREMENT THIS AND MESSAGE LENGTH)
;	P2 = GROUP HEADER ADDRESS (WILL INCREMENT ELEMENT COUNT)

GRPSTO:	CAILE	P1,777(M)		;OFF THE END YET
	  FAIL(<TMF Too Many Files in File-Specific Modify>)
	MOVEM	T1,(P1)			;STORE THIS ELEMENT
	LOAD	TF,.MSTYP(M),MS.CNT	;GET CURRENT COUNT
	ADDI	TF,1			;ADD ANOTHER
	STORE	TF,.MSTYP(M),MS.CNT	;STORE IT
	INCR	MOD.GN(P2),MODGLN	;ANOTHER ELEMENT IN THIS GROUP
	INCR	P1			;ADVANCE FOR NEXT STORE
	POPJ	P,			;AND RETURN FOR THE NEXT

;TTY OUTPUT SUBROUTINES

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

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
	TTYCHR	T3			;DUMP IT OUT
	TLNE	T2,770000		;END OF THE WORD
	  JRST	TYSIX1			;NO, GET ANOTHER
	POPJ	P,			;ALL DONE


CPOPJ1:	AOS	0(P)			;SKIP RETURN.
CPOPJ:	POPJ	P,			;RETURN.
;SUBROUTINE TO BUILD A PROPER FD AREA FROM THE MPB FILE BLOCK

;CALLED WITH S2 = ADDRESS OF THE FD
;	     P1 = THE MPB FILE BLOCK
;CAN USE T1 - T4 AND TF

;MUST FILL IN FD.LEN IN .FDLEN

;FBTEMP(E) IS THE FP BLOCK, FP.FHD IS ALREADY SET

IFN FTUUOS,<

BLDFDA:	MOVEI	T1,FDMSIZ		;ASSUME SHORT DESCRIPTOR
	STORE	T1,.FDLEN(S2),FD.LEN	;SAVE THAT SIZE
	MOVE	T1,Q.FSTR(P1)		;GET FILE STRUCTURE
	MOVEM	T1,STRBLK+.DCNAM(E)	;CONVERT UNIT TO STRUCTURE
	MOVEI	T1,STRBLK(E)		;SET ARGUMENTS FOR DSKCHR
	HRLI	T1,5			;5 WORD BLOCK
	DSKCHR	T1,			;DO THE CONVERSION AS I$MSTR DOES
	  JRST	BLDF.1			;FAILED, ASSUME NON-EXISTANT
	JUMPE	T1,BLDF.1		;IF WORKED BUT NO ANSWER, MUST BE NUL:
	TXNN	T1,DC.TYP		;IF RETURNED TYPE IS ZERO, THEN
	  FAIL(<CSG Cannot Specify Generic Disk>)
	MOVE	T1,STRBLK+.DCSNM(E)	;GET THE STR NAME CONTAINING THIS UNIT
	MOVEM	T1,Q.FSTR(P1)		;STORE IT BACK IN DATA BASE
BLDF.1:	DATAM	Q.FSTR(P1),,.FDSTR(S2)
	DATAM	Q.FSTR(P1),,CURSTR(E)
	DATAM	Q.FNAM(P1),,.FDNAM(S2)
	DATAM	Q.FEXT(P1),,.FDEXT(S2)
	DATAM	Q.FDIR(P1),,.FDPPN(S2)
	MOVEI	T4,.FDPAT(S2)		;GET READY TO DO THE PATH
	MOVSI	T1,-5			;MAXIMUM DEPTH
	HRRI	T1,Q.FDIR+1(P1)		;WHERE IT STARTS
BLDF.2:	SKIPN	T3,(T1)			;SKIP IF THERE IS ONE
	  POPJ	P,			;NO, WE ARE DONE
	MOVEM	T3,(T4)			;STORE THIS SFD
	INCR	T4			;ADJUST CURRENT POINTER
	LOAD	T2,.FDLEN(S2),FD.LEN	;PICK UP FD LENGTH
	AOS	T2			;ADD 1 TO IT.
	STORE	T2,.FDLEN(S2),FD.LEN	;AND SAVE IT.
	AOBJN	T1,BLDF.2		;GET THE NEXT
	POPJ	P,			;RETURN WITH GOOD FD AREA

>  ;END OF IFN FTUUOS
IFN FTJSYS,<

BLDFDA:	MOVEI	T3,.FDSTG(S2)		;ADDRESS OF STRING TO BUILD
	HRLI	T3,(POINT 7,0)		;MAKE AN ASCII BYTE POINTER
	MOVX	T1,1B15			;LOAD SPECIAL BIT
	SKIPLE	FORVER(E)		;VERSION 2 REQUEST FORMAT
	TDNN	T1,Q.FMOD(P1)		;YES, IS BIT 15 SET?
	JRST	BLDF.2			;NO, IGNORE THIS
	MOVE	T1,[POINT 7,Q.FSTR(P1)]	;YES, ITS A STRING
	MOVE	T2,[POINT 6,CURSTR(E)]	;TO SAVE AWAY THE STR NAME
	SETZM	CURSTR(E)		;START BLANK

BLDF.1:	ILDB	T4,T1			;GET A CHARACTER
	IDPB	T4,T3			;STORE IT
	JUMPE	T4,BLDF.3		;BRANCH WHEN DONE
	CAIN	T4,":"			;END OF DEVICE NAME?
	TLZ	T2,7700			;YES, MAKE POINTER INEFFECTIVE
	SUBI	T4,"A"-'A'		;MAKE IT SIXBIT
	TLNE	T2,770000		;GET 6 CHARS YET?
	IDPB	T4,T2			;NO, DEPOSIT ONE
	JRST	BLDF.1			;ELSE LOOP

BLDF.2:	PUSH	P,P2			;SAVE P2
	MOVE	P2,[4,,T1]		;LENGTH,,ARGS
	MOVEI	T1,3			;FUNCTION 3, PPN TO STRING
	MOVE	T2,Q.FDIR(P1)		;THE PPN, BYTE POINTER IS IN T3
	MOVE	T4,Q.FSTR(P1)		;GET STRUCTURE
	MOVEM	T4,CURSTR(E)		;SAVE AWAY FOR LATER
	COMPT.	P2,			;CONVERT IT
	  FAIL(<CDD Cannot Determine Directory of file owner>)
	POP	P,P2			;RESTORE P2
	MOVEI	T1,Q.FNAM(P1)		;THE NAME
	PUSHJ	P,BLDSTG		;INTO THE STRING
	STCHR	<".">			;MORE PUNCTUATION
	HLLZS	Q.FEXT(P1)		;WANT ONLY LEFT HALF
	MOVEI	T1,Q.FEXT(P1)		;NOW POINT TO IT
	PUSHJ	P,BLDSTG		;INTO THE STRING
	STCHR	0			;ADD A NULL TO TERMINATE THE STRING
BLDF.3:	HRRZS	T3			;NOW COMPUTE THE LENGTH
	SUBI	T3,.FDLEN-1(S2)		;THE NUMBER OF WORDS IN THE STRING
	STORE	T3,.FDLEN(S2),FD.LEN	;AS LENTH OF FD AREA
	POPJ	P,			;AND RETURN

; 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
;SUBROUTINE TO CONVERT A DEVICE TO AN OBJECT TYPE
;
;DEVICE NAME IN Q.DEV(S1), RETURN WITH T1 CONTAINING OBJECT

GETOBJ:	HLLZ	T1,Q.DEV(S1)		;GET GENERIC DEVICE
	MOVSI	T2,-NDEVS		;MAKE AN AOBJN POINTER

GETO.1:	CAMN	T1,DEVTAB(T2)		;DO A COMPARE
	JRST	GETO.2			;WIN
	AOBJN	T2,GETO.1		;LOOP
	JRST	E.NOQS			;LOSE

GETO.2:	MOVE	T1,OBJTAB(T2)		;GET THE OBJECT
	POPJ	P,			;AND RETURN

;SUBROUTINES TO FLUSH THE RECEIVE QUEUE (NEEDED FOR TOPS10 ONLY)

IFN FTUUOS,<

QUEFLS:	PUSHJ	P,QUEQRY		;QUERY THE QUEUE
	JUMPE	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
	SKIPE	DEBUGW			;IF DEBUGGING,
	CAME	T2,INFPID(E)		;COULD BE FROM INFO
	CAMN	T2,QSRPID(E)		;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		;WAKE ON IPCF PACKET AVAILABLE
	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"

RCVACK:	MOVEI	M,FBTEMP(E)		;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
	  SKIPA				;CAN'T
	JRST	RCVA.A			;ENTER COMMON CODE
	CAXN	S2,IPCUP%		;OUT OF CORE ?
	FAIL(<NEC Not enough core to receive acknowledgement>)
	FAIL(<ARF Acknowledgement receive failed>)

>  ;END OF IFN FTUUOS

IFN FTJSYS,<

	SETZB	T1,T2			;CLEAR FLAGS, SENDER
	MOVE	T3,MYPID(E)		;RECEIVER
	HRLI	T4,FBAREA		;SIZE OF SHORT MESSAGE
	HRRI	T4,FBTEMP(E)		;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

RCVA.A:	SKIPN	DEBUGW			;DEBUGGING?
	JRST	RCVA.0			;NO
	MOVE	S2,.IPCI0(M)		;GET POSSIBLE CODE WORD
	CAMN	S2,[MAKNAM,,.IPCIW]	;AND CHECK IT
	POPJ	P,			;RETURN NOW ON A MATCH
RCVA.0:	MOVE	S2,ACKCOD(E)		;GET ACK CODE WE'RE EXPECTING
	CAME	S2,.MSCOD(M)		;IS IT?
	JRST	RCVACK			;NO, IGNORE IT
	LOAD	S2,.MSFLG(M)		;GET THE MESSAGE STATUS WORD
	TXNE	S2,MF.NOM		;NORMAL "ACK" (NO MESSAGE ASSOCIATED)
	  JRST	RCVA.3			;YES, SEE IF IT IS TIME TO RETURN
	TXNN	S2,MF.MOR		;FIRST OF MANY
	  JRST	RCVA.4			;NO, OUTPUT THE MESSAGE
	LOAD	T1,Q.OPR(S1),QO.CSP	;YES, GET CALLERS IDENTIFICATION
	CAILE	T1,%QOQUE		;EITHER FLAVOR OF QUEUE
	  JRST	RCVACK			;NO, 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:	TXNN	S2,MF.FAT!MF.WRN	;FATAL OR WARNING
	JRST	RCVA.2			;NEITHER
	MOVEI	T1,"?"			;FATAL CHARACTER
	TXNN	S2,MF.FAT		;WAS IT FATAL?
	  MOVEI	T1,"%"			;NO, LOAD WARNING CHARACTER
	TTYCHR	T1			;OUTPUT THE "?" OR "%"
	TTYSTR	[ASCIZ/QSR/]		;OUTPUT "QUASAR" PREFIX
	LOAD	T1,.MSFLG(M),MF.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
	TTYCHR	T1			;MAKE THE OUTPUT PRETTY
RCVA.2:	TTYSTR	(<.OHDRS+ARG.DA(M)>)	;AND FINALLY, OUTPUT THE MESSAGE
	PUSHJ	P,TTCRLF		;END THE MESSAGE
	TXNE	S2,MF.FAT		;AGAIN, WAS IT FATAL
	  JRST	FAIEXI			;YES, QUIT NOW
RCVA.3:	TXNE	S2,MF.MOR		;MORE COMING
	  JRST	RCVACK			;YES, DO THIS ALL OVER AGAIN
	POPJ	P,			;CONTINUE PROCESSING
IFN FTUUOS,<

MSGSND:	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>)
	MOVE	T3,QSRPID(E)		;GET QUASAR'S PID
	SETOM	RTYCNT(E)		;INIT RETRY COUNTER
;**;[2256] Insert 2 lines after MSGSND+6L /LWS
	MOVE	T1,ACKCOD(E)		;[2256] GET ACK CODE
	MOVEM	T1,.MSCOD(M)		;[2256] PUT IN MESSAGE HEADER
	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
MSGGO:	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(E)		;COUNT THE RETRIES
	  JRST	MSGGO			;TRY NOW
	TTYSTR	(<[ASCIZ/
%QMRMBR Send has failed, Message Being Re-sent
/]>)
	JRST	MSGGO			;NOW RETRY IT

>  ;END OF IFN FTUUOS
IFN FTJSYS,<

MSGSND:	MOVEM	S1,MSNDT(E)		;SAVE USER DATA BASE
	MOVE	T3,QSRPID(E)		;GET QUASAR'S PID SET UP
	SETOM	RTYCNT(E)		;INIT RETRY COUNTER
	SETZ	T1,			;ASSUME NO FLAGS
	SKIPN	T2,MYPID(E)		;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 ONE PAGE
MSGGO1:	HRL	T4,S2			;GET LENGTH OF THE DATA
MSGGO:	MOVEI	S1,4			;FOUR WORDS
	MOVEI	S2,T1			;IN T1-T4
	MSEND				;SEND THE PACKET
	  JRST	MSGGO2			;FAILED, SEE WHY
	SKIPN	MYPID(E)		;DO I ALREADY HAVE THE PID
	  MOVEM	T2,MYPID(E)		;NO, SAVE IT
	MOVE	S1,MSNDT(E)		;RESTORE THE USER DATA BASE
	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(E)		;DO I HAVE A PID
	  MOVEM	T2,MYPID(E)		;NO, MAYBE THIS IS IT
	MOVEI	S1,^D2000		;WAIT BEFORE TRYING AGAIN
	DISMS				;WAIT
	AOSE	RTYCNT(E)		;COUNT THE RETRIES
	  JRST	MSGGO			;TRY NOW
	TTYSTR	(<[ASCIZ/
%QMRMBR Send has failed, Message Being Re-sent
/]>)
	JRST	MSGGO			;AND TRY THE SEND AGAIN

>  ;END OF IFN FTJSYS
; GET THE PID FOR QUASAR

GQPID:	MOVEM	S1,MSNDT(E)		;SAVE USER DATA BASE AWAY
	SKIPN	DEBUGW			;ARE WE DEBUGGING?
	JRST	GQPI.1			;NO, USE SYSTEM-QUASAR
	PUSHJ	P,MAKNAM		;MAKE UP NAME TO LOOK FOR
	MOVE	T4,S1			;LENGTH AND POSITION OF PACKET
	MOVX	S1,SP.INF		;GET PID FOR SYSTEM-INFO
	PUSHJ	P,FPID			;
	JUMPE	S1,GQPI.1		;IF NO INFO, GIVE UP
	MOVE	T3,S1			;REMEMBER THE PID
	MOVEM	T3,INFPID(E)		;
	SETZB	T1,T2			;NO FLAGS, CLEAR PID
IFN FTJSYS,<
	SKIPN	T2,MYPID(E)		;DO WE HAVE A PID?
	TXO	T1,IP%CPD		;NO, CREATE ONE
> ;END OF FTJSYS
	PUSHJ	P,MSGGO			;SEND THE MESSAGE TO INFO
	PUSHJ	P,RCVACK		;WAIT FOR REPLY
	LOAD	S1,T1,IP.CFE		;CHECK FOR ERRORS
	JUMPN	S1,GQPI.1		;
	TTYSTR	(<[ASCIZ /% Connecting to /]>)
	TTYSTR	(<FBTEMP+.IPCI2(E)>)
	TTYSTR	(<[BYTE(7) 15,12,0,0,0]>)
	MOVE	S1,FBTEMP+.IPCI1(E)	;GET PRIVATE QUASAR'S PID

GQPI.4:	MOVEM	S1,QSRPID(E)		;STORE THE PID
	MOVE	S1,MSNDT(E)		;RESTORE DATA BASE AC
	POPJ	P,			;THEN RETURN

GQPI.1:	SETOM	T1			;FLAG FOR FIRST TIME
GQPI.2:	MOVX	S1,SP.QSR		;PID OF QUASAR
	PUSHJ	P,FPID			;LOOK IT UP
	JUMPN	S1,GQPI.4		;IF WE GOT THE PID , RETURN NOW
	AOJN	T1,GQPI.3		;FIRST TIME IT FAILED?
	TTYSTR	[ASCIZ /
%QMRWFQ Waiting for [SYSTEM]QUASAR to start
/]					;NO GIVE MESSAGE
GQPI.3:	MOVEI	S1,3			;WAIT FOR 3 SECONDS
IFN FTUUOS,<
	SLEEP	S1,			;SLEEP FOR SPECIFIED TIME
> ;END OF FTUUOS
IFN FTJSYS,<
	IMULI	S1,^D1000		;CONVERT TO MS
	DISMS				;AND DISMISS PROCESS
> ;END OF FTJSYS
	JRST	GQPI.2			;AND TRY AGAIN

FPID:
IFN FTUUOS,<
	HRLI	S1,.GTSID		;WANT FROM SYSTEM PID TABLE
	MOVSS	S1
	GETTAB	S1,			;ASK FOR IT
	  SETZ	S1,			;IF IT FAILS,
	POPJ	P,			;AND RETURN
> ;END OF FTUUOS

IFN FTJSYS,<
	MOVE	T2,S1			;INDEX TO ASK FOR
	MOVX	T1,.MURSP		;READ SYSTEM PID TABLE
	DMOVE	S1,[EXP 3,T1]		;WHERE TO PLACE THE ANSWER
	MUTIL				;DO IT
	  SETZ	T3,			;IF IT FAILS, FAKE A ZERO ANSWER
	MOVE	S1,T3			;GET PID
	POPJ	P,			;AND RETURN
> ;END OF FTJSYS
; MAKE UP THE PACKET TO SEND TO INFO

; LOOK FOR [USER-NAME]QUASAR

MAKNAM:	PUSH	P,T1			;SAVE SOME REGS
	PUSH	P,T2			;

IFN FTJSYS,<
	PUSH	P,S1			;GET A STACK SPACE
	SETO	S1,			;FOR CURRENT JOB
	HRROI	S2,0(P)			;PLACE TO GET JOB USER NUMBER
	MOVX	T1,.JIUNO		;WANT USER NUMBER
	GETJI				;GET JOB INFORMATION
	 JFCL
	POP	P,S2			;PLACE NUMBER IN S2
> ;END OF FTJSYS
IFN FTUUOS,<
	SKIPL	S2,DEBUGW		;GET AND CHECK DEBUGW
	TLNN	S2,377777		;IF SET ASSUME WE GOT A PPN IN THERE
	GETPPN	S2,			;GET THE PPN
	  JFCL				;INFAMOUS SKIP RETURN
> ;END OF FTUUOS
	MOVEI	S1,FBTEMP+1(E)		;AREA TO CLEAR
	HRLI	S1,-1(S1)		;BLT POINTER
	SETZM	FBTEMP(E)		;
	BLT	S1,FBTEMP+FBAREA-1(E)	;CLEAR IT
	MOVE	S1,[MAKNAM,,.IPCIW]	;GET INFO FUNCTION
	MOVEM	S1,FBTEMP+.IPCI0(E)	;STORE IT
	SETZM	FBTEMP+.IPCI1(E)	;NO ONE TO COPY
	MOVEI	S1,FBTEMP+.IPCI2(E)	;GET LOCATION TO PUT NAME INTO
	HRLI	S1,(POINT 7,)		;MAKE IT A POINTER
	MOVEI	T1,"["			;OPEN BRACKET
	IDPB	T1,S1			;STORED
IFN FTJSYS,<
	DIRST				;STORE USER NAME
	  JFCL
> ;END OF FTJSYS
IFN FTUUOS,<
	PUSH	P,S2			;SAVE THE PPN
	HLRZ	T1,S2			;GET THE PROJ NUMBER
	PUSHJ	P,OCTNAM		;OUTPUT IT
	MOVEI	S2,","			;SEPARATING COMMA
	IDPB	S2,S1			;STORE IT
	POP	P,T1			;RESTORE THE PPN
	ANDI	T1,-1			;ONLY PROG NUMBER
	PUSHJ	P,OCTNAM		;ADD TO THE NAME
>;END OF FTUUOS
	MOVE	T1,[POINT 7,[ASCIZ /]QUASAR/]] ;END OF NAME
MAKN.1:	ILDB	T2,T1			;GET A BYTE
	IDPB	T2,S1			;STORE THE BYTE
	JUMPN	T2,MAKN.1		;REPEAT , INCLUDING NULL
	HRRZS	S1			;ISOLATE THE ADDRESS
	SUBI	S1,FBTEMP-1(E)		;GET LENGTH
	HRLI	S1,FBTEMP(E)		;WHERE THE PACKET STARTS
	MOVSS	S1			;GET LEN,,ADDR
	POP	P,T2			;RESTORE ACS USED
	POP	P,T1
	POPJ	P,			;AND RETURN

IFN FTUUOS,<
OCTNAM:	IDIVI	T1,8			;OCTAL DIVIDE ROUTINE
	HRLM	T2,0(P)			;USUAL ROUTINE
	SKIPE	T1			;DONE?
	PUSHJ	P,OCTNAM		;NO GO AGAIN
	HLRZ	T1,0(P)			;GET A DIGIT
	ADDI	T1,"0"			;ASCII-IZE IT
	IDPB	T1,S1			;STORE IT
	POPJ	P,			;AND RETURN

;**;[2256] Include new suboutine after OCTNAM subroutine.
;SUBROUTINE TO BUILD AN ACK CODE
;ACK CODE STORED IN ACKCOD(E).

BLDACK:	PUSH	P,S1			;[2256] SAVE S1
	SETZM	ACKCOD(E)		;[2256] CLEAR TARGET
	PJOB	S1,			;[2256] GET OUR JOB NUMBER
	STORE	S1,ACKCOD(E),ACK.JB	;[2256] PUT IN PROPER PLACE
	MOVX	S1,%CNDTM		;[2256] GET UDT
	GETTAB	S1,			;[2256] ASK THE MONITOR
	  SETZ	S1,			;[2256] OH WELL
	STORE	S1,ACKCOD(E),ACK.UT	;[2256] STORE IN UDT FIELD OF CODE
	POP	P,S1			;[2256] RESTORE S1
	POPJ	P,			;[2256] RETURN
> ;END OF FTUUOS

SUBTTL	Data Storage

	XLIST	;FORCED OUT LITERAL POOL
	LIT
	LIST
	SALL

FBSIZE==FPXSIZ+FDXSIZ		;THE LARGEST FD/FP WE CAN BUILD
	MAX	<FBSIZE,KIL.SZ,7,DFR.SZ>
FBAREA==MAXSIZ			;THE LARGEST FILE BLOCK/MESSAGE NEEDED
	RELOC	QMANGR

	PHASE	0

MYPID:!	 BLOCK	1		;MY PID (NECESSARY FOR SEND/RECEIVE)
QSRPID:! BLOCK	1		;PID OF SYSTEM QUASAR
MSNDT:!	BLOCK	1		;SAVE USER DATA BASE ADDR DURING IPCF STUFF
INFPID:! BLOCK	1		;PID OF SYSTEM INFO
RTYCNT:! BLOCK	1		;RETRY COUNTER WHEN SEND TO QUASAR FAILS
LISTER:! BLOCK	1		;ADDRESS OF CALLERS ROUTINE
FSTMSG:! BLOCK	1		;ADDR OF FIRST LISTANSWER OR CREATE MESSAGE
NUMANS:! BLOCK	1		;NUMBER RECEIVED OR TO BE SENT
CURANS:! BLOCK	1		;ONE WE ARE LISTING NOW
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
LENHDR:! BLOCK	1		;LENGTH OF HEADER DURING CREATE
FORVER:! BLOCK	1		;<QUEUE FORMAT VERSION>-1
CURSTR:! BLOCK	1		;STRUCTURE OF CURRENT FILE

SPCFCT:! BLOCK	1		; Place to save the file spacing
;**;[2256] Insert 1 line /LWS
ACKCOD:! BLOCK	1		;[2256] ACKCOD FOR KEEPING IN SYNCH

E.LEN:!				;LENGTH OF AREA NEEDED

	DEPHASE

	RELOC	0		;NOW, IF LOADED WITH QUEUE, DEFINE REGISTER SAVE

RSA:	BLOCK	17		;AC'S 0-16 ARE SAVED HERE WHEN LOADED WITH QUEUE



	END			;END, NO STARTING ADDRESS