Google
 

Trailing-Edge - PDP-10 Archives - BB-X116A-BB_1984 - swique.mac
There are 4 other files named swique.mac in the archive. Click here to see a list.
	TITLE	.QUEUE	SWIL GALAXY/QUEUE interface routines
	SUBTTL	Robert Houk/RDH

	SEARCH	SWIDEF,	SWIL		;SWIL PACKAGE DEFINITIONS
	SEARCH	JOBDAT,	MACTEN,	UUOSYM	;STANDARD DEFINITIONS
	SEARCH	ACTSYM			;ACCOUNTING SYSTEM SYMBOLS

	SALL				;PRETTY LISTINGS
	.DIREC	FLBLST			;PRETTIER LISTINGS

	TWOSEG	400000

Copyright (C) Digital Equipment Corporation 1984.

	COMMENT	\


Copyright (C) 1984
Digital Equipment Corporation, Maynard, Massachusetts, U.S.A.

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.

\


;SWIQUE VERSION IDENTIFICATION

MAJVER==1	;MAJOR VERSION LEVEL
MINVER==0	;MINOR (MAINTENANCE RELEASE) LEVEL
CSTVER==0	;CUSTOMER VERSION (WHO LAST . . .)
EDTVER==0	;EDIT LEVEL

%%LQUE==:<BYTE (3)CSTVER(9)MAJVER(6)MINVER(18)EDTVER>

IF2,<	PURGE	CSTVER,MAJVER,MINVER,EDTVER>
	SUBTTL	Revision history
	SUBTTL	 GALAXY queueing support routines

;QUEOP  --  QUEUE A REQUEST TO GALAXY
;Call is:
;
;	MOVX	T1,<CDB>
;	MOVX	T2,<FNC>
;	MOVX	T3,<ARG1>
;	MOVX	T4,<ARG2>
;	PUSHJ	P,QUEOP
;	 error return
;	normal return
;
;Where <FNC> is the GALAXY function to be performed (.QUBAT for a batch
;request, etc.); and <ARG1> and <ARG2> are arguments depending on the
;specific <FNC> requested:
;
;.QUPRT			Print (LPT) file
;.QUCDP			Punch (CDP) file
;.QUPTP			Punch (PTP) file
;.QUPLT			Plot file
;.QUBAT			Batch Job Submission
;	ARG1		blank
;	ARG2		blank
;	.I1xxx(IO)	File specification
;	.IOPPN		USERID (ppn)
;	.IOACT		Account string
;	.IOQUN		Unit info (.QBUxx,,<unit>)
;	.IOQND		Destination node name
;	.IOQ6N		User name (SIXBIT, double-word)
;	.IOQ6J		User job (queue entry) name (SIXBIT)
;
;.QUMAE			Access Validation (USERID, etc.)
;	ARG1		Password (SIXBIT)
;	ARG2		blank
;	.IOPPN(IO)	USERID (ppn)
;	.IOACT(IO)	Account string
;
;A <FNC> of -1 is used by FAL to set the user name (and wnatever else
;is appropriate) of a spooled-ENTER file.
;
;On error return M0 contains the error code for the queue failure.
;
;On normal return the file has been successfully queued.
;
;Uses T1, T2, T3, T4.
IFN	<<QA.LEN&7B17>-7B17>,<PRINTX ?QA.LEN not left half in QUEOP>
IFN	<<QA.TYP&7B35>-7B35>,<PRINTX ?QA.TYP not right half in QUEOP>

	ENTRY	.QUEOP
	ENTRY	QUEOP0,	QUEOP1

.QUEOP:	PUSHJ	P,.SACIO##	;SETUP I/O CONTEXT
QUEOP0:	PUSHJ	P,.SAVE4##	;SAVE THE P'S ON G.P.S
QUEOP1:	PUSHJ	P,TSAV14##	;AND THE T'S TOO
	JUMPL	T2,QUEOS1	;IF NEGATIVE FUNCTION, THEN SPPRM.
	TXO	T2,QF.RSP	;WANT THE RESPONSE BLOCK BACK
	MOVEM	T2,.I1FL3+.QUFNC(IO)  ;SET QUEUE. FUNCTION WORD
	SETOM	.I1FL3+.QUNOD(IO)  ;SET QUEUE. NODE (CENTRAL HOST)
	XMOVEI	T2,.I1NSP(IO)	;ADDRESS OF NSP. BLOCK(S)
	HRLI	T2,.I1NSL	;LENGTH OF SAME
	MOVEM	T2,.I1FL3+.QURSP(IO)  ;MULTIPLEX RESPONSE BLOCK THERE

