Trailing-Edge
-
PDP-10 Archives
-
bb-d868b-bm_tops20_v3a_2020_dist
-
3a-sources/d60qmr.mac
There are 2 other files named d60qmr.mac in the archive. Click here to see a list.
TITLE QMANGR -- MPB interface to GALAXY
SUBTTL Chuck O'Toole 21 JUL 77 (+JBS 15-MAY-77)
SEARCH QSRMAC ;GALAXY PARAMETERS
SEARCH SBSMAC ;SUB-SYSTEMS GROUP MACROS
SEARCH MACTEN ;USEFUL MACROS
SEARCH UUOSYM ;TOPS10-UUO SYMBOLS
IFN FTJSYS,<SEARCH MONSYM> ;TOPS20-JSYS SYMBOLS
SEARCH QPRM ;MPB PARAMETERS
INTERN %%.QSR ;VERSION NUMBER OF QUASAR
INTERN %%.SBS ;VERSION NUMBER OF SBSMAC
SALL ;CLEAN UP THE LISTING
VWHO==1 ;LAST EDITOR
VQMANG==102 ;VERSION OF QMANGR
VMINOR==1 ;MINOR VERSION NUMBER
VEDIT==102064 ;EDIT NUMBER
LOC 137
BYTE (3)VWHO (9)VQMANG (6)VMINOR (18)VEDIT
TWOSEG
RELOC 0
RELOC 400000
;COPYRIGHT (C) 1974, 1975, 1976, 1977, 1978 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;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.
; THIS PROGRAM WAS DEVELOPED TO AID IN CONVERSION TO THE GALAXY-10!-20 SYSTEM.
; IT IS TO PERFORM THE TRANSLATION, AS BEST AS IT CAN, FROM THE STYLE OF DATA
; USED BY THE MPB SYSTEM TO THE FORMAT USED BY GALAXY-10!-20.
; NO ATTEMPT IS MADE TO CORRECTLY FILTER EVERY FORM OF BAD DATA OR TO PRODUCE
; DIAGONISTICS FOR ALL INCORRECT USAGES.
;IN FACT, THIS PROGRAM MAKES SEVERAL ASSUMPTIONS OF GOOD INFORMATION AND IS QUITE
; PRONE TO ?ILL MEM REFS AND THE LIKE WHEN FED GARBAGE.
;HOWEVER, THERE IS ONE GUARANTEE.. IF THIS IS CALLED BY QUEUE, SPRINT, BASIC, OR
; FOROTS (ALL OF WHICH ARE SUPPORTED PRODUCTS AND PRODUCE GOOD DATA),
; ALL THE RIGHT THINGS HAPPEN.
;THE FUNCTIONS SUPPORTED ARE LIST, KILL, MODIFY, AND CREATE. THE OTHERS THAT WERE
; IN THE REPITOIR OF MPB QMANGR REQUIRE THAT THE CALLER BE CHANGED
; THE "SPEAK GALAXY-ESE" VIA IPCF AND UNDERSTAND THE NEW DATA BASE FORMAT.
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.
; 102064 LCG ANVANCED SOFTWARE GROUP - DN60 PROJECT:
; CHANGED LOCATE/WHERE TO REFERENCE GLOBAL .MYSTA
; AND CORGET TO CALL M$ACQP.
; NOTE THAT THE "LIST" FUNCTION WILL NOT WORK IN D60QMR.
; TO SIMPLIFY READING THESE EDITS, THE ORIGINAL CODE
; IS UNDER REPEAT 0, AND THE NEW CODE UNDER REPEAT 1.
;
; End of Revision History
SUBTTL Additional Macros
; 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 TEMP
DEFINE DATAM(SWRD,SFIELD,DWRD,DFIELD)<
LOAD(TEMP,SWRD,SFIELD)
XLIST
STORE(TEMP,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 FILE SPECIFIC 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
SUBTTL Entry and Exit Sections
QMANGR: JFCL ;ENTRY POINT BY CONVENTION
REPEAT 0,<
PUSH P,.JBFF## ;SAVE ORIGINAL .JBFF
MOVE E,.JBFF## ;GET BASE FOR TEMP STORAGE
GCORE E.LEN ;GET REQUIRED CORE
>
REPEAT 1,<
MOVEI E,EBLOCK ;USE DEDICATED SPACE IN D60QMR
>
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
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:
REPEAT 0,<
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
REPEAT 0,<
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
CAIN H,.QIHED ;THE INPUT QUEUE
CAIN P4,2 ;YES, 2 FILES SPECIFIED
SKIPA ;ALL IS WELL
FAIL(<INF Illegal Number of Files in INPUT Request>)
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 ALL 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
DATAM Q.FMOD(P1),QF.LOG,.FPINF(S2),FP.FLG
DATAM Q.FMOD(P1),QF.COP,.FPINF(S2),FP.FCY
LOAD TEMP,Q.FMOD(P1),QF.NFH ;GET THE FILE HEADER BIT
SETCA TEMP, ;FLIP
STORE TEMP,.FPINF(S2),FP.NFH
LOAD TEMP,Q.FMOD(P1),QF.DSP ;GET THE /DISP: VALUE
CAIN TEMP,.QFDPR ;WAS IT PRESERVE
TDZA TEMP,TEMP ;YES, ZERO TEMP AND SKIP
MOVEI TEMP,1 ;NO, GET A BIT
STORE TEMP,.FPINF(S2),FP.DEL ;SET THE DELETE BIT CORRECTLY
MOVE TEMP,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 TEMP,007777 ;A TAG OR A NUMBER
LSH TEMP,6 ;A TAG, POSITION IT LEFT
CREA.2: MOVEM TEMP,.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
ADDI S2,(T1) ;NOW FOR THE FILE DESCRIPTOR
STORE T1,FBTEMP+.FPSIZ(E),FP.FHD ;STORE SIZE OF PARAMETERS
PUSHJ P,BLDFDA ;BUILD A PROPER FD AREA
LOAD P3,FBTEMP+.FPSIZ(E),FP.FHD ;FP AREA LENGTH
LOAD T1,FBTEMP+.FPSIZ(E),FP.FFS ;FD AREA LENGTH
ADDI P3,(T1) ;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: IFN FTSPLIT,<
CAME T4,.EQLEN(M) ;SAME STRUCTURE
JRST CREA.4 ;NO, TRY THE NEXT
> ;END OF IFN FTSPLIT
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:
REPEAT 0,<
MOVE M,.JBFF## ;GET ADDRESS OF A NEW MESSAGE
>
GCORE 1000 ;GET A PAGE FOR IT
REPEAT 1,<
MOVE M,T1 ;POINT TO PAGE
>
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
MOVE T1,Q.DEV(S1) ;DEVICE
TXNN T1,QD.GDN ;ONE SPECIFIED
JRST E.NOQS ;NO, GIVE ERROR
MOVEM T1,.EQRDV(M) ;STORE
IFN FTUUOS,<
DATAM Q.PPN(S1),,.EQOWN(M)
> ;END IFN FTUUOS
IFN FTJSYS,<
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
CREA.7: PUSHJ P,DOACCT ;FILL IN ACCOUNT STRING
> ;END IFN FTJSYS
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
REPEAT 0,<
HRROI T1,.GTLOC ;FIND MY STATION NUMBER
GETTAB T1, ;FROM THE LAST LOCATE COMMAND
SETZ T1, ;NO REMOTE CODE
>
REPEAT 1,<
MOVE T1,.MYSTA## ;GET LOCATION FOR THIS QUEUE ENTRY
>
STORE T1,.EQSEQ(M),EQ.DSN ;AS DEFAULT STATION NUMBER
DATAM Q.AFTR(S1),,.EQAFT(M) ;MOVE THE AFTER PARAMETER
DATAM Q.DEAD(S1),,.EQDED(M) ;MOVE THE DEADLINE
IFN FTUUOS,<
DATAM Q.USER(S1),,.EQUSR(M)
DATAM Q.USER+1(S1),,.EQUSR+1(M)
> ;END IFN FTUUOS
DATAM Q.IDEP(S1),,.EQLM1(M)
DATAM Q.ILIM(S1),,.EQLM2(M)
DATAM Q.ILM2(S1),,.EQLM3(M)
DATAM Q.ILM3(S1),,.EQLM4(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
> ;END OF IFN FTUUOS
LOAD T1,.EQLM1(M),EQ.UNI ;GET /UNIQUE:
SKIPE T1 ;SKIP IF 0
SOS T1 ;ELSE DECREMENT IT
STORE T1,.EQLM1(M),EQ.UNI ;AND STORE AWAY
LOAD T1,Q.ILIM(S1),QM.COR ;GET /CORE:words
ADDI T1,777 ;ROUND UP TO A PAGE BOUNDRY
ADR2PG T1 ;CONVERT TO PAGES
STORE T1,.EQLM2(M),EQ.COR ;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
STORE T2,.EQLM1(M),EQ.OUT ;AND STORE THE VALUE
CREA.6: LOAD T1,Q.ILIM(S1),QS.LIM ;GET OUTPUT LIMIT
STORE T1,.EQLM2(M),EQ.PGS ;STORE THE LIMIT
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
STORE T1,.EQLM2(M),EQ.NBL ;STORE FOR QUASAR
; FALL INTO INCLUDE THIS FILE ROUTINE
;CONTINUE WITH REQUEST CREATION
CREINC: INCR .EQSPC(M),EQ.NUM ;ADD ANOTHER FILE TO 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 TEMP,MS.ACK ;GET "ACK" BITS
IORM TEMP,.MSTYP(M) ;ASK FOR RESPONSE
MOVX TEMP,%%.QSR ;VERSION NUMBER OF THE MESSAGE
STORE TEMP,.EQLEN(M),EQ.VRS ;STORE FOR QUASAR
DATAM LENHDR(E),,.EQLEN(M),EQ.LOH ;STORE LENGTH OF REQUEST HEADER
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: SKIPE Q.CNO(S1) ;DID USER SPECIFY AN ACCT STRING?
JRST DOAC.3 ;YES, GO MOVE IT
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
DOAC.3: PUSH P,S2 ;SAVE S2
HRL S2,Q.CNO(S1) ;GET THE ADDRESS OF THE SOURCE
HRRI S2,.EQACT(M) ;AND THE DEST ADDRESS
BLT S2,.EQACT+7(M) ;BLT THE STRING
POP P,S2 ;RESTORE S2
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
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,<MS.ACK!INSVL.(KIL.SZ,MS.CNT)!INSVL.(.QOKIL,MS.TYP)>
MOVEM T1,.MSTYP(M) ;STORE IN MESSAGE HEADER
KILL.1: LOAD T1,Q.DEV(S1) ;GET THE QUEUE NAME
JUMPE T1,E.NOQS ;NONE, GIVE ERROR
STORE T1,KIL.QN(M) ;STORE QUEUE NAME
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
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>)
REPEAT 0,<
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
REPEAT 1,<
MOVE M,T1 ;POINT TO ACQUIRED PAGE
>
TXO M,1B0 ;INDICATE PAGE MODE MESSAGE
MOVX T1,<MS.ACK!INSVL.(MOD.SZ,MS.CNT)!INSVL.(.QOMOD,MS.TYP)>
MOVEM T1,.MSTYP(M) ;STORE IN MESSAGE HEADER
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 Q.DEAD(S1) ; *** GRP 0, WRD 2 = DEADLINE PARAMETER ***;
MOVE T1,Q.PRI(S1) ; *** GRP 0, WRD 3 = REQUEST PROTECTION ***;
CKCHNG QP.PRO ;CONVERT CHANGE CODES
PUSHJ P,GRPSTO ;STORE /PROTECTION
;NOW SET UP FOR QUEUE DEPENDENT INFORMATION
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
LOAD T1,Q.IDEP(S1),QI.UNI ; *** GRP 1, WRD 7 = UNIQUE ***;
SKIPN T1 ;CHANGE ?
TDOA T1,[-1] ;NO, SET NO CHANGE
SOS T1 ;MPB INTERNAL = EXTERNAL + 1
PUSHJ P,GRPSTO ;STORE /UNIQUE
LOAD T1,Q.IDEP(S1),QI.MNR ; *** GRP 1, WRD 8 = RESTART ***;
SKIPN T1 ;MODIFY /RESTART
TDOA T1,[-1] ;NO, SET NO CHANGE
LOAD T1,Q.IDEP(S1),QI.NRS ;GET THE NEW VALUE
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
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) ***;
; HERE FOR FILE SPECIFIC MODIFIES
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
FMOD.1: CAIL T2,(M) ;CHECK FOR THE RIDICULOUS
FAIL(<BML Bad MODIFY Lengths>)
SKIPN Q.FNAM(T2) ;ANY NAME SPECIFIED
JRST FMOD.5 ;A NULL BLOCK, IGNORE IT
IFN FTJSYS,<OUTSTR [ASCIZ/%QMRFSN File-Specific Modifies not supported yet.
/]
JRST KILL.1 ;AND FINISH OFF
> ;END OF IFN FTJSYS
IFN FTUUOS,< ;LARGE FEATURE TEST
MOVEI T3,Q.FRPT+2(T2) ;T3 = THE MODIFY MASKS
MOVE P2,P1 ;P2 = GROUP HEADER FOR FILE-SPECIFIC
MOVX T1,<.GPFSM,,0> ;THE FIRST WORD OF GROUP 2
PUSHJ P,GRPSTO ;STUFF INTO THE MODIFY MESSAGE
MOVEI P3,Q.FDIR+5(T2) ;LAST POSSIBLE PATH SPEC
SKIPN (P3) ;ANYTHING THERE
CAIGE P3,Q.FDIR(T2) ;NO, OFF THE BOTTOM
SKIPA ;FOUND THE PATH LENGTH
SOJA P3,.-3 ;KEEP LOOKING
SUBI P3,Q.FDIR-1(T2) ;COMPUTE THE LENGTH
MOVEI T1,3(P3) ;FD LENGTH + STR:SN.EXT FOR GRPSTO
PUSHJ P,GRPSTO ;STORE THE FD LENGTHS
MOVWRD Q.FSTR(T2) ;MOVE THE STRUCTURE
MOVWRD Q.FNAM(T2) ;THE NAME
HLLZ T1,Q.FEXT(T2) ;THE EXTENSION
PUSHJ P,GRPSTO ;STICK IT IN THERE TOO
MOVEI H,Q.FDIR(T2) ;WHERE THE PATH IS
MOVEI S2,(P3) ;THE LENGTH
FMOD.2: MOVWRD 0(H) ;MOVE THE PATH
INCR H ;TO NEXT ITEM
SOJG S2,FMOD.2 ;GET IT ALL
MOVE H,Q.FSTR(T2) ;MUST BUILD OUR OWN STR MASK
SETO T1, ;STANDARD MASK GENERATOR
JUMPE H,.+4 ; 0 = DSK = ANY STR
LSH T1,-6 ;MOVE THE MASK OVER
LSH H,6 ;AND THE CHARACTERS THE OTHER WAY
JUMPN H,.-2 ;GO UNTIL ALL GONE
SETCA T1, ;WANT A POSITIVE MASK
MOVSI H,'DSK' ;SEE IF ENDED UP GENERIC DSK
XOR H,Q.FSTR(T2) ;STANDARD MASKED CHECK
AND H,T1 ;GET RID OF THE JUNK
SKIPN H ;A MATCH FOR 'DSK'
SETZ T1, ;YES, ALL STRUCTURES MATCH
PUSHJ P,GRPSTO ;STORE THE MASK GENERATED
MOVWRD Q.FNMM(T3) ;FILE NAME MASK
HLLZ T1,Q.FEXM(T3) ;THE EXTENSION MASK
PUSHJ P,GRPSTO ;STORE IT
MOVEI H,Q.FDRM(T3) ;THE PATH MASKS
FMOD.3: MOVWRD 0(H) ;ONE AT A TIME
INCR H ;TO THE NEXT ONE
SOJG P3,FMOD.3 ;GET THEM ALL
MODCHG QF.IRP ; *** GRP 2, MOD WRD 0 = REMOVE ***;
PUSHJ P,GRPSTO ;STORE /REMOVE
MODCHG QF.NFH ; *** GRP 2, MOD WRD 1 = HEADERS ***;
SKIPL T1 ;SKIP IF NO CHANGE
TRC T1,1 ;FLIP IT FOR GALAXY
PUSHJ P,GRPSTO ;STORE /HEADER
MODCHG QF.SPC ; *** GRP 2, MOD WRD 2 = SPACING ***;
PUSHJ P,GRPSTO ;STORE /SPACING
MODCHG QF.PFM ; *** GRP 2, MOD WRD 3 = PAPER FORMAT ***;
PUSHJ P,GRPSTO ;STORE /PAPER
MODCHG QF.FFM ; *** GRP 2, MOD WRD 4 = FILE FORMAT ***;
PUSHJ P,GRPSTO ;STORE /FILE
MODCHG QF.DSP ; *** GRP 2, MOD WRD 5 = 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 ; *** GRP 2, MOD WRD 6 = COPY COUNT ***;
PUSHJ P,GRPSTO ;STORE /COPIES
MOVWRD Q.FRPT(T2) ; *** GRP 2, MOD WRD 7 = 1ST REPORT WORD ***;
MOVWRD Q.FRPT+1(T2) ; *** GRP 2, MOD WRD 8 = 2ND REPORT WORD ***;
LOAD T1,Q.FBIT(T2),QB.TAG ; *** GRP 2, MOD WRD 9 = 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
> ;END OF IFN FTUUOS FROM SEVERAL PAGES AGO
FMOD.5: ADDI T2,(T4) ;T2 = THE NEXT FILE BLOCK
SOJG P4,FMOD.1 ;CONTINUE IF SOME THERE
JRST KILL.1 ;FILL IN COMMON PART AND SEND MESSAGE
SUBTTL LIST
LISTEM: MOVEI M,FBTEMP(E) ;SHORT RECEIVE BLOCK
MOVX T1,<MS.ACK!INSVL.(LIS.SZ,MS.CNT)!INSVL.(.QOLIS,MS.TYP)>
MOVEM T1,.MSTYP(M) ;STORE
ZERO LIS.QN(M) ;CLEAR THE WORD FIRST
LOAD T1,Q.DEV(S1),QD.GDN ;GET THE QUEUE NAME REQUESTED
STORE T1,LIS.QN(M),LISQUE ;STORE IT
PUSHJ P,MSGSND ;SEND THE REQUEST
PUSHJ P,RCVACK ;GET "OK" FROM QUASAR BEFORE PROCEEDING
LOAD T1,Q.OPR(S1),QO.SCH ;GET ADDRESS OF LISTER
MOVEM T1,LISTER(E) ;SAVE FOR LATER PUSHJ'S
SETZM Q.MEM(S1) ;CLEAR CALLERS AREA
HRLI T1,Q.MEM(S1) ;BUILD BLT WORD
HRRI T1,Q.MEM+1(S1)
BLT T1,.QOHED(S1) ;CLEAR IT
MOVX T1,<INSVL.(.QOHED,QL.HLN)> ;FUDGE SIZE
MOVEM T1,Q.LEN(S1) ;FOR LISTER
MOVE P1,.JBFF## ;NOW FOR THE MESSAGES RETURNED
MOVEI P1,777(P1) ;COMPUTE THE FIRST NON-EX PAGE
TRZ P1,777 ;WISH I HAD M$NXPG
MOVEM P1,FSTMSG(E) ;SAVE ADDR OF FIRST MESSAGE
SETZB P2,P3 ;P2 = NUM REC., P3 = NUM IN ANS.
; FALL ONTO THE NEXT PAGE FOR THE LIST ANSWERS
IFN FTUUOS,<
LSH P1,-^D9 ;CONVERT TO A PAGE NUMBER
LIST.1: 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
FAIL(<LRF List answer receive failed>)
> ;END OF IFN FTUUOS
IFN FTJSYS,<
MOVEM P1,.JBFF## ;FAKE OUT THE COMPATABILITY PACKAGE
LSH P1,-^D9 ;CONVERT TO A PAGE NUMBER
LIST.1: 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
AOS P2 ;BUMP REC COUNT
MOVEI S2,(P1) ;FIND THE FIRST WORD OF THIS MESSAGE
LSH S2,^D9 ;TO A REAL ADDR
MOVE T1,(S2) ;GET THE DATA
TXZN T1,1B0 ;1B0 ON = LAST TO BE SENT
JRST LIST.2 ;NOT THE LAST
MOVEM T1,(S2) ;STORE WITH THE BIT OFF
HLRZ P3,T1 ;NOW KNOW HOW MANY ARE COMING
LIST.2: CAME P2,P3 ;DID I GET THEM ALL
AOJA P1,LIST.1 ;NO GET ANOTHER (DON'T KNOW THE ORDER)
MOVEM P2,NUMANS(E) ;SAVE NUMBER REC.
SETZM CURANS(E) ;CURRENT IS NOW ZERO (IT GETS AOSED)
LIST.3: PUSHJ P,FNDNEX ;FIND THE NEXT TO LIST
FAIL(<NEL No end of list for listing function>)
PUSHJ P,TOLIST ;PASS THE CURRENT PAGE
JRST QMRXIT ;ALL DONE
JRST LIST.3 ;GET THE NEXT PAGE TO PASS
FNDNEX: MOVE P4,NUMANS(E) ;GET NUMBER POSSIBLE
AOS P2,CURANS(E) ;BUMP TO THE NEXT
CAILE P2,(P4) ;TOO FAR
POPJ P, ;WHOOPS!!! A BUG
MOVE P1,FSTMSG(E) ;GET ADDR OF FIRST
FNDN.1: HLRZ P3,(P1) ;GET SEQUENCE NUMBER OF THIS
CAIN P3,(P2) ;ONE WE'RE LOOKING FOR
JRST CPOPJ1 ;YES, RETURN FOR LISTING
MOVEI P1,1000(P1) ;BUMP TO NEXT PAGE
SOJG P4,FNDN.1 ;TRY NOW
POPJ P, ;WHOOPS!!! ANOTHER BUG
TOLIST: MOVEI P2,LST.FT(P1) ;POINT TO FIRST IN LIST
MOVEI P3,LST.NU ;NUMBER POSSIBLE IN THIS PAGE
TOLI.1: SKIPN LST.JB(P2) ;END OF LIST ( JOBNAME=0 )
POPJ P, ;YES, GIVE DONE RETURN
DATAM LST.ST(P2),,Q.MEM(S1) ;MOVE REQUIRED STRUCTURE
DATAM LST.JB(P2),,Q.JOB(S1) ;MOVE JOB NAME
DATAM LST.SQ(P2),LS.SEQ,Q.SEQ(S1)
DATAM LST.SQ(P2),LS.PRO,Q.PRI(S1),QP.PRO
DATAM LST.PI(P2),LS.PRI,Q.PRI(S1),QP.PRI
DATAM LST.DV(P2),,Q.DEV(S1) ;MOVE SIXBIT DEVICE REQUEST
DATAM LST.PV(P2),,Q.PDEV(S1) ;PROCESSING DEVICE
IFN FTUUOS,<
DATAM LST.US(P2),,Q.USER(S1) ;1ST HALF USER NAME
DATAM LST.US+1(P2),,Q.USER+1(S1) ;OTHER HALF
> ;END IFN FTUUOS
DATAM LST.OI(P2),,Q.PPN(S1) ;PPN
DATAM LST.AF(P2),,Q.AFTR(S1) ;AFTER IF ANY
HRLI TEMP,LST.LM(P2) ;FIRST LIMIT WORD
HRRI TEMP,Q.IDEP(S1) ;INTO OLD FORMAT BLOCK
BLT TEMP,Q.IDEP+3(S1) ;MOVE 4 OF THE 5
LOAD TEMP,Q.DEV(S1),QD.GDN ;GET THE QUEUE NAME
CAIN TEMP,'INP' ;THE INPUT QUEUE
JRST TOLI.2 ;YES, FIX UP /CORE
MOVSS Q.ILIM(S1) ;NO, MPB LIMIT IS IN THE OTHER HALF
MOVX TEMP,FRMNOR ;GET THE NAME OF "NORMAL" FORMS
CAMN TEMP,Q.IDEP(S1) ;SAME??
SETZM Q.IDEP(S1) ;YES, SAVE PAPER, DON'T TYPE IT
JRST TOLI.3 ;NOW GO LIST IT
TOLI.2: LOAD TEMP,Q.ILIM(S1),EQ.COR ;GET /CORE:pages
PG2ADR TEMP ;CONVERT TO WORDS
DECR TEMP ;MAKE .JBREL FORMAT (LET 256K WORK)
STORE TEMP,Q.ILIM(S1),QM.COR ;STORE FOR QUEUE TO LIST
TOLI.3: PUSH P,S1 ;SAVE S1
PUSHJ P,@LISTER(E) ;CALL THE LISTER
POP P,S1 ;RESTORE POINTER
TOLI.4: MOVEI P2,LST.SZ(P2) ;BUMP TO NEXT ENTRY
SOJG P3,TOLI.1 ;AND GO
CPOPJ1: AOS (P) ;END OF THIS PAGE
CPOPJ: POPJ P, ;AND 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,<MS.ACK!INSVL.(DFR.SZ,MS.CNT)!INSVL.(.QODFR,MS.TYP)>
MOVEM T1,.MSTYP(M) ;STORE MESSAGE AND LENGTH
PJOB T1, ;FOR THIS JOB NUMBER
STORE T1,DFR.JB(M),DF.JOB ;STORE THE JOB NUMBER
MOVE T1,Q.DEV(S1) ;THE DEVICE TO RELEASE ( 0 IS ALL)
MOVEM T1,DFR.QN(M) ;STORE THE QUEUE NAME
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:
REPEAT 0,<
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
>
REPEAT 1,<
PUSH P,AP ;SAVE REGS
PUSH P,S1 ;
PUSH P,S2
PUSHJ P,M$ACQP## ;GET A PAGE
PG2ADR AP ;CONVERT TO ADDRESS
MOVE T1,AP ;PUT IN RIGHT REGISTER
POP P,S2 ;RESTORE REGS
POP P,S1
POP P,AP ;RESTORE REGISTER
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
OUTSTR [ASCIZ/?QMR/] ;ADD PREFIX
OUTSTR (T1) ;OUTPUT SUFFIX AND MESSAGE AFTER PREFIX
PUSHJ P,TTCRLF ;END THE LINE
FAIEXI: EXIT 1, ;EXIT AFTER THE OUTPUT
FAIL1(<CNC Can't CONTINUE -- try REENTER>)
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
INCR .MSTYP(M),MS.CNT ;ADD ANOTHER WORD STORED
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: OUTSTR [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
OUTCHR T3 ;DUMP IT OUT
TLNE T2,770000 ;END OF THE WORD
JRST TYSIX1 ;NO, GET ANOTHER
POPJ P, ;ALL DONE
;SUBROUTINE TO BUILD A PROPER FD AREA FROM THE MPB FILE BLOCK
;CALLED WITH S2 = .FDSTR IF TOPS10, .FDSTG IF TOPS20
; P1 = THE MPB FILE BLOCK
;CAN USE T1 - T4
;MUST FILL IN FP.FFS IN .FPSIZ
;FBTEMP(E) IS THE FP BLOCK, FP.FHD IS ALREADY SET
IFN FTUUOS,<
BLDFDA: MOVEI T1,FDMSIZ ;ASSUME SHORT DESCRIPTOR
STORE T1,FBTEMP+.FPSIZ(E),FP.FFS ;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 S2,.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,(S2) ;STORE THIS SFD
INCR S2 ;ADJUST CURRENT POINTER
INCR FBTEMP+.FPSIZ(E),FP.FFS ;FILE DESR IS ONE BIGGER
AOBJN T1,BLDF.2 ;GET THE NEXT
POPJ P, ;RETURN WITH GOOD FD AREA
> ;END OF IFN FTUUOS
IFN FTJSYS,<
BLDFDA: MOVEI T3,(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
REPEAT 0,<
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
REPEAT 1,<
PUSH P,S1 ;SAVE S1
PUSH P,S2 ; AND S2
MOVE S1,T3 ;POINT TO ANSWER AREA
MOVE S2,Q.FDIR(P1) ;PUT PPN IN S2
HRROI T1,[ASCIZ /DSK:/] ;STRUCTURE NAME STRING
PPNST ;CONVERT PPN TO STRING
ERJMP [FAIL(<CDD Cannot Determine Directory of file owner>)]
MOVE T3,S1 ;UPDATE BYTE POINTER
POP P,S2 ;RESTORE S2
POP P,S1 ; AND S1
>
REPEAT 0,<
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,-1(S2) ;THE NUMBER OF WORDS IN THE STRING
STORE T3,FBTEMP+.FPSIZ(E),FP.FFS ;AS LENGTH 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
;SUBROUTINES TO FLUSH THE RECEIVE QUEUE (NEEDED FOR TOPS10 ONLY)
IFN FTUUOS,<
QUEFLS: PUSHJ P,QUEQRY ;QUERY THE QUEUE
PJUMPE S2,CPOPJ ;RETURN WHEN EMPTY
PUSHJ P,QUEIGN ;IGNORE THE ENTRY
JRST QUEFLS ;AND KEEP GOING
QUEQRY: SETZB T1,T2 ;CLEAR QUERY BLOCK
SETZB T3,T4 ;FOR GOOD MEASURE
MOVE S2,[4,,T1] ;LENGTH,,ARGUMENTS
IPCFQ. S2, ;FIND OUT WHATS THERE
SETZ T4, ;NOTHING, CLEAR T4
MOVE S2,T4 ;COPY QUEUE STATUS INTO S2
JUMPE S2,CPOPJ ;RETURN IF NOTHING THERE
CAMN T2,QSRPID(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+^D2000> ;FLAGS,,NAP TIME
HIBER S2, ;WAIT FOR A REASONABLE TIME
JFCL ;WATCH THIS LOOP
JRST QUEWAT ;TRY NOW
> ;END OF IFN FTUUOS
; SUBROUTINE TO RECEIVE AN EXPECTED "ACK" FROM QUASAR
; IT RETURNS TO THE CALLER AFTER RECEIVING A "GOOD" ONE
; ISSUES AN ERROR MESSAGE AND QUITS ON A "BADDY"
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
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
LOAD S2,TEX.ST(M) ;GET THE MESSAGE STATUS WORD
TXNE S2,TX.NMS ;NORMAL "ACK" (NO MESSAGE ASSOCIATED)
JRST RCVA.3 ;YES, SEE IF IT IS TIME TO RETURN
TXNN S2,TX.MOR ;FIRST OF MANY
JRST RCVA.4 ;NO, OUTPUT THE MESSAGE
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: MOVEI T1,"[" ;CHARACTER FOR INFORMATIONAL MESSAGES
TXNN S2,TX.FAT!TX.WRN ;FATAL OR WARNING
JRST RCVA.2 ;NEITHER, JUST REPORT THE TEXT
MOVEI T1,"?" ;FATAL CHARACTER
TXNN S2,TX.FAT ;WAS IT FATAL
MOVEI T1,"%" ;NO, LOAD WARNING CHARACTER
OUTCHR T1 ;OUTPUT THE "?" OR "%"
OUTSTR [ASCIZ/QSR/] ;OUTPUT "QUASAR" PREFIX
LOAD T1,TEX.ST(M),TX.SUF ;GET THE MESSAGE SUFFIX
HRLZS T1 ;INTO THE OTHER SIDE FOR TTYSIX
PUSHJ P,TTYSIX ;OUTPUT THE FULL ERROR CODE
MOVEI T1," " ;GET ALIGNMENT CHARACTER
RCVA.2: OUTCHR T1 ;MAKE THE OUTPUT PRETTY
OUTSTR TEX.MS(M) ;AND FINALLY, OUTPUT THE MESSAGE
TXNN S2,TX.FAT!TX.WRN ;ANOTHER CHECK
OUTCHR ["]"] ;GEE..IT TAKES A LOT TO DO NICE WORK
PUSHJ P,TTCRLF ;END THE MESSAGE
TXNE S2,TX.FAT ;AGAIN, WAS IT FATAL
JRST FAIEXI ;YES, QUIT NOW
RCVA.3: TXNE S2,TX.MOR ;MORE COMING
JRST 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>)
SETO T4, ;FLAG INDICATING FIRST TRY
MSGS.1: MOVX T3,%SIQSR ;GETTAB FOR PID OF [SYSTEM]QUASAR
GETTAB T3, ;SEE IF IT IS RUNNING
FAIL(<SGF SYSID. GETTAB failed>)
MOVEM T3,QSRPID(E) ;REMEMBER QUASAR'S PID
SETOM RTYCNT(E) ;INIT RETRY COUNTER
JUMPN T3,MSGGO ;THERE HE IS, SEND THE MESSAGE
MOVEI T3,3 ;NOT UP YET, TRY A SLEEP
SLEEP T3, ;GIVE IT A CHANCE
AOJN T4,MSGS.1 ;JUMP IF ALREADY GAVE A MESSAGE
OUTSTR [ASCIZ/
%QMRWFQ Waiting For [SYSTEM]QUASAR to Start
/]
JRST MSGS.1 ;TRY NOW
MSGGO: SETZB T1,T2 ;CLEAR FLAGS,MY PID
MOVEI T4,(M) ;MESSAGE ADDRESS, T3 = QSRPID
LOAD S2,.MSTYP(M),MS.CNT ;GET THE LENGTH OF THE MESSAGE
TXNN M,1B0 ;IS THIS A PAGE MODE REQUEST
JRST MSGGO1 ;NO, SEND IT
MOVX T1,IP.CFV ;INDICATE A PAGE SEND
LSH T4,-^D9 ;CONVERT 'M' TO A PAGE NUMBER
MOVEI S2,1000 ;LENGTH MUST BE 1000
MSGGO1: HRL T4,S2 ;INCLUDE CORRECT SIZE IN HEADER
MSGGO2: MOVE S2,[4,,T1] ;ARGUMENT FOR SEND
IPCFS. S2, ;SEND THE MESSAGE
SKIPA ;FAILED, SEE WHY
POPJ P, ;RETURN TO CALLER
CAIE S2,IPCDD% ;QUASAR DISABLED
CAIN S2,IPCRS% ;OR MY QUOTA EXHAUSTED
JRST RETRY ;YES, TRY IT AGAIN
CAIE S2,IPCRR% ;QUASAR FULL
CAIN S2,IPCRY% ;OR SYSTEM FULL
JRST RETRY ;YES, TRY IT AGAIN
FAIL1(<SQF Send to [SYSTEM]QUASAR failed>)
RETRY: MOVEI S2,2 ;WAIT BEFORE TRYING AGAIN
SLEEP S2, ;TAKE A QUICK NAP
AOSE RTYCNT(E) ;COUNT THE RETRIES
JRST MSGGO2 ;TRY NOW
OUTSTR [ASCIZ/
%QMRMBR Send has failed, Message Being Re-sent
/]
JRST MSGGO2 ;NOW RETRY IT
> ;END OF IFN FTUUOS
IFN FTJSYS,<
MSGSND: SETO T4, ;FLAG INDICATING FIRST TRY
PUSH P,S1 ;SAVE USER BASE
MSGS.1: MOVEI S1,3 ;NUMBER OF WORDS
MOVEI S2,T1 ;USE T1-T3
MOVEI T1,.MURSP ;READ SYSTEM PID TABLE
MOVX T2,.SPQSR ;WANT PID OF SYSTEM QUASAR
MUTIL ;READ THE TABLE
SETZ T3, ;ASSUME IT CONTAINS AN INVALID PID
MOVEM T3,QSRPID(E) ;REMEMBER QUASAR'S PID
SETOM RTYCNT(E) ;INIT RETRY COUNTER
JUMPN T3,MSGGO ;JUMP IF QUASAR IS RUNNING
MOVEI S1,^D3000 ;WAIT FOR IT
DISMS ;TAKE A NAP
AOJN T4,MSGS.1 ;JUMP IF ALREADY GAVE A MESSAGE
OUTSTR [ASCIZ/
%QMRWFQ Waiting For [SYSTEM]QUASAR to Start
/]
JRST MSGS.1 ;TRY NOW
MSGGO: SETZ T1, ;ASSUME NO FLAGS
SKIPN T2,MYPID(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 A PAGE
MSGGO1: HRL T4,S2 ;INCLUDE THE LENGTH
MOVEI S1,4 ;FOUR WORDS
MOVEI S2,T1 ;IN T1-T4
MSEND ;SEND THE PACKET
JRST MSGGO2 ;FAILED, SEE WHY
SKIPN MYPID(E) ;DO I ALREADY HAVE THE PID
MOVEM T2,MYPID(E) ;NO, SAVE IT
POP P,S1 ;RESTORE S1
POPJ P, ;AND RETURN TO CALLER
;MORE OF THE TOPS20 VERSION ON THE NEXT PAGE
MSGGO2: CAIE S1,IPCFX6 ;CHECK FOR EXHAUSTED QUOTAS
CAIN S1,IPCFX7 ;AND RETRY IF POSSIBLE
JRST RETRY ;IS POSSIBLE
CAIE S1,IPCFX8 ;ANOTHER RECOVERABLE ERROR
CAIN S1,IPCFX5 ;QUASAR DISABLED
JRST RETRY ;YES, TRY AGAIN
FAIL1(<SQF Send to [SYSTEM]QUASAR failed>)
RETRY: SKIPN MYPID(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
OUTSTR [ASCIZ/
%QMRMBR Send has failed, Message Being Re-sent
/]
JRST MSGGO ;AND TRY THE SEND AGAIN
> ;END OF IFN FTJSYS
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,LIS.SZ,DFR.SZ>
FBAREA==MAXSIZ ;THE LARGEST FILE BLOCK/MESSAGE NEEDED
RELOC QMANGR ;ORG OVER CODE TO SAVE SPACE
PHASE 0
MYPID:! BLOCK 1 ;MY PID (NECESSARY FOR SEND/RECEIVE)
QSRPID:! BLOCK 1 ;PID OF SYSTEM QUASAR
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
E.LEN:! ;LENGTH OF AREA NEEDED
DEPHASE
RELOC 0 ;NOW, IF LOADED WITH QUEUE, DEFINE REGISTER SAVE
RSA: BLOCK 17 ;AC'S 0-16 ARE SAVED HERE WHEN LOADED WITH QUEUE
REPEAT 1,<
EBLOCK: BLOCK E.LEN ;SPACE TO USE FOR MISCELLANEOUS
>
END ;END, NO STARTING ADDRESS