Trailing-Edge
-
PDP-10 Archives
-
BB-H138A-BM
-
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: C