;NOW BUILD THE ARGUMENTS

QUEO10:	XMOVEI	P1,.I1FL3+.QUARG-1(IO)  ;START ADDRESS OF SUB-ARG LIST

;FINISH OFF QUEUE. BLOCK BASED ON FUNCTION REQUEST

	HRRZ	T2,-T2(P)	;REFETCH OPERATION TYPE
	JSP	T4,.CDISP##	;DISPATCH ON QUEUE. FUNCTION
		QUAV01,,.QUMAE	;ACCESS VALIDATION
		QUPR01,,.QUPRT	;LINE PRINTER PRINT SPOOL
		QUCD01,,.QUCDP	;CARD PUNCH SPOOL
		QUPT01,,.QUPTP	;PAPER TAPE PUNCH SPOOL
		QUPL01,,.QUPLT	;PLOTTER SPOOL
		QUBA01,,.QUBAT	;BATCH JOB SUBMISSION
		0		;THAT'S ALL
	STOPCD	<Unexpected QUEUE. function in QUEOP>


;BACK HERE TO ISSUE QUEUE., AND AWAIT RESULTS

QUEO70:	ANDI	P1,-1		;STRIP OFF POSSIBLE GARBAGE
	CAIL	P1,.I1GE3(IO)	;MAKE SURE WITHIN BOUNDS
	STOPCD	<QUEUE. block overran arg block>
	SUBI	P1,.I1FL3-1(IO)	;P1:=LENGTH OF PRIMARY ARG LIST
	XMOVEI	T1,.I1FL3(IO)	;T1:=ADDRESS OF QUEUE. BLOCK
	HRL	T1,P1		;T1:=LENGTH,,ADDRESS OF QUEUE. BLOCK
	QUEUE.	T1,		;GO KICK GALAXY
	 JRST	QUERR1		;SOMETHING DIDN'T WORK
	JRST	.POPJ1##	;ASSUME IT DID WORK
;HERE FOR QUEUE. ERROR TO TRY TO FIGURE OUT WHAT HAPPENED

QUERR1:	TXNE	T1,QU.RBT!QU.RBR;GET A RESPONSE BLOCK IN RETURN?
	JRST	QUERS1		;YUP
	CAIL	T1,0		;NO, QUEUE. ERROR CODE RETURNED
	CAILE	T1,QUERTL	;IS IT ONE WE RECOGNIZE?
	 SETO	T1,		;NO, OUT OF RANGE
	MOVE	M0,QUERTB(T1)	;TRANSLATE ERROR CODE
	POPJ	P,		;AND TAKE ERROR RETURN


;QUEUE. ERROR TABLE

	$EQXXX			;UNKNOWN OR UNSPECIFIED
QUERTB:	$EQXXX			;00  -	UNKNOWN OR UNSPECIFIED
	$EQIAL			;01  -  ILLEGAL ARGUMENT LIST
	$EQILF			;02  -  ILLEGAL FUNCTION
	$EQNFS			;03  -  NO MONITOR FREE CORE
	$EQADC			;04  -  ADDRESS CHECK
	$EQCNR			;05  -  COMPONET NOT RUNNING
	$EQFER			;06  -  FATAL ERROR RETURNED FROM ORION
	$EQSOC			;07  -  INVALID MESSAGE FROM ORION
	$EQNPV			;10  -  NOT PRIVILEGED

	QUERTL==.-QUERTB
;HERE TO DECIPHER THE RESPONSE BLOCK

QUERS1:	MOVE	P1,[POINT 7,.I1NSP(IO)]  ;RETURNED ASCIZ STRING
	PUSHJ	P,QUERST	;GET PREFIX CHARACTER TRIPLET
	MOVEI	T4,QERTBL	;GET THE PREFIX TABLE OF TABLES
	PUSHJ	P,.CFIND##	;IDENTIFY THE TABLE TO BE SEARCHED
	 JRST	QUERS9		;HO HUM GENERIC ERROR RETURN
	MOVE	T4,T1		;POSITION TABLE ADDRESS
	PUSHJ	P,QUERST	;GET ERROR CHARACTER TRIPLET
	PUSHJ	P,.CFIND##	;IDENTIFY THE INDIVIDUAL ERROR
	 JRST	QUERS9		;GENERIC ERROR RETURN
	MOVE	M0,T1		;RETURN ERROR CODE IN M0
	POPJ	P,		;PROPAGATE ERROR RETURN

