Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
7/galaxy-sources/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) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
; 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 THAT IS NOT SUPPLIED BY DIGITAL.
TWOSEG
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==6 ;VERSION OF QMANGR
QMAMIN==0 ;MINOR VERSION NUMBER
QMAEDT==:6001 ;EDIT NUMBER
%%.QMA==VRSN.(QMA)
LOC 137
EXP %%.QMA
RELOC
Subttl Table of Contents
; Table of Contents for QMANGR
;
; Section Page
;
;
; 1. Revision History . . . . . . . . . . . . . . . . . . . 3
; 2. Queue Independent Header . . . . . . . . . . . . . . . 4
; 3. Input Queue Header Extension . . . . . . . . . . . . . 6
; 4. Output Queue Header Extension . . . . . . . . . . . . 7
; 5. File Specification Block . . . . . . . . . . . . . . . 8
; 6. Filespec MODIFY Block . . . . . . . . . . . . . . . . 9
; 7. Paper Formats . . . . . . . . . . . . . . . . . . . . 10
; 8. Control, Log, and Output File Offsets . . . . . . . . 11
; 9. Additional Macros . . . . . . . . . . . . . . . . . . 12
; 10. Entry and Exit Sections . . . . . . . . . . . . . . . 15
; 11. CREATE . . . . . . . . . . . . . . . . . . . . . . . . 17
; 12. KILL . . . . . . . . . . . . . . . . . . . . . . . . . 23
; 13. MODIFY . . . . . . . . . . . . . . . . . . . . . . . . 24
; 14. LIST . . . . . . . . . . . . . . . . . . . . . . . . . 27
; 15. DEFER & ZDEFER . . . . . . . . . . . . . . . . . . . . 30
; 16. Subroutines . . . . . . . . . . . . . . . . . . . . . 31
; 17. Data Storage . . . . . . . . . . . . . . . . . . . . . 44
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
;
; 2253 Fix copyright. GCO 4.2.1528
;
;***** Release 6.0 -- begin development edits *****
;
;6000 6.1037 26-Oct-87
; Move sources from G5: to G6:
;
;6001 6.1225 8-Mar-88
; Update copyright notice.
;
; 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
;;4-5 RESERVED TO DEC
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
;12-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)
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
;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 ;BACK TO HIGH
; 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
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
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
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
MOVEM TF,SPCFCT ; 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
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
SKIPLE FORVER(E) ;SKIP IF QFV= 0 OR 1
JRST CREINC ;SKIP THE OUTPUT QUEUE STUFF
LOAD T1,Q.IDEP(S1),QI.OUT ;GET /OUTPUT
MOVEI T2,%EQOLG ;ASSUME /OUT:LOG
SKIPN T1 ;WAS IT /OUT:0?
MOVEI T2,%EQONL ;YES, MAKE IT /OUT:NOLOG
STOLIM T2,.EQLIM(M),OUTP ;AND STORE THE VALUE
JRST CREINC ;SKIP LIMIT CALC IF INPUT QUEUE
CREA.6: LOAD T1,Q.ILIM(S1),QS.LIM ;GET OUTPUT LIMIT
SKIPLE SPCFCT ; Do we have abnormal spacing?
IMUL T1,SPCFCT ; 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:)
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.
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: 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
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
> ;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
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
E.LEN:! ;LENGTH OF AREA NEEDED
DEPHASE
RELOC ;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