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