QUERS9:	MOVEI	M0,$EQFUF	;QUEUE. FUNCTION FAILED
	POPJ	P,		;IT DIDN'T WORK


;HELPER TO RETURN SIXBIT TRIPLET OF CHARACTERS

QUERST:	ILDB	T1,P1		;FIRST CHARACTER
	MOVEI	T2,'0'-"0"(T1)	;FIRST CHARACTER
	ILDB	T1,P1		;SECOND CHARACTER
	LSH	T2,6		;POSITION AND
	IORI	T2,'0'-"0"(T1)	; ACCUMULATE SECOND CHARACTER
	ILDB	T1,P1		;THIRD ASCII CHARACTER
	LSH	T2,6		;POSITION AND
	IORI	T2,'0'-"0"(T1)	; ACCUMULATE THIRD CHARACTER
	POPJ	P,		;RETURN WITH T2/0,,TRIPLET
;ERROR TABLES FOR QUEUE. ERRORS FROM RESPONSE BLOCK TEXT

;TABLE OF TABLES FOR CLASS OF ERROR

QERTBL:	QERACT,,'ACT'		;ACTDAE ERRORS
	0,,	0		;NO OTHER KNOWN ERRORS


;ACCOUNTING ERRORS (ACTDAE)

QERACT:	$EQILP,,'NPP'		;ACTNPP NON-EXISTANT PPN
	$EQILP,,'ILP'		;ACTILP ILLEGAL PPN
	$EQIPW,,'IPW'		;ACTIPW INVALID PASSWORD
	$EQIVA,,'IVA'		;ACTIVA INVALID ACCOUNT STRING
	$EQPRA,,'JNP'		;ACTJNP JOB NOT PRIVILEGED [FOR ACCOUNTING]
	0			;NO OTHER ACCOUNTING ERRORS
;HELPER FOR SETTING FILE SPEC AND "ON-BEHALF-OF" ENTRIES

QUEF01:	PUSH	P1,[<.QBFS5+1,,.QBFIL>]  ;FILE SPEC BLOCK ARGUMENT
	XMOVEI	T2,.I1NSP(IO)	;ADDRESS OF SCRATCH BLOCK FOR FILE SPEC
	PUSH	P1,T2		;SET FIRST ARG ADDRESS
	MOVE	T2,.I1DEV(IO)	;DEVICE (STRUCTURE) NAME
	MOVEM	T2,.I1NSP+.QBFSR(IO)  ;SET SIXBIT STRUCTURE NAME
	MOVE	T2,.I1LKP+.RBNAM(IO)  ;FILE NAME
	MOVEM	T2,.I1NSP+.QBFFL(IO)  ;SET SIXBIT FILE NAME
	HLLZ	T2,.I1LKP+.RBEXT(IO)  ;FILE TYPE
	MOVEM	T2,.I1NSP+.QBFEX(IO)  ;SET SIXBIT EXTENSION,,0
	MOVE	T2,.I1PT2+.PTPPN(IO)  ;GET FILE PATH PPN
	MOVEM	T2,.I1NSP+.QBFPP(IO)  ;SET DIRECTORY NUMBER
	MOVE	T2,.I1PT2+.PTPPN+1(IO)  ;GET FIRST SFD
	MOVEM	T2,.I1NSP+.QBFS1(IO)  ;SET FIRST LEVEL SFD
	MOVE	T2,.I1PT2+.PTPPN+2(IO)  ;GET SECOND SFD
	MOVEM	T2,.I1NSP+.QBFS2(IO)  ;SET SECOND LEVEL SFD
	MOVE	T2,.I1PT2+.PTPPN+3(IO)  ;GET THIRD SFD
	MOVEM	T2,.I1NSP+.QBFS3(IO)  ;SET THIRD LEVEL SFD
	MOVE	T2,.I1PT2+.PTPPN+4(IO)  ;GET FOURTH SFD
	MOVEM	T2,.I1NSP+.QBFS4(IO)  ;SET FOURTH LEVEL SFD
	MOVE	T2,.I1PT2+.PTPPN+5(IO)  ;GET FIFTH SFD
	MOVEM	T2,.I1NSP+.QBFS5(IO)  ;SET FIFTH LEVEL SFD

