.MCALL .MODULE .MODULE MQ, VERSION=04, COMMENT=, AUDIT=YES ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only 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 except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. .SBTTL ******************************** .SBTTL * Message Queue (MQ) Handler * .SBTTL ******************************** ;+ ; The message handler is set up to look like a device handler. ; On entry, if there is no matching operation waiting for this entry, ; the current operation is stored in the internal queue of waiting requests. ; If a matching operation is found, the message is copied ; and the queue elements used are freed for reuse. ; ; Removed from RMON and made a separate device handler - 5/85 bc ; ; Updated to reflect RMON changes thru V5.4D, to use data structure ; definitions .MCALLed from SYSTEM.MAC, and code cleanup - 1/88 jrg ;- .SBTTL Macro Calls .LIBRARY "SRC:EDTL.MLB" ; .LIBRARY "SRC:SYSTEM.MLB" .MCALL .ADDR .ASSUME .BR DEFALT .DRDEF ;SYSMAC .MCALL .CF3DF .CHNDF .ERRDF .FIXDF .IBKDF ;SYSTEM .MCALL .IMPDF PUT .SGNDF .SYCDF .USSDF ;SYSTEM .SBTTL Structure Definition Macros .CF3DF ;Configuration Word 3 Bit Definitions .CHNDF ;I/O Channel Format .ERRDF ;EMT Error Code Definitions .FIXDF ;RMON Fixed Offset Area Definitions .IBKDF ;I.BLOK Blocking Condition Bit Definitions .IMPDF ;Impure Area Layout .SGNDF ;SYSGEN Sysgen Features Word Format .SYCDF ;SYSCOM System Communications Area Definitions .USSDF ;Codes For Special Directory Requests .SBTTL Conditional Assembly Summary and Default Checking ;+ ;COND ; ; EIS$I (RTE$M!MMG$T) Use SOB instruction ; 0 Simulate SOB ; 1 Use real SOB ; ; MQH$P2 (0) Use extra PAR for buffer mapping (faster copy) ; 0 Use only PAR1 for mapping ; 1 Use both PAR1 and PAR2 for mapping ; NOTE: Forced to 0 if MMG$T=0 ; ; RTE$M (0) RTEM version (affects conditional defaults) ; 0 Not RTEM version ; 1 RTEM version ; ; MMG$T (0) Std. conditional ; TIM$IT Std. conditional (no code effects) ; ERL$G Std. conditional (no code effects) ; ;- DEFALT MMG$T FLAG ;Default to no memory mapping DEFALT MQH$P2 FLAG ;Default to not using PAR2 for messages DEFALT RTE$M FLAG ;Default to not RTEM DEFALT EIS$I ;Assume no EIS unless RTEM or XM .IIF EQ MMG$T, MQH$P2=0 ;No PAR2 use if not memory mapped .SBTTL Local Symbol, Macro and Storage Definitions ;+ ; Define null macro for unconditional branch source code formatting ;- .MACRO ...... .ENDM ...... ;+ ; Call SOB macro if no EIS ;- .IF EQ .MCALL SOB .ENDC ;EQ ;+ ; Local symbols ;- MXFJOBS =: 7 ;Maximum number of foreground jobs allowed in system L.LNAM =: 6 ;Length of an ASCII logical jobname LOW2UP =: 40 ;BIC mask to convert lower case to upper ;+ ; KT11 (Memory Management) Register Definitions ;- KISAR1 =: 172342 ;KERNEL I-Space Address Register 1 UISAR1 =: 177642 ;USER I-Space Address Register 1 UISDR1 =: 177602 ;USER I-Space Descriptor Register 1 AP$ACF =: 077406 ;Active Page Reg. - 8K w/NO SYS TRAP/ABORT Action Set VAPAR1 =: 020000 ;PAR1 low address for offset when using PAR2 also ;+ ; These notes came from Jackie P. ; ;Building I/O Queue Element Q.FUNC/Q.UNIT/Q.JNUM Word ;---------------------------------------------------- ; ;Normal 64 unit monitor and handler scenario: ;------------------------------------------- ; ;C.Unit : 00 HHH LLL HHH is the high unit digit ; LLL is the low unit digit ; ;Jobnum : 00 00J JJJ JJJJ is the job number in the even ; form: 2-16 ; ;Q.Func : RJ JJJ LLL | 0H HHW WWW WWWW is the regular function code ;Q.Unit FFFF is the 64 unit special function ;Q.JNum OR code. This represents the low 4 bits ; of a unit number between 360 and 377 ; RJ JJJ LLL | 1h hhF FFF R is reserved and is used by TSX+ ; hhh is the complement of HHH ; ; ;Normal 64 unit monitor and non-64 unit handler scenario: ;------------------------------------------------------- ; ;C.Unit : 00 000 LLL ; ;Jobnum : 00 00J JJJ ; ;Q.Func : RJ JJJ LLL | 00 00W WWW ;Q.Unit ;Q.JNum OR ; ; RJ JJJ LLL | 1F FFF FFF ; ; ;Non-64 unit scenario : ;-------------------- ; ;C.Unit : 00 000 LLL ; ;Jobnum : 00 00J JJJ ; ;Q.Func : RJ JJJ LLL | 00 00W WWW 1FFFFFFF is the special function ;Q.Unit code for 8 unit handlers (200-377) ;Q.JNum OR ; ; RJ JJJ LLL | 1F FFF FFF ; ; ;64 unit monitor with MQ scenario : ;-------------------------------- ; ;C.Unit : D0 00D DDD DDDD are bits used to indicate the ; destination job number 2-16 ;Jobnum : 00 00J JJJ ; ;Q.Func : RJ JJJ DDD | 00 0DW WWW d is the complement of the D ;Q.Unit ;Q.JNum ; ; ;Non-64 unit monitor with MQ : ;--------------------------- ; ;C.Unit : D0 00D DDD ; ;Jobnum : 00 00J JJJ ; ; D D D D ;Q.Func : RJ JJJ DDD | 00 00W WWW R,J are numbers that may be set ;Q.Unit by MQ. They should always ;Q.JNum have a value of 0. ; ; D ;So, in the final analysis, MQ will need to clear the J bit before using ;the job number. It uses the job number to compare aborting job numbers ;to so that it can cancel any messages that job sent. ; ;We also need to document the use of the reserved bit in SYSTEM.MAC. ;+ ; Invoke Handler Definition Macro ;- .DRDEF MQ,42,,0,0,0 .SBTTL ---------------------------------------------------- .SBTTL Installation Verification Section ;+ ; This code checks that MQ is not being installed as the system device, ; and that the system is not a Background Only system. If either check ; fails, a return with carry set is done to prevent installation. ;- .ENABL LSB .DRINS MQ ;Define block 0 install check stuff .ASSUME . EQ INSDAT BR 10$ ;Data device entry point, go do install check ............ .ASSUME . EQ INSSYS BR 20$ ;System device entry point, return error ............ 10$: MOV @#$SYPTR,R5 ;Get pointer to RMON fixed offset area CMPB #<1>,$JOBS(R5) ;Are we a Multi-job system BLE 20$ ;Branch if not (i.e., we are Background Only) TST (PC)+ ;C=0 (==> Install us) & skip next instruction 20$: SEC ;C=1 (==> Don't install us) RETURN ;Return to install code in KMON ............ .DSABL LSB .SBTTL ---------------------------------------------------- .SBTTL I/O Initiation Section .ENABL LSB ;+ ; This is where RMON calls us, when a new I/O request is received. ;- .DRBEG MQ ;+ ; Check whether the request is a USR or input/output function ;- MOV MQCQE,R3 ;R3 -> CQE MOV @#$SYPTR,R5 ;R5 -> RMON BIT #,$CNFG3(R5) ;Monitor supports extended units? BEQ 10$ ;Skip clear of high unit bits if not BICB #,Q$FUNC(R3) ;Clear out high bits of unit number 10$: MOVB Q$FUNC(R3),R4 ;R4 = SPFUN code BEQ MQIO ;Branch if not USR request .BR MQUSR ;Fall into USR function code ............ .DSABL LSB .SBTTL MQUSR - Handle USR Operations ;+ ; Perform USR operations on message channels ; ; R3 -> CQE at offset Q.BLKN ; R4 = SPFUN code ; R5 -> $RMON (fixed area) ;- .ENABL LSB MQUSR: .IF NE MMG$T MOV @#KISAR1,-(SP) ;Save PAR1 MOV Q$PAR(R3),@#KISAR1 ;Map to user logical job name block .ENDC ;NE MMG$T CMP R4,# ;LOOKUP, ENTER? (3,4 - only valid codes) BLT MQUNMAP ;CLOSE or DELETE do nothing but unmap ... ; ... (SPESHL will close channel for us) CMP R4,# ;If greater than 4, then ... BGT MQUNMAP ; ... must be RENAME, do nothing but unmap BIT #,$SYSGE(R5) ;Do we have system job support? BEQ MQERR1 ;If not, then LOOKUP/ENTER are errors MOV Q$BUFF(R3),R0 ;R0 -> logical job name MOV @R0,R1 ;Job name given? BNE 10$ ;Yes, go find job's impure area CMP R4,# ;No, this means any job. Is this an ENTER? BEQ MQERR1 ;*C Yes, null job name is an error RORB R1 ;*C Make target job number a 200 for 'any' job BR 20$ ............ 10$: CALL FINDJOB ;Yes, find pointer to other job's impure area BEQ MQERR1 ;Job doesn't exist, report error 1 BIT #,I.BLOK(R2) ;Job exists, is it running? BNE MQERR1 ;No, give an error MOVB I.JNUM(R2),R1 ;R1 = target job number .ASSUME Q.CSW EQ Q.BLKN-2 20$: MOV -(R3),R3 ;R3 -> CSW MOVB R1,C.UNIT(R3) ;Store target job number in channel BR MQUNMAP ;Go unmap and then exit ............ ;+ ; USR operation - error and exit code ;- MQERR1: MOV #,$SPUSR(R5) ;ERROR 1, no such job .BR MQUNMAP ............ MQUNMAP: .IF NE MMG$T MOV (SP)+,@#KISAR1 ;Restore PAR1 .ENDC ;NE MMG$T BR MQFIN ;Exit request ............ .DSABL LSB .SBTTL MQIO - Handle I/O Operations ;+ ; Perform I/O operations on message channels ; ; R3 -> CQE at offset Q.BLKN ;- .ENABL LSB MQIO: MOVB Q$JNUM(R3),R4 ;R4 = job, unit number ASR R4 ;Isolate job number ... ASR R4 ; ... ASR R4 ; ... BIC #^c,R4 ;Zero extraneous bits MOVB R4,Q$FUNC(R3) ;Save job number in SPFUN slot so ... ; ... MQABORT can find owner easily MOV Q$CSW(R3),R1 ;R1 -> CSW MOVB C.UNIT(R1),R1 ;R1 = target job number BIC #^c<377>,R1 ;Strip the auto sign extend TST Q$WCNT(R3) ;Assume a READ. What is it really? BEQ MQFIN ;A SEEK, all this for nothing BPL 20$ ;Process READ MOV R1,R2 ;R2 = job # (change queues on a WRITE) CMP R2,#<200> ;Is it 'any job'? BNE 10$ ;Not 'any job', so ok ;(Following was: JMP CHANER ;in RMON) BIS #,@Q$CSW(R3) ;Give hard error (EMT error 1) BR MQFIN ;Finish up ............ 10$: MOV R4,R1 ;Issuing job number to R1 BIS #<100000>,R1 ;Set hi bit to flag a WRITE MOV R2,R4 ;Request goes on target job's queue 20$: MOV R1,@R3 ;Put issuing job# in Q.BLKN for easy access .ADDR #,R4,ADD ;R0 -> internal list header + 4 BR 40$ ;Start loop ............ 30$: MOV R0,R4 ;R4 -> Q.BLKN (next) .ASSUME Q.LINK EQ Q.BLKN-4 40$: CMP -(R4),-(R4) ;Bump back to link word MOV @R4,R0 ;R0 -> waiting element BEQ 110$ ;Nothing there, store this one CMPB @R3,@R0 ;Do job numbers match? BEQ 50$ ;Yes TSTB @R0 ;Is waiting element a 'match any job'? BMI 60$ ;Yes, and waiting element must be a read TSTB @R3 ;Is new element a 'match any job'? BPL 30$ ;No, on to next element 50$: TST @R0 ;Is waiting element a READ? BPL 60$ ;Yes, need a WRITE to match TST @R3 ;A WRITE. Got a READ to match? BPL 70$ ;Yes, go transfer message BR 30$ ;On to next element ............ 60$: TST @R3 ;Need a WRITE to complete. Is this a WRITE? BMI 80$ ;Yes, go transfer message BR 30$ ;On to next element ............ 70$: MOV R3,R0 ;Swap queue element pointers ... MOV @R4,R3 ; ... (@R4 -> waiting element from before) ;+ ; R0 -> Read Qelement at Q.BLKN ; R3 -> Write Qelement at Q.BLKN ; @R4 -> Waiting Qelement at Q.BLKN ;- .ASSUME Q.BUFF EQ Q.BLKN+4 80$: CMP (R3)+,(R3)+ ;R3 -> Write Qelement at Q.BUFF CMP (R0)+,(R0)+ ;R0 -> Read Qelement at Q.BUFF .ASSUME Q.WCNT EQ Q.BUFF+2 MOV (R3)+,R1 ;R1 -> Source buffer ... ; ... (R3 -> Write Qelement at Q.WCNT) MOV (R0)+,R2 ;R2 -> Destination buffer ... ; ... (R0 -> Read Qelement at Q.WCNT) ;+ ; Now we map the user buffers ;- .IF NE MMG$T MOV #,R5 ;R5 -> Kernel I-space PAR1 .IF EQ MQH$P2 MOV @R5,-(SP) ;Save Kernel I-space PAR1 ... MOV @#UISAR1,-(SP) ; ... User I-space PAR1 ... MOV @#UISDR1,-(SP) ; ... and User I-space PDR1 MOV Q.PAR-Q.WCNT(R3),@R5 ;Map the source buffer ... MOV Q.PAR-Q.WCNT(R0),@#UISAR1 ; ... the destination buffer ... MOV #,@#UISDR1 ; ... and setup User I-space PDR1 .IFF ;EQ MQH$P2 .ASSUME KISAR2 EQ KISAR1+2 MOV (R5)+,-(SP) ;Save kernel PAR1 ... MOV @R5,-(SP) ; ... and PAR2 MOV Q.PAR-Q.WCNT(R3),-2(R5) ;Map the source buffer using PAR1 ... MOV Q.PAR-Q.WCNT(R0),@R5 ; ... and the destination using PAR2 ADD #,R2 ;Adjust destination references to PAR2 .ENDC ;EQ MQH$P2 .ENDC ;NE MMG$T ;+ ; Now, in order to avoid reading beyond the end of the source buffer, ; which may not be mapped, we use the minimum of the write and read ; transfer counts as the actual transfer count. ;- MOV @R3,-(SP) ;Get the write transfer count NEG @SP ;Make it positive MOV @R0,R0 ;Get the read transfer count CMP (SP)+,R0 ;Write more than read? BGE 90$ ;Yes, use read count MOV @R3,R0 ;No, use write count NEG R0 90$: .IF EQ MQH$P2 PUT R0,(R2)+ ;Return transfer count to receiver .IFF ;EQ MQH$P2 MOV R0,(R2)+ ;Return transfer count to receiver .ENDC ;EQ MQH$P2 ;+ ; Now we do the actual transfer ;- 100$: .IF EQ MQH$P2 PUT (R1)+,(R2)+ ;Transfer a word .IFF ;EQ MQH$P2 MOV (R1)+,(R2)+ ;Transfer a word .ENDC ;EQ MQH$P2 SOB R0,100$ ;Loop until transfer has completed ;+ ; Now we restore the PAR context we saved ;- .IF NE MMG$T .IF EQ MQH$P2 MOV (SP)+,@#UISDR1 ;Restore User PDR1 ... MOV (SP)+,@#UISAR1 ; ... User PAR1 ... MOV (SP)+,@R5 ; ... and Kernel PAR1 .IFF ;EQ MQH$P2 .ASSUME KISAR1 EQ KISAR2-2 MOV (SP)+,@R5 ;Restore Kernel PAR2 ... MOV (SP)+,-(R5) ; ... and PAR1 .ENDC ;EQ MQH$P2 .ENDC ;NE MMG$T .SBTTL MQFIN - I/O Completion Section ;+ ; Free up saved and current queue elements, return to monitor ;- MOV @R4,R0 ;Link wait queue forward (R0 -> freed element) MOV Q$LINK(R0),@R4 ;+ ; Fake out COMPLT by making waiting element look like CQE ;- CLR Q$LINK(R0) ;Clear link in waiting element so monitor ... ; ... won't link queue forward MOV MQCQE,R3 ;Save pointer to real CQE in R3 MOV R0,MQCQE ;Make waiting queue element into CQE CLRB Q$FUNC(R0) ;Clear SPFUN slot so SPSIZE: not clobbered MOV @#$SYPTR,R5 ;R5 -> RMON CALL @$QCOMP(R5) ;Complete the element ;+ ; Restore old CQE pointer so we can finish current request ;- MOV R3,MQCQE ;Restore real CQE to MQCQE: CLRB Q$FUNC(R3) ;Clear SPFUN slot so SPSIZE: not clobbered ;+ ; Complete CQE request processing ;- MQFIN: .DRFIN MQ ............ ;+ ; At this point request is on hold, waiting for a matching READ or WRITE. ; Since request is processed in System State, nothing else has been linked on, ; so we clear MQCQE, MQLQE to make sure this element is really gone. ;- 110$: MOV R3,@R4 ;Link the element to the end of the queue CLR Q$LINK(R3) ;Clear it's link word, it's the last element CLR MQCQE ;Clear MQCQE ... CLR MQLQE ; ... and MQLQE, too RETURN ;Return without completing operation ............ .DSABL LSB .SBTTL *** Utility Functions for USR Functions *** .SBTTL FINDJOB - Convert Taskname To Impure Area Pointer ;+ ; FINDJOB - Convert taskname to pointer to impure pointer ; ; R0 -> 3 words of ASCII taskname ; R5 -> RMON fixed offset area ; ; CALL FNDJOB ; ; R2 -> impure area of job ; Z bit set if job not found ; ; MUST PRESERVE R3 AND R5 ;- .ENABL LSB FINDJOB:MOV $IMPLO(R5),R4 ;Get IMPLOC, R4 -> after impure table MOV #,R2 ;Set up loop count MOV R0,R1 ;Copy pointer to start of buffer for TOUPPER CALL TOUPPER ;Convert logical jobname to all uppercase CMP #<'F>,@R0 ;Looking for FG job? BNE 20$ ;No, not so easy MOV -(R4),R2 ;Point to FCNTXT:, set Z bit if not there RETURN ;Return with Z bit appropriately set ............ 10$: MOV @R4,R2 ;Get pointer from table BEQ 20$ ;No job here ;+ ; The following definition is here, so that if we are being built without ; system job support, we don't get warning errors when linking. The value ; of 1 will cause a trap to 4 if we ever get to this code. We shouldn't ; ever get here if we have no system job support (see test in MQUSR code). ;- DEFALT I.LNAM 1 ADD #,R2 ;Point to logical job name CMP (R2)+,@R0 ;Match part 1? BNE 20$ ;No CMP (R2)+,2(R0) ;Match part 2? BNE 20$ ;Still no CMP (R2),4(R0) ;Match part 3? BNE 20$ ;No, not this job MOV @R4,R2 ;R2 -> impure area of job we matched TST I.JNUM(R2) ;Did it match background job? BNE 40$ ;No, can't be KMON TST $KMONI(R5) ;Yes, is KMON running? BEQ 40$ ;If not, this is a match 20$: CMP #<-1>,-(R4) ;End of table? BNE 10$ ;No 30$: TST (R4)+ ;R4 -> BCNTXT: MOV @R4,R2 ;R2 -> background impure area CMP #<'B>,@R0 ;Looking for BG job? BNE 50$ ;No, not a match 40$: TST (PC)+ ;A match! Clr Z bit & *** Skip next instr! *** 50$: SEZ ;Set Z bit RETURN ;Au reservoir. ............ .DSABL LSB .SBTTL TOUPPER - Convert an ASCII string to all uppercase ;+ ; TOUPPER - Convert an ASCII string to all uppercase ; ; R1 -> ASCII string to convert ; R2 = Length of the string ; ; CALL TOUPPER ; ; R1 and R2 are destroyed and string is all uppercase upon return ;- .ENABL LSB TOUPPER:CMPB #<'a>,@R1 ;Less than lowercase a? BHI 10$ ;Branch if yes - no conversion CMPB #<'z>,@R1 ;Greater than lowercase z? BLO 10$ ;Branch if yes - no conversion BICB #,@R1 ;Convert lowercase alpha to uppercase 10$: TSTB (R1)+ ;Increment pointer to -> next character SOB R2,TOUPPER ;Continue looping if not done RETURN ............ .DSABL LSB .SBTTL ---------------------------------------------------- .SBTTL Interrupt Service Section .SBTTL MQINT - Job Abort and (Unused) Interrupt Entry Points BR MQABORT ;The abort entry point ............ MQINT:: BR MQFIN ;The (unused) interrupt entry point ............ .SBTTL MQABORT - Flush Message Queue For Aborting Job ;+ ; MQABORT - Remove all messages sent from aborting job to any other job ; ; MQABORT is called from IOQABT in RMON. It flushes the internal queues. ; ; R4 = aborting job number ; R5 = 0 (job abort) NOTE: R5 is ignored by MQ ; <> 0 (channel abort) ; ; NOTE: MUST preserve R0 - R3 for IOQABT. ; R5 is destroyed, but IOQABT doesn't care. ;- .ENABL LSB MQABORT:MOV R0,-(SP) ;Save R0 MOV R1,-(SP) ;Save R1 MOV R2,-(SP) ;Save R2 MOV @#$SYPTR,R5 ;R5 -> RMON MOV $CNTXT(R5),R0 ;R0 -> aborting jobs impure area JSR R3,30$ ;Save R3, point to MSGQUE ............ ;+ ; Queues for waiting message handler requests ;- MSGQUE: .REPT MXFJOBS+1 ;Changed to have room for all ... .WORD 0 ; ... possible jobs rather than ... .ENDR ; ... just SYSGEN'ed # of jobs .WORD -1 ;List stopper ............ 10$: MOV R2,R1 ;Check next element 20$: MOV @R2,R2 ;R2 -> next element, R1 -> previous BNE 40$ ;Not end of queue, do another element ;+ ; Start checking the internal queue for the next job ;- 30$: MOV R3,R1 ;R1 -> last link MOV (R3)+,R2 ;R2 -> first element BEQ 30$ ;Continue if it exists CMP R2,#<-1> ;End of table? BEQ 50$ ;Yes, done .ASSUME Q.LINK EQ Q.BLKN-4 40$: CMP -(R2),-(R2) ;No, search the queue. Bump back to link word CMPB Q.FUNC(R2),R4 ;Originated by aborted job? BNE 10$ ;No, not correct job number MOV Q.CSW(R2),R5 ;R5 -> CSW DECB C.DEVQ(R5) ;Reduce pending channel I/O count DEC I.IOCT(R0) ;Decrement pending job I/O count MOV @R2,@R1 ;Delink current element from queue BR 20$ ;Do next element, or next job if end of queue ............ 50$: MOV (SP)+,R3 ;We're done with all jobs MOV (SP)+,R2 ;Restore registers ... MOV (SP)+,R1 ; ... MOV (SP)+,R0 ; ... RETURN ; ... and return ............ .DSABL LSB .SBTTL ---------------------------------------------------- .SBTTL Handler Termination Section .DREND MQ ;That's all folks .END