;FAKE UP A JOB NAME BASED ON THE FILE NAME (TO AVOID QUASAR'S "XXXXXX")

QUEF03:	SKIPN	T1,.IOQ6J(IO)	;PICKUP "ON-BEHALF-OF" JOB NAME
	MOVE	T1,.I1LKP+.RBNAM(IO)  ;USE FILE NAME AS A DEFAULT
	JUMPE	T1,QUEF10	;LET GALAXY FIGURE IT OUT IF BLANK
	PUSH	P1,[QA.IMM!<1,,.QBJBN>]  ;"JOB" NAME ARGUMENT
	PUSH	P1,T1		;SET IMMEDIATE JOB NAME ARGUMENT

;SET USER PPN

QUEF10:	SKIPN	T1,.IOPPN(IO)	;GOT A "ON-BEHALF-OF" PPN?
	JRST	QUEF13		;NO
	PUSH	P1,[QA.IMM!<1,,.QBOID>]  ;USER PPN ARGUMENT
	PUSH	P1,T1		;SET IMMEDIATE ARG VALUE OF USERID PPN

;SET ACCOUNTING STRING INFO

QUEF13:	SKIPN	.IOACT(IO)	;GOT AN ACCOUNTING STRING?
	JRST	QUEF16		;NO
	PUSH	P1,[<^D8,,.QBACT>]  ;USER ACCOUNT STRING ARGUMENT
	XMOVEI	T2,.IOACT(IO)	;ADDRESS OF "ON-BEHALF-OF" ACCOUNT STRING
	PUSH	P1,T2		;SET ARGUMENT VALUE

;SET USER NAME

QUEF16:	SKIPN	.IOQ6N(IO)	;GOT A USER NAME?
	JRST	QUEF20		;NO
	PUSH	P1,[<2,,.QBNAM>];USER NAME ARGUMENT
	XMOVEI	T1,.IOQ6N(IO)	;ADDRESS OF USER-NAME
	PUSH	P1,T1		;SET IN QUEUE. BLOCK

;SET DESTINATION (NODE)

QUEF20:	SKIPN	T1,.IOQND(IO)	;GOT A DESTINATION NODE
	JRST	QUEF23		;NO
	PUSH	P1,[QA.IMM!<1,,.QBNOD>]  ;DESTINATION NODE ARGUMENT
	PUSH	P1,T1		;SET IMMEDIATE ARGUMENT VALUE

;SET UNIT INFO

QUEF23:	SKIPN	T1,.IOQUN(IO)	;GOT A UNIT SPECIFIED?
	JRST	QUEF99		;NO
	PUSH	P1,[QA.IMM!<1,,.QBUNT>]  ;UNIT ARGUMENT
	PUSH	P1,T1		;SET IMMEDIATE ARGUMENT VALUE

QUEF99:	JRST	.POPJ1##	;ALL DONE
;HERE TO FILL OUT A PRINT REQUEST

QUPR01:	PUSHJ	P,QUEF01	;SET FILE SPEC AND "ON-BEHALF-OF" STUFF
	 POPJ	P,		;DIED

;SET /LIMIT BASED ON FILE SIZE

QUPR10:	PUSH	P1,[QA.IMM!<1,,.QBLIM>]  ;PAGE COUNT LIMIT ARGUMENT
	MOVE	T1,.IOLNW(IO)	;GET LENGTH OF FILE (-10 WORDS)
	IDIVI	T1,4*^D128	;MIMIC QUEUE'S LIMIT ALGORITHM
	IMULI	T1,3		;WHICH IS 75% OF FILE BLOCK SIZE
	CAIGE	T1,10		;ALWAYS GIVE A MINIMUM LIMIT
	MOVEI	T1,10		;JUST TO PLAY IT SAFE!
	PUSH	P1,T1		;PAGE LIMIT

;CHECK /DISPOSITION:DELETE

QUPR93:	MOVE	T1,.IOIOM(IO)	;GET MODE CONTROL WORD
	TXNN	T1,IM.CDL	;DELETE ON CLOSE?
	JRST	QUPR99		;NO
	PUSH	P1,[QA.IMM!<1,,.QBODP>]  ;SET OUTPUT DISPOSITION TYPE
	PUSH	P1,[EXP .QBODR]	;DELETE ("RENAME") WHEN FINISHED PRINTING

QUPR99:	JRST	QUEO70		;DO THE QUEUE. UUO
;HERE TO FILL OUT A CARD PUNCH REQUEST

QUCD01:	PUSHJ	P,QUEF01	;SET FILE SPEC AND "ON-BEHALF-OF" STUFF
	 POPJ	P,		;DIED

;SET /LIMIT BASED ON FILE SIZE

QUCD10:	PUSH	P1,[QA.IMM!<1,,.QBLIM>]  ;CARD COUNT LIMIT ARGUMENT
	MOVE	T1,.IOLNW(IO)	;GET LENGTH OF FILE (-10 WORDS)
	IDIVI	T1,4*^D128	;MIMIC QUEUE'S LIMIT ALGORITHM
	IMULI	T1,33		;WHICH IS 8.25 TIMES FILE BLOCK SIZE
	CAIGE	T1,10		;ALWAYS GIVE A MINIMUM LIMIT
	MOVEI	T1,10		;JUST TO PLAY IT SAFE!
	PUSH	P1,T1		;CARD LIMIT

;CHECK /DISPOSITION:DELETE

QUCD93:	MOVE	T1,.IOIOM(IO)	;GET MODE CONTROL WORD
	TXNN	T1,IM.CDL	;DELETE ON CLOSE?
	JRST	QUCD99		;NO
	PUSH	P1,[QA.IMM!<1,,.QBODP>]  ;SET OUTPUT DISPOSITION TYPE
	PUSH	P1,[EXP .QBODR]	;DELETE (/DISP:RENAME) WHEN FINISHED

QUCD99:	JRST	QUEO70		;DO THE QUEUE. UUO
;HERE TO FILL OUT A PAPER TAPE PUNCH REQUEST

QUPT01:	PUSHJ	P,QUEF01	;SET FILE SPEC AND "ON-BEHALF-OF" STUFF
	 POPJ	P,		;DIED

;SET /LIMIT BASED ON FILE SIZE

QUPT10:	PUSH	P1,[QA.IMM!<1,,.QBLIM>]  ;PAPER TAPE LIMIT ARGUMENT
	MOVE	T1,.IOLNW(IO)	;GET LENGTH OF FILE (-10 WORDS)
	IDIVI	T1,4*^D128	;MIMIC QUEUE'S LIMIT ALGORITHM
	IMULI	T1,7		;WHICH IS 1.75 TIMES FILE BLOCK SIZE
	CAIGE	T1,10		;ALWAYS GIVE A MINIMUM LIMIT
	MOVEI	T1,10		;JUST TO PLAY IT SAFE!
	PUSH	P1,T1		;PAPER TAPE LIMIT

;CHECK /DISPOSITION:DELETE

QUPT93:	MOVE	T1,.IOIOM(IO)	;GET MODE CONTROL WORD
	TXNN	T1,IM.CDL	;DELETE ON CLOSE?
	JRST	QUPT99		;NO
	PUSH	P1,[QA.IMM!<1,,.QBODP>]  ;SET OUTPUT DISPOSITION TYPE
	PUSH	P1,[EXP 1]	;DELETE WHEN FINISHED?

QUPT99:	JRST	QUEO70		;DO THE QUEUE. UUO
;HERE TO FILL OUT A PLOT REQUEST

QUPL01:	PUSHJ	P,QUEF01	;SET FILE SPEC AND "ON-BEHALF-OF" STUFF
	 POPJ	P,		;DIED

;SET /LIMIT BASED ON FILE SIZE

QUPL10:	PUSH	P1,[QA.IMM!<1,,.QBLIM>]  ;PLOTTER LIMIT ARGUMENT
	MOVE	T1,.IOLNW(IO)	;GET LENGTH OF FILE (-10 WORDS)
	IDIVI	T1,15*^D128	;MIMIC QUEUE'S LIMIT ALGORITHM
	CAIGE	T1,2		;ALWAYS GIVE A MINIMUM LIMIT
	MOVEI	T1,2		;JUST TO PLAY IT SAFE!
	PUSH	P1,T1		;PLOT LIMIT

;CHECK /DISPOSITION:DELETE

QUPL93:	MOVE	T1,.IOIOM(IO)	;GET MODE CONTROL WORD
	TXNN	T1,IM.CDL	;DELETE ON CLOSE?
	JRST	QUPL99		;NO
	PUSH	P1,[QA.IMM!<1,,.QBODP>]  ;SET OUTPUT DISPOSITION TYPE
	PUSH	P1,[EXP 1]	;DELETE WHEN FINISHED?

QUPL99:	JRST	QUEO70		;DO THE QUEUE. UUO
;HERE FOR BATCH SUBMISSION

QUBA01:	PUSHJ	P,QUEF01	;SET FILE SPEC AND "ON-BEHALF-OF" STUFF
	 POPJ	P,		;DIED

;SET /TIME:01:00:00 (USER HAS NO WAY TO SET TIME, AND 5 MINUTES IS TOO SHORT)

QUBA10:	PUSH	P1,[QA.IMM!<1,,.QBLIM>]  ;RUNTIME LIMIT ARGUMENT
	PUSH	P1,[EXP ^D01*^D60*^D60]  ;TIME LIMIT (IN SECONDS)

;SET /OUTPUT:NOLOG (WELL, WHY NOT? THE USER CAN ALWAYS PRINT IT LATER)

QUBA16:	PUSH	P1,[QA.IMM!<1,,.QBLOG>]  ;OUTPUT LOG FILE CONTROL
	MOVE	T1,.IOIOM(IO)	;GET MODE CONTROL FLAGS
	TXNN	T1,IM.CPR	;PRINT ON CLOSE?
	SKIPA	T2,[EXP .QBLNL]	;NO, /OUTPUT:NOLOG
	MOVE	T2,[EXP .QBLLG]	;YES, /OUTPUT:LOG
	PUSH	P1,T2		;SET LOG FILE PRINT STATE

QUBA99:	JRST	QUEO70		;ALL SET, ISSUE QUEUE.
;HERE FOR ACCESS VALIDATION

QUAV01:	PUSH	P1,[QA.IMM!<1,,.QBAFN>]  ;SET ACCOUNTING SUBFUNCTION ARG TYPE
	PUSH	P1,[EXP UGACC$]	;ACCESS CONTROL CHECK

;BUILD IN-LINE ACCESS CHECK BLOCK (ACCOUNTING STUFF WORKS DIFFERENTLY FROM
;THE "NORMAL" GALAXY-RELATED QUEUE BLOCKS)

	PUSH	P1,[QA.IMM!<1,,.UGTYP>]  ;SET TYPE OF ACCESS CHECK
	PUSH	P1,[EXP UG.VER]	;STRAIGHT PPN/PASSWORD/ACCOUNT STRING
	PUSH	P1,[QA.IMM!<1,,.UGPPN>]  ;PPN ARGUMENT FOLLOWS
	PUSH	P1,.IOPPN(IO)	;IMMEDIATE PPN ARGUMENT
	PUSH	P1,[QA.IMM!<1,,.UGPSW>]  ;PASSWORD ARGUMENT IS NEXT
	PUSH	P1,-T3(P)	;IMMEDIATE PASSWORD AGRUMENT
	PUSH	P1,[<10,,.UGACT>]  ;INDIRECT ACCOUNT STRING FOLLOWS LAST
	XMOVEI	T2,.IOACT(IO)	;ADDRESS OF ACCOUNT STRING
	PUSH	P1,T2		;SET INDIRECT ACCOUNT STRING ARGUMENT

;ASK ACTDAE TO VALIDATE USER PPN/PASSWORD/ACCOUNT STRING

	ANDI	P1,-1		;MASK OFF JUNK
	SUBI	P1,.I1FL3-1(IO)	;P1:=LENGTH OF PRIMARY ARG LIST
	XMOVEI	T1,.I1FL3(IO)	;T1:=
	HRL	T1,P1		;LENGTH,,ADDRESS OF QUEUE. ARG BLOCK TO
	QUEUE.	T1,		;VERIFY PPN/PASSWORD/ACCOUNT STRING
	 JRST	QUERR1		;FAILED
	MOVSI	T2,.I1NSP(IO)	;ADDRESS OF RETURNED RESPONSE BLOCK
	HRRI	T2,.IOACT(IO)	;ADDRESS OF USER ACCOUNT STRING
	BLT	T2,.IOACT+7(IO)	;COPY OVER ACTDAE'S RETURNED ACCOUNT STRING

;NOW MUST SETUP FOR "OBTAIN USER PROFILE"
;
;	GAWD HOW I ***HATE*** ACCOUNTING

	XMOVEI	P1,.I1FL3+.QUARG-1(IO)  ;RESET QUEUE. ARG BLOCK SUB-ARG PTR
				; .QUFNC AND .QURSP BLOCKS STILL SET FROM
				; ORIGINAL QUEUE. CALL . . .
	PUSH	P1,[QA.IMM!<1,,.QBAFN>]  ;ACCOUNTING SUBFUNCTION ARG TYPE
	PUSH	P1,[EXP UGOUP$]	;OBTAIN USER PROFILE SUBFUNCTION FUNCTION
	PUSH	P1,[QA.IMM!<1,,.UGPPN>]  ;PPN ARGUMENT FOLLOWS (AGAIN)
	PUSH	P1,.IOPPN(IO)	;IMMEDIATE PPN ARGUMENT (AGAIN)

;NOW ASK ACTDAE FOR THE USER'S NAME . . .

	ANDI	P1,-1		;MASK OFF JUNK
	SUBI	P1,.I1FL3-1(IO)	;P1:=LENGTH OF PRIMARY ARG LIST
	XMOVEI	T1,.I1FL3(IO)	;T1:=
	HRL	T1,P1		;LENGTH,,ADDRESS OF QUEUE. ARG BLOCK TO
	QUEUE.	T1,		;FIND OUT THE USERS SIXBIT NAME.
	 JRST	QUERR1		;FAILED
	DMOVE	T2,.I1NSP+1+.ACNM1(IO)  ;GET THE USER'S NAME (SIXBIT DOUBLEWORD)
	DMOVEM	T2,.IOQ6N(IO)	;AND SET IN THE CDB FOR OTHER QUEUE.'S
	JRST	.POPJ1##	;ASSUME ALL IS ROSY
;HERE FOR SPOOLED-ENTER OPERATIONS (E.G., FROM FAL)

QUEOS1:	SETZM	.I1LK3(IO)	;CLEAR START OF ARG BLOCK
	MOVSI	T4,.I1LK3(IO)	;CONCOCT A
	HRRI	T4,.I1LK3+1(IO)	; BLT POINTER TO
	BLT	T4,.I1LK3+.SPMAX-1(IO)  ;CLEAR SPPRM. BLOCK
	MOVX	T1,.SPSFP	;SPPRM. FUNCTION: SET PARAMETERS
	MOVEM	T1,.I1LK3+.SPPFN(IO)  ;SET IN SPPRM. BLOCK
	SKIPN	T1,.IOCHN(IO)	;GET CHANNEL WITH SPOOLED FILE
	STOPCD	<No I/O channel in QUEOS1>
	MOVEM	T1,.I1LK3+.SPPDN(IO)  ;SET IN SPPRM. BLOCK
	DMOVE	T1,.IOQ6N(IO)	;GET USER NAME (SIXBIT)
	DMOVEM	T1,.I1LK3+.SPNM1(IO)  ;SET IN SPPRM. BLOCK
	MOVSI	T1,.SPNM2+1	;LENGTH AND
	HRRI	T1,.I1LK3(IO)	;ADDRESS FOR SPPRM. TO
	SPPRM.	T1,		;SET SPOOLING PARAMETERS
	 JRST	QSERR1		;SPPRM. FAILED
	JRST	.POPJ1##	;ALL DONE HERE
;HERE TO DECIHPER SPPEM. UUO FAILURE

QSERR1:	CAML	T1,[-1]		;ERROR CODE IN RANGE?
	CAILE	T1,QSERTL	; . . .
	 MOVNI	T1,2		;NO
	MOVE	M0,QSERTB(T1)	;TRANSLATE ERROR CODE
	POPJ	P,		;PROPAGATE ERROR RETURN


;SPPRM. ERROR TABLE

	$EQXXX			;UNKNOWN ERROR
	$EQPAC			;-1  -  ADDRESS CHECK
QSERTB:	$EQPIA			;00  -  ILLEGAL ARG LIST LENGTH
	$EQPID			;01  -  ILLEGAL DEVICE
	$EQPNA			;02  -  DEVICE NOT OPENED
	$EQPNS			;03  -  NOT A SPOOLED DEVICE
	$EQPNS			;04  -  NO MONITOR FREE CORE
	$EQPIF			;05  -  ILLEGAL SPPRM. FUNCTION CODE

	QSERTL==.-QSERTB
	END