.TITLE SS - System Service routines for Queueing functions .IDENT 'V06.026' ; ; DATE OF LAST UPDATE: 6/29/88 ; ; AUDIT TRAIL: ; ; 6.26 6/16/88 - 6/29/88 E. Lakia (Ipact) ; Added verification of user buffer for WRITE_Q, READ_Q, and ; RTR_WRITE_Q. Changed some probes from read to write to ; further ensure accessible. Modified detach_q to clear ; user's Q_BLOCK. Added probe to rundown code. ; ; 6.25 5/19/87 E. LAKIA ; Fixed the detach_q so that it will remove the correct virtual ; address space. The previous release only contracted the ; program region and did not correctly delete the virtual address ; used to map the queue. ; ;;;DEBUG = 1 ; Used to enable assembly of debug code ; .SBTTL Declarations and Equates ; ; Include Files ; .LIBRARY "SYS$LIBRARY:LIB.MLB" ; Macro library for system structure ; definitions ; ; Macro Definitions ; .MACRO DEFINE_SERVICE,NAME,NARG=0,MODE=KERNEL .PSECT $$$TRANSFER_VECTOR,PAGE,NOWRT,EXE,PIC .ALIGN QUAD ; Align entry points for speed and style .TRANSFER NAME ; Define name as universal symbol for entry .MASK NAME ; Use entry mask defined in main routine .IF IDN MODE,KERNEL CHMK # ; Change to kernel mode and execute RET ; Return KERNEL_COUNTER=KERNEL_COUNTER+1 ; Advance counter .PSECT KERNEL_NARG,BYTE,NOWRT,EXE,PIC .BYTE NARG ; Define number of required arguments .PSECT USER_KERNEL_DISP1,BYTE,NOWRT,EXE,PIC .WORD 2+NAME-KCASE_BASE ; Make entry in kernel mode CASE table .IFF CHME # ; Change to executive mode and execute RET ; Return EXEC_COUNTER=EXEC_COUNTER+1 ; Advance counter .PSECT EXEC_NARG,BYTE,NOWRT,EXE,PIC .BYTE NARG ; Define number of required arguments .PSECT USER_EXEC_DISP1,BYTE,NOWRT,EXE,PIC .WORD 2+NAME-ECASE_BASE ; Make entry in exec mode CASE table .ENDC ; .ENDM DEFINE_SERVICE ; .PAGE ; ; Equated Symbols ; $IODEF ; Define the I/O functions $IPLDEF $PCBDEF ; Process control block offsets $PHDDEF ; Define process header offsets $PLVDEF ; Define PLV offsets and values $PRIDEF $PRTDEF $PSLDEF $SECDEF $SSDEF ; Define system status codes $LCKDEF $RSBDEF $LKBDEF $PRVDEF ; PROCESS PRIVELEGES .list meb MIDDEF ; Define the message ID definitions HDRDEF ; Define the header definitions QSTDEF ; Define the message packet definitions PEXDEF ; Define the process region definitions QHDDEF ; Define the Queue header definitions .nlist meb ; ; Initialize counters for change mode dispatching codes ; KERNEL_COUNTER=0 ; Kernel code counter EXEC_COUNTER=0 ; Exec code counter ; ; Own Storage ; .PSECT KERNEL_NARG,BYTE,NOWRT,EXE,PIC KERNEL_NARG: ; Base of byte table containing the ; number of required arguments. .PSECT EXEC_NARG,BYTE,NOWRT,EXE,PIC EXEC_NARG: ; Base of byte table containing the ; number of required arguments. .PAGE .SBTTL Transfer Vector and Service Definitions ; DEFINE_SERVICE WRITE_Q, 5, KERNEL ; Write to queue ; DEFINE_SERVICE READ_Q, 4, KERNEL ; Read queue ; DEFINE_SERVICE ACK_READ, 3, KERNEL ; Acknowledge read ; DEFINE_SERVICE ATTACH_Q, 1, EXEC ; Init and attach to GS ; DEFINE_SERVICE CONNECT_READ, 4, KERNEL ; Connect to MID as reader ; DEFINE_SERVICE GET_MID_INDEX, 3, KERNEL ; Get Message ID index ; DEFINE_SERVICE DETACH_Q, 1, KERNEL ; Detach from queue ; DEFINE_SERVICE RTR_WRITE_Q, 5, KERNEL ; Write to queue (ROUTER) ; DEFINE_SERVICE BACKUP_RNA, 3, KERNEL ; Backup RNA message ; DEFINE_SERVICE ADD_MESSAGE_ID,3,KERNEL ; Add a message id ; DEFINE_SERVICE CHANGE_MESSAGE_ID,3,KERNEL ; Change a message id ; DEFINE_SERVICE DELETE_MESSAGE_ID,2,KERNEL ; Delete a message id ; DEFINE_SERVICE DISPLAY_MESSAGE_ID,3,KERNEL ; Display a message id ; DEFINE_SERVICE DISPLAY_QUEUE_HEAD,2,KERNEL ; Display queue header ; DEFINE_SERVICE DISPLAY_REGION,2,KERNEL ; Display expanded proc. region ; DEFINE_SERVICE SHUTDOWN_Q,1,KERNEL ; Shut down this queue ; DEFINE_SERVICE FIND_Q_PROCESSES,4,KERNEL ; Return attached processes ; DEFINE_SERVICE UPDATE_MID_STAT,3,KERNEL ; modify message id status word ; ; THE FOLLOWING ARE NOW FILLED IN BY KITINSTAL (Since we don't know ; what base codes other products may use. ; ;KCODE_BASE=-1024 ; Base CHMK code value for these services ;ECODE_BASE=-1024 ; Base CHME code value for these services .PAGE .SBTTL Change Mode Dispatcher Vector Block ; This vector is used by the image activator to connect the privileged shareable ; image to the VMS change mode dispatcher. The offsets in the vector are self- ; relative to enable the construction of position independent images. The system ; version number will be used by the image activator to verify that this shareable ; image was linked with the symbol table for the current system. ; ; Change Mode Vector Format ; +------------------------------------------+ ; ! Vector Type Code ! PLV$L_TYPE ; ! (PLV$C_TYP_CMOD) ! ; +------------------------------------------+ ; ! System Version Number ! PLV$L_VERSION ; ! (SYS$K_VERSION) ! ; +------------------------------------------+ ; ! Kernel Mode Dispatcher Offset ! PLV$L_KERNEL ; ! ! ; +------------------------------------------+ ; ! Exec Mode Entry Offset ! PLV$L_EXEC ; ! ! ; +------------------------------------------+ ; ! User Rundown Service Offset ! PLV$L_USRUNDWN ; ! ! ; +------------------------------------------+ ; ! Reserved ! ; ! ! ; +------------------------------------------+ ; ! RMS Dispatcher Offset ! PLV$L_RMS ; ! ! ; +------------------------------------------+ ; ! Address Check ! PLV$L_CHECK ; ! ! ; +------------------------------------------+ ; ; The reference to SYS$K_VERSION will only be resolved if the image is ; linked against SYS.STB. In other cases the version check is ; unnecessary and will not be done. ; .WEAK SYS$K_VERSION ; .PSECT USER_SERVICES,PAGE,VEC,PIC,NOWRT,EXE .LONG PLV$C_TYP_CMOD ; Set type of vector to change mode dispatcher .LONG SYS$K_VERSION ; Identify system version .LONG KERNEL_DISPATCH-. ; Offset to kernel mode dispatcher .LONG EXEC_DISPATCH-. ; Offset to executive mode dispatcher .LONG USER_RUNDOWN-. ; Offset to user rundown service .LONG 0 ; Reserved. .LONG 0 ; No RMS dispatcher .LONG 0 ; Address check - PIC image .PAGE .SBTTL Kernel Mode Dispatcher ; Input Parameters: ; (SP) - Return address if bad change mode value ; R0 - Change mode argument value. ; R4 - Current PCB Address. (Therefore R4 must be specified in all ; register save masks for kernel routines.) ; AP - Argument pointer existing when the change ; mode instruction was executed. ; FP - Address of minimal call frame to exit ; the change mode dispatcher and return to ; the original mode. .PSECT USER_KERNEL_DISP0,BYTE,NOWRT,EXE,PIC KACCVIO: ; Kernel access violation MOVL #QUE_KSSACCVIO,R0 ; Set access violation status code RET ; and return KINSFARG: ; Kernel insufficient arguments. MOVL #QUE_KSSINSFARG,R0 ; Set status code and RET ; return KNOTME: RSB ; RSB to forward request ; KERNEL_DISPATCH:: ; Entry to dispatcher MOVAB W^-KCODE_BASE(R0),R1 ; Normalize dispatch code value ; (get 0 to Kernel counter-1) BLSS KNOTME ; Branch if code value too low CMPW R1,#KERNEL_COUNTER ; Check high limit BGEQ KNOTME ; Branch if out of range ; ; The dispatch code has now been verified as being handled by this dispatcher, ; now the argument list will be probed and the required number of arguments ; verified. ; MOVZBL W^KERNEL_NARG[R1],R1 ; Get minimum required argument count MOVAL @#4[R1],R1 ; Compute byte count including arg count ; needed for argument list. IFNORD R1,(AP),KACCVIO ; Branch if arglist not readable CMPB (AP),W^[R0] ; Check for required number BLSS KINSFARG ; of arguments MOVL FP,SP ; Reset stack for service routine CASEW R0,- ; Case on change mode - ; argument value #KCODE_BASE,- ; Base value # ; Limit value (number of entries) KCASE_BASE: ; Case table base address for DEFINE_SERVICE ; ; Case table entries are made in the PSECT USER_KERNEL_DISP1 by ; invocations of the DEFINE_SERVICE macro. The three PSECTS, ; USER_KERNEL_DISP0,1,2 will be abutted in lexical order at link-time. ; .PSECT USER_KERNEL_DISP2,BYTE,NOWRT,EXE,PIC BUG_CHECK IVSSRVRQST,FATAL ; Since the change mode code is validated ; above, we should never get here .PAGE .SBTTL Executive Mode Dispatcher ; Input Parameters: ; (SP) - Return address if bad change mode value ; R0 - Change mode argument value. ; AP - Argument pointer existing when the change ; mode instruction was executed. ; FP - Address of minimal call frame to exit ; the change mode dispatcher and return to ; the original mode. .PSECT USER_EXEC_DISP0,BYTE,NOWRT,EXE,PIC EACCVIO: ; Exec access violation MOVL #QUE_ESSACCVIO,R0 ; Set access violation status code RET ; and return EINSFARG: ; Exec insufficient arguments. MOVL #QUE_ESSINSFARG,R0 ; Set status code and RET ; return ENOTME: RSB ; RSB to forward request ; EXEC_DISPATCH:: ; Entry to dispatcher MOVAB W^-ECODE_BASE(R0),R1 ; Normalize dispatch code value ; (getting 0 to EXEC_COUNTER-1) BLSS ENOTME ; Branch if code value too low CMPW R1,#EXEC_COUNTER ; Check high limit BGEQ ENOTME ; Branch if out of range ; ; The dispatch code has now been verified as being handled by this dispatcher, ; now the argument list will be probed and the required number of arguments ; verified. ; MOVZBL W^EXEC_NARG[R1],R1 ; Get minimum required argument count MOVAL @#4[R1],R1 ; Compute byte count including arg count ; of the argument list. IFNORD R1,(AP),EACCVIO ; Branch if arglist not readable CMPB (AP),W^[R0] ; Check for required number BLSS EINSFARG ; of arguments MOVL FP,SP ; Reset stack for service routine CASEW R0,- ; Case on change mode - ; argument value #ECODE_BASE,- ; Base value # ; Limit value (number of entries) ECASE_BASE: ; Case table base address for DEFINE_SERVICE ; ; Case table entries are made in the PSECT USER_EXEC_DISP1 by ; invocations of the DEFINE_SERVICE macro. The three PSECTS, ; USER_EXEC_DISP0,1,2 will be abutted in lexical order at link-time. ; .PSECT USER_EXEC_DISP2,BYTE,NOWRT,EXE,PIC BUG_CHECK IVSSRVRQST,FATAL ; Since the change mode code is validated ; above, we should never get here .PAGE .SBTTL User Rundown Service ;++ ; Functional description: ; This service is invoked from within the kernel mode system service ; that performs image rundown. It is invoked before any system ; rundown functions (i.e. deassign channels, release memory) are ; performed. User code should not invoke any RMS services or RTL ; routines, must not signal any exceptions. User code can invoke ; most system services execpt those that use RMS (e.g. $PUTMSG). ; ; Calling sequence: ; JSB USER_RUNDOWN ; Entered at IPL=0 and must leave at IPL=0. ; ; Input Parameters: ; R4 - Current PCB Address. (Therefore R4 must be specified in all ; register save masks for kernel routines.) ; ; R7 - Access mode parameter to $RUNDWN maximized with previous mode ; ; AP - Argument pointer existing when the $RUNDWN system ; service was invoked. ; ; 4(AP) - Access mode parameter to $RUNDWN ; ;-- .PAGE .SBTTL User Rundown Service .PSECT USER_CODE,BYTE,NOWRT,EXE,PIC ; .IF DEFINED DEBUG SYSOUT: .ASCII /_OPA0:/ SYS_LEN=.-SYSOUT MSG: .ASCII /*** MA Q application exiting ***/ MSG_LEN=.-MSG .ENDC ; USER_RUNDOWN:: ; Entry point for service PUSHR #^M ; Save some registers .IF DEFINED DEBUG PUSHAB B^SYSOUT ; Set up address of descriptor PUSHL S^#SYS_LEN ; Set up length MOVAL -(SP), R2 ; Grab some temporary storage BBSS #PRV$V_SYSPRV,PCB$Q_PRIV(R4),5$ ; GIVE UP PRIV.TO WRITE TO OPA0: 5$: $ASSIGN_S 4(R2), (R2) ; Assign a channel to operator console BLBC R0, 10$ ; Error $OUTPUT (R2), S^#MSG_LEN, B^MSG ; Print the message on operator console $DASSGN_S (R2) ; Get rid of the channel 10$: ADDL2 #12, SP ; Clean up .ENDC ; ; Clean up MA Q stuff ; JSB 20$ ; Push PC on stack 20$: MOVL (SP)+, R1 ; Get PC ADDL2 #, R1 ; Add offset to executive mode exit ; handler to form true address MOVAL G^CTL$GL_THEXEC,R0 ; GET THE EXECUTIVE EXIT HANDLERS BEQL 50$ ; NONE, MUST HAVE BEEN EXECUTED ALREADY ; ; BUILD A CALL FRAME TO CALL THE EXECUTIVE EXIT HANDLER ; ; R0= ADDRESS EXIT DESCRIPTOR BLOCK ; .LONG FLINK ; .ADDR EXIT HANDLER ; .LONG ARGUMENT COUNT ; .ADDR STATUS ; .LONG . ; ARGUMENTS ; .LONG . ; ARGUMENTS ; MOVL R0, R2 ; Save address of list head 30$: MOVL R2, R3 ; Save address of previous entry 40$: MOVL (R3), R2 ; Get address of next exit control block BEQL 50$ ; if EQL end of list, leave CMPL R1, 4(R2) ; Is it our handler? BNEQ 30$ ; no, then don't execute it MOVL (R2), (R3) ; Remove exit control block from list PUSHR #^M ; Save some registers CALLG 8(R2), @4(R2) ; CALL EXECUTIVE MODE EXIT HANDLER ; AT KERNEL MODE (SOMEWHAT EVALUATED) POPR #^M ; Restore registers BRW 40$ ; Don't change the previous entry 50$: POPR #^M ; Restore registers RSB .PAGE .SBTTL Acknowledge Read ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&ACK_READ\& ; .nf ; .x ACK_READ>Defined ; Source:ACK_READ.MOD ; Designer :PAUL VESTUTO, EARL LAKIA ; Author :PAUL VESTUTO ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update: 31-JUL-1986 12:00:00.00 ; Revision level :1.0 ; ; .C ;Formal Parameter List ; ; ; Q_BLOCK INTEGER*4(2) ; Q BLOCK DESCRIPTOR ADDRESS, WILL CONTAIN THE ; START ADDRESS FOR P0 (Q_BLOCK(1)) AND THE END ; ADDRESS FOR P0 (Q_BLOCK(2)). ; ; MESSAGE_ID CHARACTER*16 ; MESSAGE ID TO READ FROM. ; ; RNA_POINTER INTEGER*4 ; POINTER TO THE RNA MESSAGE. THIS VALUE WAS ; RETURNED DURING THE READ OPERATION. IF THIS ; VALUE DOES NOT MATCH THE VALUES SPCIFIED IN ; THE MESSAGE ID HEADER, AN APPROPRIATE ERROR ; MESSAGE WILL BE RETURNED. ; ; MIDX INTEGER*2 (OPTIONAL) ; INDEX OF MESSAGE ID. USED FOR FASTER ACCESS ; TO THE MESSAGE ID HEADER. IF NOT SPECIFIED, ; THE MESSAGE ID NAME IS USED. IF SPECIFIED, ; THE NAME CALCULATED FROM THE INDEX IS ; COMPARED WITH THE PASSED NAME, AND IF NOT ; THE SAME, THE PASSED NAME IS USED. ; ; Returns: ; ; ACK_READ INTEGER*4 ; THIS IS THE RETURN CODE AS DESCRIBED BY THE VMS ; STANDARDS AND THE QUESRV STANDARDS. ; ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; ; ; This routine acknolwges a message for the specified message ID. ; The following conditions are checked: ; the message ID exists ; the calling process is connected to the specified message ID ; the message ID does have an RNA message ; the RNA pointer matches the one stored in the Message ID header ; If any of the above conditions are not met, an appropriate error message is ; returned. ; ; This routines expects the parameters to be valid, if not an ; appropriate return code is returned to the caller. ; ; .tp 27 ; .nofill ; .SKIP ; INCLUDE 'MA_Q$DEF:QUEUE.TLB(QUECONST)' ; INTEGER*4 Q_BLOCK(2) ; CHARACTER MESSAGE_ID*16 ; MESSAGE_ID = 'STEEL_AVAILABLTY' ; INTEGER*4 RNA_POINTER ; INTEGER*2 MIDX ; ... ; STATUS = ACK_READ (Q_BLOCK, MESSAGE_ID, RNA_POINTER) ; or ; STATUS = ACK_READ (Q_BLOCK, MESSAGE_ID, RNA_POINTER, MIDX) ; ; POSSIBLE ERRORS: ; .SK ; .list 1,' ' ; .LE;QUE_INSFARG - Insufficient arguments ; .X QUE_INSFARG ; .LE;QUE_INVARG - Invalid arguments ; .X QUE_INVARG ; .LE;QUE_NOTINITIALIZED - Queueing functions have not been initialized ; .X QUE_NOTINITIALIZED ; .LE;QUE_INVIDX - MID index is not consistant with MID name ; .X QUE_INVIDX ; .LE;QUE_IDXOOR - MID index is out of range ; .X QUE_IDXOOR ; .LE;QUE_MIDNOTFOUND - Message ID not found in list ; .X QUE_MIDNOTFOUND ; .LE;QUE_NORNAMESS - There is no outstanding read-not-acknowleged mesage ; .X QUE_NORNAMESS ; .LE;QUE_INVRNA - Invalid read-not-acknowleged pointer ; .X QUE_INVRNA ; .LE;QUE_MIDNOTATT - Message ID is not attached ; .X QUE_MIDNOTATT ; .LE;QUE_NOCHK - Checkpoint process is not available ; .X QUE_NOCHK ; .ELS ; ; .fill ; end.doc ****************************** end.doc ; .PAGE .ENTRY ACK_READ,^M ; ; Check the passed parameter ; CMPB (AP), #3 ; enough arguments? BLSSU 10$ ; NO MOVL 4(AP), R3 ; Get the Q_BLOCK address IFNOWRT #8, (R3), 20$ ; insure Q_BLOCK writeable MOVL AP, R8 ; Save argument pointer $CMKRNL_S ROUTIN=30$ ; Jump into Kernel mode RET ; R0 has the return code ; 10$: MOVL #QUE_INSFARG, R0 ; Insufficient arguments RET 20$: MOVL #QUE_INVARG, R0 ; Invalid arguments RET 25$: MOVL #QUE_NOTINITIALIZED, R0 ; Not initialized RET 26$: MOVL #QUE_INVARG, R0 ; Invalid arguments BRW LEAVE_ACK_READ ; ; ********** In KERNEL Mode ********** ; 30$: .WORD ^M ; ; Make sure we are initialized ; MOVL (R3), R6 ; Get the P0 starting address IFNORD #PEX$K_LEN, (R6), 25$ ; insure readable CMPL (R3), PEX$L_SREG(R6) ; PASSED start same as STORED ? BNEQ 25$ ; no CMPL 4(R3), PEX$L_EREG(R6) ; PASSED end same as STORED ? BNEQ 25$ ; no BICL #PEX$M_INVIDX, PEX$L_STAT(R6) ; Clear INCOMPATIBLE flag ; ; Protect this process from being deleted ; DSBINT #IPL$_ASTDEL ; Disable AST interrupts and below ; ; Find the message ID in the list, check it, and delete the message ; MOVL PEX$Q_GSRETADR(R6), R10 ; Get virtual address for GS JSB CHECK_LOCK ; Wait if MID list is locked BLBS R0,31$ ; all ok? (lock not valid anymore?) BRW LEAVE_ACK_READ ; no, tell caller the bad news 31$: MOVL 8(R8), R11 ; Get MID descriptor buffer address IFNORD #8, (R11), 26$ ; insure readable MOVL 4(R11), R11 ; Get MID buffer address IFNORD #MID$K_SIZ, (R11), 26$ ; insure readable ; ; Use the index if found ; CMPB (R8), #4 ; passed MID index ? BLSS 32$ ; No MOVL 16(R8), R9 ; Get index address IFNORD #2, (R9), 26$ ; Insure readable JSB CHECK_MID_INDEX ; Check MID index BLBS R0, 34$ ; Passed index same as passed name BITL #PEX$M_INVIDX, PEX$L_STAT(R6) ; Was this a warning error? BEQL AR_IDXOOR ; No, index must be out of range ; ; use the MID name ; 32$: JSB MID_INDEX ; find this MID (R5, R9 NEW) BLBS R0,34$ ; found? BRW AR_INV_MID ; Not found 34$: CMPL MID$L_CPID(R9), PEX$L_PID(R6) ; This process attached ? BEQL 38$ ; YES, BRW AR_NOT_ATT ; No, then error 38$: TSTL MID$L_RNA(R9) ; Is there an RNA message? BEQL NO_RNA_MESS ; No CMPL @12(R8), MID$L_RNA(R9) ; Is the passed RNA same as one stored? BEQL 40$ ; YES BRW INV_RNA ; No 40$: MOVAB MID$L_RNA(R9), R11 ; Get RNA pointer address JSB DELETE_MESSAGE ; Delete this message ; ; Wake up check_point task ; MOVL QHD$L_PCB(R10), R0 ; Get check point process PCB address BEQL AR_NO_CHECK ; Check point process not there CMPL PCB$L_PID(R0), QHD$L_IPID(R10) ; Real PID same as stored ? BNEQ AR_NO_CHECK ; Inconsistant, return error code MOVL QHD$L_IPID(R10), R1 ; Get Index PID MOVL #PRI$_IOCOM, R2 ; I/O complete boost MOVZWL QHD$L_EFN(R10), R3 ; EFN to set PUSHR #^M JSB G^SCH$POSTEF ; Post the event flag POPR #^M .PAGE ; ; All done, return status ; BITL #PEX$M_INVIDX, PEX$L_STAT(R6) ; INCOMPATIBLE flag set ? BEQL 56$ ; No MOVL #QUE_INVIDX, R0 ; Yes, return warning status BICL #PEX$M_INVIDX, PEX$L_STAT(R6) ; Clear flag BRW LEAVE_ACK_READ ; return control to caller 56$: MOVL #SS$_NORMAL, R0 ; successful completion status ; LEAVE_ACK_READ: DECL QHD$L_INSRV(R10) ; decrement count of processes in service ENBINT ; Enable interrupts to previous level RET ; ; Error branches ; AR_IDXOOR: MOVL #QUE_IDXOOR, R0 ; Index out of range BRW LEAVE_ACK_READ AR_INV_MID: MOVL #QUE_MIDNOTFOUND, R0 ; MID not found BRW LEAVE_ACK_READ AR_NOT_ATT: MOVL #QUE_MIDNOTATT, R0 ; MID not attached BRW LEAVE_ACK_READ NO_RNA_MESS: MOVL #QUE_NORNAMESS, R0 ; There is no RNA message BRW LEAVE_ACK_READ INV_RNA: MOVL #QUE_INVRNA, R0 ; Invalid RNA address BRW LEAVE_ACK_READ AR_NO_CHECK: MOVL #QUE_NOCHK, R0 ; No check point process BRW LEAVE_ACK_READ .PAGE .SBTTL ADD_MESSAGE_ID ;.begin.doc ************************** begin.doc ; .c ;MODULE ; .c ;^&ADD_MESSAGE_ID\& ; .nf ; .x ADD_MESSAGE_ID>Defined ; Source:SSDISP.MAR ; Designer :EARL LAKIA ; Author :Earl Lakia, Paul Vestudo ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update:19-FEB-1987 ; Revision level :1.0 ; ; .C ;Formal Parameter List ; Receives: ; ; Q_BLOCK INTEGER*4 (2) ; Q BLOCK DESCRIPTOR AS RETURNED FROM THE ATTACH_Q ; SERVICE. THE ADDITION OF AN ID APPLIES TO THIS ; QUEUE ONLY. ; ; MESSAG_ID CHARACTER*16 ; MESSAGE ID THAT IS TO BE ADDED. ; ; MAXCNT INTEGER*4 ; MAXIMUM NUMBER OF MESSAGES TO BE ALLOWED FOR THIS ; MESSAGE ID. ; ; Returns: ; ; ADD_MESSAGE_ID INTEGER*4 ; RETURN STATUS ; ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; This system service allows the caller to add a message id to the ; queue. The caller must have sufficient privelege (SYSNAM). ; .sk ; CALL SEQUENCE ; ; INTEGER*4 SYS_STATUS ; INTEGER*4 ADD_MESSAGE_ID ! SYS. SERV. CALL ; CHARACTER*16 MESSAGE_ID !MESSAGE ID TO ADD ; INTEGER*4 Q_BLOCK(2) ! FROM ATTACH Q ; INTEGER*4 MAXMSG ! MAX NUMBER MESSAGES ; DATA MAXMSG/100/ ; DATA MESSAGE_ID/'MESSAGE ONE'/ ; C ; SYS_STATUS=ATTACH_Q(Q_BLOCK) ; IF(.NOT. SYS_STATUS)THEN ; CALL SSYS$EXIT(%VAL(SYS_STATUS)) ; ENDIF ; C ; SYS_STATUS=ADD_MESSAGE_ID( ; 1 Q_BLOCK, ; 1 MESSAGE_ID, ; 1 MAXMSG) ; C ; IF(.NOT. SYS_STATUS)THEN ; CALL SYS$EXIT(%VAL(SYS_STATUS)) ; ENDIF ; END ; .FILL ; .SK ; POSSSBILE ERROR CODES (Can also be system service errors): ; .LIST 1,' ' ; .LE;QUE_INSFARG- Insufficient number of arguments ; .X QUE_INSFARG ; .LE;QUE_INVARG- Invalid argument (one of the parameters is ; not valid, make sure Q_BLOCK is correctly dimentsioned, MESSAGE_ID is ; of sufficient dimension, etc. ; .X QUE_INVARG ; .LE;QUE_NOTINITIALIZED- The Q_BLOCK passed is either zero, or ; does not contain valid information. ; .x QUE_NOTINITIALIZED ; .LE;QUE_MIDTNOTUNIQUE- A request to add a message id that already ; exists. ; .X QUE_MIDNOTUNIQUE ; .LE;QUE_MIDLISTFULL- There is insufficient room left in the queue ; to allow the addition of the message id. The queue must be recreated ; and reinstalled with a larger allocation for the message id list ; heads. ; .x QUE_MIDLISTFULL ; .LE;QUE_NOPRIV- Calling process does not have sufficient privelege to ; add the message id to the queue. SYSPRV is required. ; .x QUE_NOPRIV ; .x SYSPRV ; .ELS ; ; ; end.doc ****************************** end.doc .PAGE ; ; Input Parameters: ; 4(ap) - Q block descriptor address ; 8(ap) - message Id ; 12(AP) - max message count ; Output Parameters: ; R0 - status return ; .ENTRY ADD_MESSAGE_ID,^M BBS #PRV$V_SYSPRV,PCB$Q_PRIV(R4),5$ ; Does caller have SYSPRV MOVL #QUE_NOPRIV,R0 ; no, return error status RET 5$: CMPB (AP), #3 ; enough arguments ? BLSSU 10$ ; Nope, return MOVL 4(AP),R3 ; Get the Q Block address IFNORD #8, (R3), 20$ ; insure Q_BLOCK readable MOVL 8(AP),R11 ; Get the MESSAGE ID descriptor address IFNORD #8, (R11), 20$ ; insure MID DESCIPTOR readable MOVL 4(R11),R11 ; Now get the MESSAGE ID buffer IFNORD #MID$K_SIZ, (R11), 20$ ; insure MESAGE_ID readable MOVL 12(AP),R8 ; Get the max message number IFNORD #2, (R8), 20$ ; insure MAX MESAGE readable $CMKRNL_S ROUTIN=30$ ; Jump into Kernel mode RET ; R0 has the return code 10$: MOVL #QUE_INSFARG, R0 ; Insufficient arguments RET 20$: MOVL #QUE_INVARG, R0 ; Invalid arguments RET ; ; ********** In KERNEL Mode ********** ; 30$: .WORD ^M $CMKRNL_S ROUTIN=40$ ; Jump into Kernel mode RET ; R0 has the return code ; ; ********** In KERNEL Mode, WITH PREVIOUS MODE KERNEL !! ********** ; 40$: .WORD ^M ; ; Make sure we are initialized ; MOVL (R3), R6 ; Get the P0 starting address IFNOWRT #PEX$K_LEN, (R6), ADD_MID_NOT_INITIALIZED ; insure writeable CMPL (R3), PEX$L_SREG(R6) ; PASSED start same as STORED ? BNEQ ADD_MID_NOT_INITIALIZED ; no CMPL 4(R3), PEX$L_EREG(R6) ; PASSED end same as STORED ? BEQL ADD_MID_INITIALIZED ; yes ADD_MID_NOT_INITIALIZED: MOVL #QUE_NOTINITIALIZED, R0 ; QUEUEING functions not initialized RET .PAGE ; ; Capture the Queue lock and do our thing ; ADD_MID_INITIALIZED: DSBINT #IPL$_ASTDEL ; protect from process deletion MOVL PEX$Q_GSRETADR(R6), R10 ; get Starting VA for Global Section JSB CAPQUE ; Capture the queue BLBS R0,5$ ; Did we capture the queue, jump if yes BRW LEAVE_ADD_MESSAGE_ID ; NO. ; ; Make sure Message ID is not already in the list ; 5$: JSB G^MID_INDEX ; Get MID index (R5, R9 new) BLBC R0, 10$ ; Not found, keep going MOVL #QUE_MIDNOTUNIQUE, R0 ; Set NOT UNIQUE status BRW LEAVE_ADD_MESSAGE_ID ; Return to caller ; ; Make sure we have room for this Message ID ; 10$: CMPL QHD$L_IDC(R10), QHD$L_AID(R10) ; Check allocated to current count BLSS 20$ ; If current < allocated, keep going MOVL #QUE_MIDLISTFULL, R0 ; set LIST_FULL status BRW LEAVE_ADD_MESSAGE_ID ; return to caller ; ; Add Message ID header. We must simply scan down the message id ; headers until we find one that has been deleted. Note: when the ; queue was created, any unused ones were also marked this way as ; well as any that are so marked because of someone deleteing them. ; 20$: MOVL QHD$L_AID(R10),R1 ; Number that were allocated ADDL3 #QHD$K_SIZ,R10,R9 ; Start of the message ids 30$: BITL #MID$M_DEL,MID$L_STAT(R9) ; is this one free? BNEQ 40$ ; Yes, then use this one ADDL2 #MID$K_LEN,R9 ; Move pointer to next MID listhead SOBGTR R1,30$ ; No, loop until we find one MOVL #QUE_MIDLISTFULL,R0 ; return error code if we don't find one BRW LEAVE_ADD_MESSAGE_ID ; ooops, something not kosher!!!! .page ; ; found an empty slot ; R9=MID LIST HEAD ; 40$: INCL QHD$L_IDC(R10) ; Increment MID count in Qheader area ; R9 is pointing to next sequential slot ; clear the slot first, then transfer the MID and load message count CLRL R5 ; Clear character CLRL R3 ; Source length MOVL #MID$K_LEN, R1 ; Get length of area to clear MOVC5 R3, MID$C_MID(R9), R5, R1, MID$C_MID(R9) ; Clear block MOVL #MID$K_SIZ, R3 ; Get length of area to move MOVC3 R3, (R11), MID$C_MID(R9) ; load MID (R0-R5 not valid now) MOVW (R8), MID$W_MAX(R9) ; Set maximum message count JSB HASHIT ; Get hash key (R0= hash key) MOVAB QHD$C_HASH(R10),R1 ; Get hash table address MOVL (R1)[R0],R2 ; Get current hash table entry MOVL R2,MID$L_HASH(R9) ; Ours will now thread to it SUBL3 R10,R9,R2 ; Calc. offset from beginning of queue ; to our entry MOVL R2,(R1)[R0] ; Have hash table now point to ours MOVL #QUE_SUCCESS,R0 ; return status and go release lock ; ; Release the Queue lock ; LEAVE_ADD_MESSAGE_ID: PUSHR #^M ; save status return JSB RELQUE ; release our monopoly on the queue POPR #^M ; Restore return status ENBINT ; reenable interupts RET .PAGE .sbttl ATTACH_Q ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&ATTACH_Q\& ; .nf ; .x ATTACH_Q>Defined ; Source:ATTACH_Q.MOD ; Designer :PAUL VESTUTO, EARL LAKIA ; Author :PAUL VESTUTO ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update: 29-JUL-1986 12:00:00.00 ; Revision level :1.0 ; ; .C ;Formal Parameter List ; ; ; Q_BLOCK INTEGER*4(2) ; Q BLOCK DESCRIPTOR ADDRESS, WILL CONTAIN THE ; START ADDRESS FOR P0 (Q_BLOCK(1)) AND THE END ; ADDRESS FOR P0 (Q_BLOCK(2)). ; ; Q_NAME CHARACTER*16 ; GLOBAL SECTION NAME (OPTIONAL). This parameter ; IF SPECIFIED, IDENTIFIES THE GLOBAL SECTION TO ; BE ATTACHED. IF NOT SPECIFIED, THE DEFAULT ; GLOBAL SECTION IS ATTACHED AS SPECIFIED BY ; EITHER THE NAME "MA_Q_NAME" OR THE LOGICAL NAME ; "GBL$MA_Q_NAME". ; ; MID_COUNT INTEGER*2 (OPTIONAL) ; MAXIMUM NUMBER OF MESSAGE IDS THE CALLER WILL ; ATTTACH TO. IF NOT SPECIFIED, THE DEFAULT IS ; USED. ; ; Returns: ; ; ATTACH_Q INTEGER*4 ; THIS IS THE RETURN CODE AS DESCRIBED BY THE VMS ; STANDARDS AND THE QUESRV STANDARDS. ; ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; ; ; This routine expands P0 space to get a working area. ; The global section is then attached, with the information being stored ; in the P0 work space. A null lock is created to ; be used for accessing the global section. Some Process information ; is obtained and stored in the working area. ; An exit handler is setup. ; ; This routines expects the parameters to be valid, if not an ; appropriate return code is returned to the caller. ; ; .tp 27 ; .nofill ; .SKIP ; INCLUDE 'MA_Q$DEF:QUEUE.TLB(QUECONST)' ; INTEGER*4 Q_BLOCK(2) ; INTEGER*2 MID_COUNT ; CHARACTER Q_NAME*(*) ; PARAMETER (Q_NAME = 'MY_OWN_QUEUE') ; MID_COUNT = 7 ; ... ; STATUS = ATTACH_Q (Q_BLOCK) ; OR ; STATUS = ATTACH_Q (Q_BLOCK, Q_NAME) ; OR ; STATUS = ATTACH_Q (Q_BLOCK, Q_NAME, MID_COUNT) ; OR ; STATUS = ATTACH_Q (Q_BLOCK, , MID_COUNT) ; ; POSSIBLE ERRORS: ; .SK ; .list 1,' ' ; .LE;QUE_INSFARG - Insufficient arguments ; .X QUE_INSFARG ; .LE;QUE_INVARG - Invalid arguments ; .X QUE_INVARG ; .LE;QUE_GTRMAX - Number specified is greater than allowed maximum number of MIDs ; .X QUE_GTRMAX ; .LE;QUE_NOCHK - Checkpoint process is not available ; .X QUE_NOCHK ; .LE;QUE_ALRATT- Queue already attached ; .x QUE_ALRATT ; .ELS ; ; .fill ; end.doc ****************************** end.doc .PAGE .ENTRY ATTACH_Q,^M ; ; Check the passed parameter ; CMPB (AP), #1 ; enough arguments? BGEQ 6$ ; YES JMP 72$ ; NO 6$: MOVL 4(AP),R6 ; Get the Q_BLOCK address IFNOWRT #8, (R6), 74$ ; insure Q_BLOCK writeable CMPB (AP), #2 ; passed global section name? BLSSU 10$ ; NO MOVL 8(AP), R7 ; Get GS name descriptor address IFNORD #8, (R7), 10$ ; Insure descriptor readable MOVZWL (R7), R8 ; Get length of string BLEQ 10$ ; Zero length MOVL 4(R7), R9 ; Now get the GS name buffer BLEQ 10$ ; Zero length IFNORD R8, (R9), 74$ ; Insure GS name buffer readable BRW 20$ 10$: MOVAB W^GSNAM, R7 ; Load default name descriptor address ; ; set up count of expected attached MIDs ; 20$: CMPB (AP), #3 ; passed MID count? BLSS 30$ ; NO MOVL 12(AP), R5 ; Get count address IFNORD #2, (R5), 74$ ; Insure buffer readable CMPW (R5), #PEX$L_MAXMID ; Insure number within bounds BGTR 76$ ; Too many, leave MOVZWL (R5), R5 ; Use what was passed BRW 40$ 30$: MOVL #PEX$L_DEFMID, R5 ; Take default ; ; Go to kernel mode to expand P0 space, map region, and enqueue a null ; lock. ; 40$: $CMKRNL_S ROUTIN=101$ ; Jump into Kernel mode BLBC R0, 45$ ; Successful attach ? ; ; Specify an Exit Handler ; (must be done from EXEC, previous mode is used - not current mode as ; documented to decide if exit handler can be setup.) ; MOVL (R6), R3 ; Get start P0 VA .GLOBL SYS$DCLEXH PUSHAB PEX$L_EXTHDL(R3) ; Push address of exit handler CALLS #1,G^SYS$DCLEXH 45$: RET 72$: MOVL #QUE_INSFARG, R0 ; Insufficient arguments RET 74$: MOVL #QUE_INVARG, R0 ; Invalid arguments RET 76$: MOVL #QUE_GTRMAX, R0 ; Too many MIDs specified RET ; ; ********** In KERNEL Mode ********** ; 101$: .WORD ^M ; Entry mask $CMKRNL_S ROUTIN=102$ ; Jump into Kernel mode again RET ; ; ********** In KERNEL Mode, with previous mode KERNEL ********** ; 102$: .WORD ^M ; Entry mask ; ; Get some Virtual Address area ; GET_VIRTUAL: ; Start a new local block... SUBL3 #PEX$L_DEFMID, R5, R2 ; Subtract default # MIDs to connect BGEQ 10$ CLRL R2 ; Default, accounted for in block 1 10$: MULL2 #MID$K_SIZ, R2 ; Get # of bytes needed for MID list ADDL2 #PEX$K_LEN+511, R2 ; Add length of rest of area (+round) DIVL2 #512, R2 ; Get number of blocks DSBINT #IPL$_ASTDEL ; Disable AST interrupts and below $EXPREG_S - PAGCNT=R2, - RETADR=(R6), - ; Return right into users's Q_BLOCK ACMODE=#PSL$C_EXEC ENBINT ; Enable interrupts to previous level BLBS R0, DONE_GET_VIRTUAL ; CHECK STATUS RET ; return with status in R0 DONE_GET_VIRTUAL: ; ; Fill region with some data ; MOVL (R6), R3 ; Get start VA MOVL (R6), PEX$L_SREG(R3) ; starting address of this region MOVL 4(R6), PEX$L_EREG(R3) ; ending address of this region MOVW R5, PEX$W_SETMID(R3) ; Number of allowed MIDs to connect MOVAB W^MAQ_RUNDOWN, PEX$L_EXTHDL+4(R3) ; Load exit handler address MOVL #2, PEX$L_EXTHDL+8(R3) ; Set # of params (STATUS, P0 ADDR) MOVAB PEX$Q_IOSB(R3), PEX$L_EXTHDL+12(R3) ; address of status MOVL (R6), PEX$L_EXTHDL+16(R3) ; P0 start VA MOVL G^SCH$GL_CURPCB, R0 ; Get PCB address MOVL PCB$L_PID(R0), PEX$L_IPID(R3) ; Index PID .PAGE ; ; Map the Queue Global Section ; $MGBLSC_S - INADR=PEX$Q_GSINADR(R3), - RETADR=PEX$Q_GSRETADR(R3), - ACMODE=#PSL$C_KERNEL, - FLAGS=#SEC$M_SYSGBL!SEC$M_WRT!SEC$M_EXPREG, - GSDNAM=(R7) BLBS R0, 20$ BRW LEAVE_ATTACH_Q ; CHECK STATUS ; ; Insure check_point task available ; 20$: MOVL PEX$Q_GSRETADR(R3), R10 ; Get GS virtual address MOVL QHD$L_PCB(R10), R0 ; Get check point process PCB address BEQL 23$ ; Check point process not there CMPL PCB$L_PID(R0), QHD$L_IPID(R10) ; Real PID same as stored ? BEQL 25$ ; YES, then ok 23$: MOVL #QUE_NOCHK, R0 ; Checkpoint process not available BRW LEAVE_ATTACH_Q ; ; See if the caller has alrady attached to the queue before ; by looking at his lock blocks. ; 25$: MOVL G^SCH$GL_CURPCB,R0 ; Get current PCB MOVL PCB$L_LOCKQFL(R0),R1 ; get thread to the locks MOVAB PCB$L_LOCKQFL(R0),R2 ; Get ending thread address 30$: CMPL R2,R1 ; At the end of list or null list? BEQL 60$ ; YES ; ; Found a lock block, see if it is the one for our queue. If it is ; then the caller has already attached to the queue before. ; r1= LKB ; CMPL LKB$L_RSB-LKB$L_OWNQFL(R1),QHD$L_RSB(R10) ; RSB MATCH (SAME ; RESOURCE)? BNEQ 50$ ; NO, GO CHECK NEXT POSSIBLE LOCK ; ; The user has already attached to the queue before, we must therefore ; unmap the second mapping of the queue, and contract the P0 space. ; $DELTVA_S INADR=PEX$Q_GSRETADR(R3),- ACMODE=#PSL$C_KERNEL BLBS R0,48$ ; Successful unmap? RET ; OOOPS, return system service error 48$: MOVL PEX$L_EREG(R3),R6 ; end address of expanded region SUBL PEX$L_SREG(R3),R6 ; sub. start address ASHL #-9,R6,R6 ; change to number of blocks INCL R6 ; must have at least one. $CNTREG_S PAGCNT=R6,- ; number of pages to contract ACMODE=#PSL$C_KERNEL ; access mode BLBS R0,49$ ; successfull reduction of P0 space RET ; OOOPS, return stysem service error ; 49$: MOVL #QUE_ALRATT,R0 ; ERROR CODE RET ; ; This lock is not the one for the queue ; 50$: MOVL (R1),R1 ; traverse forward thread BRW 30$ ; go see if at end or check nex LKB ; ; The user hasn't connect to the queue before, so let him conect ; load the expanded region with the descriptor block information ; initialize the access-lock descriptor block ; 60$: MOVZBW QHD$C_CLOCK(R10), PEX$Q_CLOCK(R3) ; Move the count byte into length word MOVAB QHD$C_CLOCK+1(R10), PEX$Q_CLOCK+4(R3) ; put the ascii long-word address into the descriptor ; ; Create a Null lock ; $ENQW_S LKMODE=#LCK$K_NLMODE, - ; null mode LKSB=PEX$C_LOCK(R3), - ; Status block for ENQW FLAGS=#LCK$M_SYSTEM!LCK$M_VALBLK, - ACMODE=#PSL$C_USER, - ; User mode RESNAM=PEX$Q_CLOCK(R3) ; Change-Lock descriptor block BLBC R0, LEAVE_ATTACH_Q ; bad STATUS ; ; Get this process identification, and lock block information and ; store in the allocated P0 space. ; MOVZWL PEX$C_LOCK+4(R3),R0 ; Lock id MOVL G^LCK$GL_IDTBL,R1 ; System lock table MOVL (R1)[R0],R5 ; Get LKB MOVL LKB$L_RSB(R5),PEX$L_RSB(R3) ; Store in expanded region ; MOVAB PEX$C_ITMLST(R3), R11 ; Get item list address MOVW #15, (R11)+ ; Size of process name buffer MOVW #JPI$_PRCNAM, (R11)+ ; Process name item code MOVAB PEX$C_PNAME(R3), (R11)+ ; Adress of process name buffer MOVAB PEX$L_PNAMEL(R3), (R11)+ ; Address of return process name size MOVW #4, (R11)+ ; Size of PID buffer MOVW #JPI$_PID, (R11)+ ; PID item code MOVAB PEX$L_PID(R3), (R11)+ ; Address of PID buffer MOVAB PEX$L_PIDL(R3), (R11)+ ; Address of return PID size CLRL (R11) ; end of list $GETJPIW_S - ITMLST = PEX$C_ITMLST(R3), - ; item list IOSB = PEX$Q_IOSB(R3) ; status block BLBC R0, LEAVE_ATTACH_Q ; check status MOVL #SS$_NORMAL,R0 ; success RET ; ; Error exit ; LEAVE_ATTACH_Q: CLRL PEX$L_SREG(R3) ; Clear P0 starting region address CLRL PEX$L_EREG(R3) ; Clear P0 ending region address RET .PAGE .SAVE_PSECT .PSECT NAME,PIC,GBL,SHR,NOEXE,OVR,LONG,NOWRT ; ; This section defines the MA_Q Global Section name through the ; logical name: GBL$MA_Q_NAME ; GSNAM: .ASCID /MA_Q_NAME/ .even .RESTORE_PSECT .PAGE .SBTTL Rundown queue routine, cleanup MA_Q specific data ; ; EXEC mode exit handler. This routine will clean up the queue specific ; data before the process exits. ; ; ENTRY IS: ; ; 00(AP)= # arguments ; 04(AP)= condition code which caused exit ; 08(AP)= P0 Start virtual address ; MAQ_RUNDOWN: .WORD ^M ; MOVL 8(AP), R6 ; Get P0 VA MOVL AP, R8 ; Save AP pointer ; ; Check current mode ; MOVPSL R0 EXTZV #PSL$V_CURMOD, #PSL$S_CURMOD, R0, R0 ; Extract current mode field DECL R0 ; Subtract out executive mode bias BLSS 21$ ; IF LSS Already in kernel mode ; ; Go to KERNEL mode to do the work ; $CMKRNL_S ROUTIN=20$ ; Clean up P0 structure, GS structure RET 20$: .WORD ^M<> ; Saves done above ; ; Consistency check for PEX region still attached ; 21$: IFNOWRT #PEX$K_LEN,(R6),60$ CMPL 8(R8), PEX$L_SREG(R6) ; Are we still attached ? BNEQ 60$ ; Nope ; ; Clean up the connected Message IDs ; MOVAB PEX$C_MIDLIST(R6), R11 ; Get address of MID list in P0 space MOVL PEX$Q_GSRETADR(R6), R10 ; Get GS VA 40$: DECW PEX$W_CURMID(R6) ; Decrement count of connected MIDs BLSS 50$ ; No more, rundown all done! JSB MID_INDEX ; Find MID (R5, R9 new) BLBC R0, 45$ ; Not found, go to next MID in list CLRL MID$L_CPID(R9) ; Clear connected PID CLRL MID$L_IPID(R9) ; Clear connected Index PID CLRW MID$W_EFN(R9) ; Clear connected EFN CLRL MID$L_PCB(R9) ; Clear connected PCB 45$: ADDL2 #MID$K_SIZ, R11 ; Look at next connected MID in list BRW 40$ ; Finish list 50$: CLRW PEX$W_CURMID(R6) ; Zero current # connected MIDs CLRL PEX$L_SREG(R6) ; Clear P0 start address CLRL PEX$L_EREG(R6) ; Clear P0 end address 60$: RET .PAGE .SBTTL Backup RNA ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&BACKUP_RNA\& ; .nf ; .x BACKUP_RNA>Defined ; Source:BACKUP_RNA.MOD ; Designer :PAUL VESTUTO, EARL LAKIA ; Author :PAUL VESTUTO ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update: 15-Aug-1986 12:00:00.00 ; Revision level :1.0 ; ; .C ;Formal Parameter List ; ; ; Q_BLOCK INTEGER*4(2) ; Q BLOCK DESCRIPTOR ADDRESS, WILL CONTAIN THE ; START ADDRESS FOR P0 (Q_BLOCK(1)) AND THE END ; ADDRESS FOR P0 (Q_BLOCK(2)). ; ; MESSAGE_ID CHARACTER*16 ; MESSAGE ID TO READ FROM. ; ; RNA_POINTER INTEGER*4 ; POINTER TO THE RNA MESSAGE. THIS VALUE WAS ; RETURNED DURING THE READ OPERATION. IF THIS ; VALUE DOES NOT MATCH THE VALUES SPCIFIED IN ; THE MESSAGE ID HEADER, AN APPROPRIATE ERROR ; MESSAGE WILL BE RETURNED. ; ; MIDX INTEGER*2 (OPTIONAL) ; INDEX OF MESSAGE ID. USED FOR FASTER ACCESS ; TO THE MESSAGE ID HEADER. IF NOT SPECIFIED, ; THE MESSAGE ID NAME IS USED. IF SPECIFIED, ; THE NAME CALCULATED FROM THE INDEX IS ; COMPARED WITH THE PASSED NAME, AND IF NOT ; THE SAME, THE PASSED NAME IS USED. ; ; Returns: ; ; BACKUP_RNA INTEGER*4 ; THIS IS THE RETURN CODE AS DESCRIBED BY THE VMS ; STANDARDS AND THE QUESRV STANDARDS. ; ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; ; ; This routine returns an RNA message to the head of the Message ID ; queue. ; The following conditions are checked: ; the message ID exists ; the calling process is connected to the specified message ID ; the message ID does have an RNA message ; the RNA pointer matches the one stored in the Message ID header ; If any of the above conditions are not met, an appropriate error message is ; returned. ; ; This routines expects the parameters to be valid, if not an ; appropriate return code is returned to the caller. ; ; .tp 27 ; .nofill ; .SKIP ; INCLUDE 'MA_Q$DEF:QUEUE.TLB(QUECONST)' ; INTEGER*4 Q_BLOCK(2) ; CHARACTER MESSAGE_ID*16 ; MESSAGE_ID = 'STEEL_AVAILABLTY' ; INTEGER*4 RNA_POINTER ; INTEGER*2 MIDX ; ... ; STATUS = BACKUP_RNA (Q_BLOCK, MESSAGE_ID, RNA_POINTER) ; or ; STATUS = BACKUP_RNA (Q_BLOCK, MESSAGE_ID, RNA_POINTER, MIDX) ; ; POSSIBLE ERRORS: ; .SK ; .list 1,' ' ; .LE;QUE_INSFARG - Insufficient arguments ; .X QUE_INSFARG ; .LE;QUE_INVARG - Invalid arguments ; .X QUE_INVARG ; .LE;QUE_NOTINITIALIZED - Queueing functions have not been initialized ; .X QUE_NOTINITIALIZED ; .LE;QUE_INVIDX - MID index is not consistant with MID name ; .X QUE_INVIDX ; .LE;QUE_IDXOOR - MID index is out of range ; .X QUE_IDXOOR ; .LE;QUE_MIDNOTFOUND - Message ID not found in list ; .X QUE_MIDNOTFOUND ; .LE;QUE_NORNAMESS - There is no outstanding read-not-acknowleged mesage ; .X QUE_NORNAMESS ; .LE;QUE_INVRNA - Invalid read-not-acknowleged pointer ; .X QUE_INVRNA ; .LE;QUE_MIDNOTATT - Message ID is not attached ; .X QUE_MIDNOTATT ; .LE;QUE_HEADNOTREM - Message header unable to be removed from Message ID list ; .X QUE_HEADNOTREM ; .ELS ; ; .fill ; end.doc ****************************** end.doc ; .PAGE .ENTRY BACKUP_RNA,^M ; ; Check the passed parameter ; CMPB (AP), #3 ; enough arguments? BLSSU 10$ ; NO MOVL 4(AP), R3 ; Get the Q_BLOCK address IFNOWRT #8, (R3), 20$ ; insure Q_BLOCK writeable MOVL AP, R8 ; Save AP $CMKRNL_S ROUTIN=30$ ; Jump into Kernel mode RET ; R0 has the return code 10$: MOVL #QUE_INSFARG, R0 ; Insufficient arguments RET 20$: MOVL #QUE_INVARG, R0 ; Invalid arguments RET 25$: MOVL #QUE_NOTINITIALIZED, R0 ; Not initialized RET 26$: MOVL #QUE_INVARG, R0 ; Invalid arguments BRW 50$ ; ; ********** In KERNEL Mode ********** ; 30$: .WORD ^M ; ; Make sure we are initialized ; MOVL (R3), R6 ; Get the P0 starting address IFNORD #PEX$K_LEN, (R6), 25$ ; insure readable CMPL (R3), PEX$L_SREG(R6) ; PASSED start same as STORED ? BNEQ 25$ ; no CMPL 4(R3), PEX$L_EREG(R6) ; PASSED end same as STORED ? BNEQ 25$ ; no BICL #PEX$M_INVIDX, PEX$L_STAT(R6) ; Clear INCOMPATIBLE flag ; ; Find the message ID in the list, check it, and delete the message ; ; ; Protect this process from being deleted ; DSBINT #IPL$_ASTDEL ; Disable AST interrupts and below MOVL PEX$Q_GSRETADR(R6), R10 ; Get virtual address for GS JSB CHECK_LOCK ; Wait if MID list is locked BLBS R0,31$ ; Are locks still in place? BRW 50$ ; nope, let caller know 31$: MOVL 8(R8), R11 ; Get MID descriptor buffer address IFNORD #8, (R11), 26$ ; insure readable MOVL 4(R11), R11 ; Get MID buffer address IFNORD #MID$K_SIZ, (R11), 26$ ; insure readable ; Use the index if found CMPB (R8), #4 ; passed MID index ? BLSS 32$ ; No MOVL 16(R8), R9 ; Get index address IFNORD #2, (R9), 26$ ; Insure readable JSB CHECK_MID_INDEX ; Compare passed index with passed name BLBS R0, 34$ ; they match! BITL #PEX$M_INVIDX, PEX$L_STAT(R6) ; Was this a warning error? BEQL 53$ ; No, index must be out of range ; Use the MID name 32$: JSB MID_INDEX ; find this MID (R5, R9 NEW) BLBC R0, 52$ ; not found ; ; Do some tests, then, return the RNA message to the queue head if able ; 34$: CMPL MID$L_CPID(R9), PEX$L_PID(R6) ; This process attached ? BNEQ 54$ ; No TSTL MID$L_RNA(R9) ; Is there an RNA message? BEQL 56$ ; No CMPL @12(R8), MID$L_RNA(R9) ; Is the passed RNA same as one stored? BLSS 57$ ; No 40$: REMQHI MID$L_RNA(R9), R2 ; remove block BVC 44$ ; successful, control block removed BCS 40$ ; Interlock failed, try again JMP 55$ ; Remove failed 44$: INSQHI (R2), MID$L_FLK(R9) ; Insert this into the FLK header BCS 44$ ; Interlock failed, try again ; ; All done, return status ; BITL #PEX$M_INVIDX, PEX$L_STAT(R6) ; INCOMPATIBLE flag set ? BEQL 46$ ; No MOVL #QUE_INVIDX, R0 ; Yes, return warning status BICL #PEX$M_INVIDX, PEX$L_STAT(R6) ; Clear flag BRW 50$ ; return control to caller 46$: MOVL #SS$_NORMAL, R0 ; successful completion status 50$: DECL QHD$L_INSRV(R10) ; decrement count of processes in service ENBINT ; Enable interrupts to previous level RET ; ; Error branches ; 52$: MOVL #QUE_MIDNOTFOUND, R0 ; MID not found BRW 50$ 53$: MOVL #QUE_IDXOOR, R0 ; Index out of range BRW 50$ 54$: MOVL #QUE_MIDNOTATT, R0 ; MID not attached BRW 50$ 55$: MOVL #QUE_HEADNOTREM, R0 ; Message header not removed BRW 50$ 56$: MOVL #QUE_NORNAMESS, R0 ; There is no RNA message BRW 50$ 57$: MOVL #QUE_INVRNA, R0 ; Invalid RNA address BRW 50$ .PAGE .SBTTL CHANGE_MESSAGE_ID ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&CHANGE_MESSAGE_ID\& ; .nf ; .x CHANGE_MESSAGE_ID>Defined ; Source:SSDISP.MAR ; Designer :EARL LAKIA ; Author :EARL LAKIA ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update:18-FEB-1987 07:51:10.64 ; Revision level :1.0 ; ; .C ;Formal Parameter List ; Receives: ; ; Q_BLOCK INTEGER*4 (2) ; Q-BLOCK AS RETURNED FROM ATTACH Q ; ; MESSAGE_ID CHARACTER*16 ; MESSAGE ID THAT CHANGE IS TO EFFECT ; ; NEWCOUNT INTEGER84 ; NEW MAXIMUM NUMBER OF MESSAGES FOR THIS MESSAGE ID ; ; Returns: ; ; CHANGE_MESSAGE_ID INTEGER*4 ; RETURN STATUS ; ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; This subroutine allows the caller to modify the maximum ; number of messages allowed for a message id. This is the only ; parameter that has any meaning to be modified. ; .sk ; CALLING SEQUENCE ; ; ; INTEGER*4 SYS_STATUS ; INTEGER*4 CHANGE_MESSAGE_ID ! SYS. SERV. CALL ; CHARACTER*16 MESSAGE_ID !MESSAGE ID TO ADD ; INTEGER*4 Q_BLOCK(2) ! FROM ATTACH Q ; INTEGER*4 MAXMSG ! MAX NUMBER MESSAGES ; DATA MAXMSG/100/ ; DATA MESSAGE_ID/'MESSAGE ONE'/ ; C ; SYS_STATUS=ATTACH_Q(Q_BLOCK) ; IF(.NOT. SYS_STATUS)THEN ; CALL SSYS$EXIT(%VAL(SYS_STATUS)) ; ENDIF ; C ; SYS_STATUS=CHANGE_MESSAGE_ID( ; 1 Q_BLOCK, ; 1 MESSAGE_ID, ; 1 MAXMSG) ; C ; IF(.NOT. SYS_STATUS)THEN ; CALL SYS$EXIT(%VAL(SYS_STATUS)) ; ENDIF ; END ; .FILL ; .SK ; POSSSBILE ERROR CODES (Can also be system service errors): ; .LIST 1,' ' ; .LE;QUE_INSFARG- Insufficient number of arguments ; .X QUE_INSFARG ; .LE;QUE_INVARG- Invalid argument (one of the parameters is ; not valid, make sure Q_BLOCK is correctly dimentsioned, MESSAGE_ID is ; of sufficient dimension, etc. ; .X QUE_INVARG ; .LE;QUE_NOTINITIALIZED- The Q_BLOCK passed is either zero, or ; does not contain valid information. ; .x QUE_NOTINITIALIZED ; .LE;QUE_NOPRIV- The calling process does not have sufficient ; privelege to change a message id. The privelege SYSPRIV is ; required. ; .X QUE_NOPRIV ; .ELS ; end.doc ****************************** end.doc .PAGE ; ; Input Parameters: ; 4(ap) - Q block descriptor address ; 8(ap) - message Id ; 12(AP) - by reference, maximum number of messages this id ; Output Parameters: ; R0 - status return ; .ENTRY CHANGE_MESSAGE_ID,^M BBS #PRV$V_SYSPRV,PCB$Q_PRIV(R4),5$ ; Does caller have SYSPRV MOVL #QUE_NOPRIV,R0 ; no, return error status RET 5$: CMPB (AP), #3 ; enough arguments ? BLSSU 10$ ; Nope, return MOVL 4(AP),R3 ; Get the Q Block address IFNORD #8, (R3), 20$ ; insure Q_BLOCK readable MOVL 8(AP),R11 ; Get the MESSAGE ID descriptor address IFNORD #8, (R11), 20$ ; insure MID DESCIPTOR readable MOVL 4(R11),R11 ; Now get the MESSAGE ID buffer IFNORD #MID$K_SIZ, (R11), 20$ ; insure MESSAGE_ID readable MOVL 12(AP),R8 ; Get the MID BUFFER DESCRIPTOR address IFNORD #2, (R8), 20$ ; insure new count readable $CMKRNL_S ROUTIN=30$ ; Jump into Kernel RET ; R0 has the return code 10$: MOVL #QUE_INSFARG, R0 ; Insufficient arguments RET 20$: MOVL #QUE_INVARG, R0 ; Invalid arguments RET ; ; ********** In KERNEL Mode ********** ; 30$: .WORD ^M $CMKRNL_S ROUTIN=40$ ; Jump into Kernel mode RET ; R0 has the return code ; ; ********** In KERNEL Mode, WITH PREVIOUS MODE KERNEL !! ********** ; 40$: .WORD ^M ; ; Make sure we are initialized ; MOVL (R3), R6 ; Get the P0 starting address IFNOWRT #PEX$K_LEN, (R6), CHANGE_MID_NOT_INITIALIZED ; insure writeable CMPL (R3), PEX$L_SREG(R6) ; PASSED start same as STORED ? BNEQ CHANGE_MID_NOT_INITIALIZED ; no CMPL 4(R3), PEX$L_EREG(R6) ; PASSED end same as STORED ? BEQL CHANGE_MID_INITIALIZED ; yes CHANGE_MID_NOT_INITIALIZED: MOVL #QUE_NOTINITIALIZED, R0 ; QUEUEING functions not initialized RET .PAGE ; ; Capture the Queue lock ; CHANGE_MID_INITIALIZED: MOVL PEX$Q_GSRETADR(R6),R10 ; Get queue address DSBINT #IPL$_ASTDEL ; don't let us get deleted JSB CAPQUE ; Monopolize the queue BLBC R0, LEAVE_CHANGE_MESSAGE_ID ; Jump if bad status ; ; Make sure Message ID is in the list ; JSB MID_INDEX ; Find the message id BLBC R0,LEAVE_CHANGE_MESSAGE_ID ; Message id not found ; ; Change Message ID header, only parameter allowed is the maximum number ; of messages for this id. ; 40$: MOVW (R8),MID$W_MAX(R9) ; Update the count MOVL #QUE_SUCCESS,R0 ; return status ; ; Release the Queue lock ; LEAVE_CHANGE_MESSAGE_ID: PUSHR #^M ; save status return JSB RELQUE ; Release the queue POPR #^M ; Restore return status ENBINT ; allow process deletion RET .PAGE .SBTTL CONNECT_READ - Routine to establish a message ID read ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&CONNECT_READ\& ; .nf ; .x CONNECT_READ>Defined ; Source:CONNECT_READ.MOD ; Designer :PAUL VESTUTO, EARL LAKIA ; Author :PAUL VESTUTO ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update: 25-AUG-1986 12:00:00.00 ; Revision level :1.0 ; ; .C ;Formal Parameter List ; Receives: ; ; Q_BLOCK INTEGER*4(2) ; Q BLOCK DESCRIPTOR ADDRESS, CONTAINS THE START ; ADDRESS FOR P0 (Q_BLOCK(1)) AND THE END ADDRESS ; FOR P0 (Q_BLOCK(2)). ; ; MESSAGE_ID CHARACTER*16 ; MESSAGE_ID TO CONNECT TO ; ; EFN INTEGER*2 ; EVENT FLAG TO SET WHEN THIS MESSAGE IDS COUNT ; GOES NON-ZERO. ; ; Returns: ; ; CONNECT_READ INTEGER*4 ; THIS IS THE RETURN CODE AS DESCRIBED BY THE VMS ; STANDARDS AND THE QUESRV STANDARDS. ; ; INDEX INTEGER*2 ; INDEX OF MESSAGE ID IN MID LIST. ; ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; ; ; This routine establishes the caller as the reader of the specified ; message IDs. ; ; The queue does not get checkpointed because the connect information ; is considered to be volatile. ; ; This routines expects the parameters to be valid and that the caller has ; already called the appropriate initialization routines. If any of the above ; conditions are not met, an appropriate return code is returned to the caller. ; ; .TP 25 ; .nofill ; .SKIP ; INCLUDE 'MA_Q$DEF:QUEUE.TLB(QUECONST)' ; INTEGER*4 Q_BLOCK(2) ; INTEGER*2 EFN, INDEX ; CHARACTER*16 MESSAGE_ID ; ... ; MESSAGE_ID = 'STEEL_AVAILABLTY' ; EFN = 1 ; STATUS = CONNECT_READ (Q_BLOCK, MESSAGE_ID, EFN, INDEX) ; ; POSSIBLE ERRORS: ; .SK ; .list 1,' ' ; .LE;QUE_INSFARG - Insufficient arguments ; .X QUE_INSFARG ; .LE;QUE_INVARG - Invalid arguments ; .X QUE_INVARG ; .LE;QUE_NOTINITIALIZED - Queueing functions have not been initialized ; .X QUE_NOTINITIALIZED ; .LE;QUE_MIDNOTFOUND - Message ID not found in list ; .X QUE_MIDNOTFOUND ; .LE;QUE_MIDATTACHED - Message ID is already attached ; .X QUE_MIDATTACHED ; .LE;QUE_MAXMID - Caller is connected to maximum number of Message IDs ; .X QUE_MAXMID ; .LE;QUE_HEADNOTREM - Message header unable to be removed from Message ID list ; .X QUE_HEADNOTREM ; .ELS ; ; .fill ; end.doc ****************************** end.doc ; .PAGE .ENTRY CONNECT_READ,^M CMPB (AP), #4 ; enough arguments ? BNEQ 10$ ; Nope, return MOVL 4(AP),R3 ; Get the Q Block address IFNORD #8, (R3), 20$ ; insure Q_BLOCK readable MOVL 8(AP), R11 ; Get the Message ID descriptor address IFNORD #8, (R11), 20$ ; insure structure readable MOVL 4(R11), R11 ; Get the Message ID address IFNORD #MID$K_SIZ, (R11), 20$ ; insure structure readable MOVL 12(AP), R8 ; Get address of the event flag to set MOVL 16(AP), R7 ; Get address of MID index to return $CMKRNL_S ROUTIN=30$ ; Jump into Kernel RET ; R0 has the return code 10$: MOVL #QUE_INSFARG, R0 ; Insufficient arguments RET 20$: MOVL #QUE_INVARG, R0 ; Invalid arguments RET 22$: MOVL #QUE_HEADNOTREM, R0 ; Message header not removed BRW 77$ 24$: MOVL #QUE_MIDATTACHED, R0 ; MID already attached BRW 77$ 25$: MOVL #QUE_NOTINITIALIZED, R0 ; Not initialized RET 26$: MOVL #QUE_MAXMID, R0 ; Maxmimum MIDs already attached RET 27$: MOVL #QUE_MIDNOTFOUND, R0 ; MID not found BRW 77$ ; ; ********** In KERNEL Mode ********** ; 30$: .WORD ^M ; ; Make sure we are initialized ; MOVL (R3), R6 ; Get the P0 starting address IFNORD #PEX$K_LEN, (R6), 25$ ; insure readable CMPL (R3), PEX$L_SREG(R6) ; PASSED start same as STORED ? BNEQ 25$ ; no CMPL 4(R3), PEX$L_EREG(R6) ; PASSED end same as STORED ? BNEQ 25$ ; no CMPW PEX$W_CURMID(R6), PEX$W_SETMID(R6) ; At maximum connect ? BGEQ 26$ ; Yes ; ; Protect this process from being deleted ; DSBINT #IPL$_ASTDEL ; Disable AST interrupts and below ; ; Find the message ID in the list ; MOVL PEX$Q_GSRETADR(R6), R10 ; Get the Global Section VA JSB CHECK_LOCK ; Wait if MID list is locked BLBS R0,38$ ; Locks still in place BRW 77$ 38$: JSB MID_INDEX ; Get mid index (R5 invalid, new R9) BLBC R0, 27$ ; MID not found, leave TSTL MID$L_IPID(R9) ; Is this MID already connected ? BNEQ 24$ ; Yes, leave ; ; Connect this message ID ; MOVL G^SCH$GL_CURPCB, R0 ; Get PCB address MOVL PCB$L_PID(R0), MID$L_IPID(R9) ; Store Index PID in header MOVL G^SCH$GL_CURPCB, MID$L_PCB(R9) ; Store PCB address in header MOVL PEX$L_PID(R6), MID$L_CPID(R9) ; Store PID in MID header MOVW (R8), MID$W_EFN(R9) ; Store EFN in MID header ; ; Insert the MID name into this process MID list ; CLRL R3 MULW3 #MID$K_SIZ, PEX$W_CURMID(R6), R3 ; get offset into connected MID list MOVAB PEX$C_MIDLIST(R6), R2 ; Get Mid list address ADDL2 R3, R2 ; Add offset to address INCW PEX$W_CURMID(R6) ; Bump current MID count MOVW R5, (R7) ; Return the MID index MOVL #MID$K_SIZ, R1 ; Get length of area to transfer MOVL R4, R10 ; Save PCB MOVC3 R1, MID$C_MID(R9), (R2) ; Transfer MID (R0-R5 invalid) MOVL R10, R4 ; Restore PCB ; ; Check if there is an RNA message ; TSTL MID$L_RNA(R9) ; Non-zero pointer ? BEQL 50$ ; No RNA message 40$: REMQHI MID$L_RNA(R9), R2 ; remove block BVC 45$ ; successful, control block removed BCS 40$ ; Interlock failed, try again JMP 22$ ; Remove failed 45$: INSQHI (R2), MID$L_FLK(R9) ; Insert this into the FLK header BCS 45$ ; Interlock failed, try again ; ; Check if messages are in queue for this message ID ; 50$: TSTW MID$W_CNT(R9) ; Is there a message ? BLEQ 60$ ; No MOVL MID$L_IPID(R9), R1 ; Get Index PID MOVL #PRI$_IOCOM, R2 ; I/O complete boost MOVZWL MID$W_EFN(R9), R3 ; EFN to set PUSHR #^M JSB G^SCH$POSTEF ; Post the event flag POPR #^M ; ; Successful connection to specified MID ; 60$: MOVL #SS$_NORMAL, R0 ; Success 77$: MOVL PEX$Q_GSRETADR(R6), R10 ; Get the Global Section VA AGAIN DECL QHD$L_INSRV(R10) ; decrement count of processes in service ENBINT ; Enable interrupts to previous level RET .page .SBTTL Delete message and return control blocks to free list ; ; This subroutine deletes a message from a MID queue and returns the control ; blocks to the free list. ; ; Inputs: ; R9 = MID pointer ; R10 = GS VA ; R11 = Address of forward link ; DELETE_MESSAGE: ; PUSHR #^M ; Save some registers ; ; Remove the header control block from the MID list ; 5$: REMQHI (R11), R7 ; remove block BCS 5$ ; Interlock failed, try again TSTW QS2$C_HDR+HDR$W_TYPE(R7) ; Test if non-volatile type BEQL 10$ ; Non-zero, volatile DECW MID$W_NVCNT(R9) ; Decrement Non-volatile count 10$: DECW MID$W_CNT(R9) ; Decrement message count ; ; Remove the next data control block from the data chain ; 20$: REMQHI QS2$L_DLNK(R7), R8 ; remove block BVS 40$ ; Empty data chain, do header block BCS 20$ ; Interlock failed, try again ; ; Clear the data block before returning it to the free list ; MOVZBL #^A/ /, R5 ; Clear character CLRL R3 ; Source length MOVL #QST$K_MSGL, R1 ; size of message area MOVL R4, R6 ; Save PCB address MOVC5 R3, QST$C_MSG(R8), R5, R1, QST$C_MSG(R8) ; Clear block MOVL R6, R4 ; restore PCB address ; ; Return the data block to the free list ; 30$: INSQTI (R8), QHD$Q_FLS(R10) ; put this block back into the list BCS 30$ ; Interlock failed, try again INCL QHD$L_FREE(R10) ; Bump the number of free blocks BRW 20$ ; Do next block ; ; ********************************************************************** ; ; Clear the header before returning it to the free list ; 40$: MOVZBL #^A/ /, R5 ; Clear character CLRL R3 ; Source length MOVL #QST$K_MSGL, R1 ; size of message area MOVL R4, R6 ; Save PCB address MOVC5 R3, QST$C_MSG(R7), R5, R1, QST$C_MSG(R7) ; Clear block MOVL R6, R4 ; restore PCB address ; ; Return the data block to the free list ; 50$: INSQTI (R7), QHD$Q_FLS(R10) ; put this block back into the list BCS 50$ ; Interlock failed, try again INCL QHD$L_FREE(R10) ; Bump the number of free blocks 70$: MOVL #SS$_NORMAL, R0 ; successful return POPR #^M ; Restore registers RSB .PAGE .sbttl Delete_message_id ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&DELETE_MESSAGE_ID\& ; .nf ; .x DELETE_MESSAGE_ID>Defined ; Source:DELETE_MESSAGE_ID.MOD ; Designer :EARL LAKIA ; Author : ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update:18-FEB-1987 07:54:35.26 ; Revision level :1.0 ; ; .C ;Formal Parameter List ; Receives: ; ; Q_BLOCK INTEGER*4 (2) ; Q_BLOCK AS RETURNED FROM ATTACH Q ; ; MESSAGE_ID CHARACTER*16 ; MESSAGE ID THAT IS TO BE DELETED FROM THE QUEUE ; ; Returns: ; ; DELETE_MESSAGE_ID INTEGER*4 ; RETURN STATUS ; ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; This subroutine allows the caller to mark a message Id as ; nolonger in the queue. The message id can not have any messages ; in the queue. ; .sk ; CALLING SEQUENCE ; ; INTEGER*4 SYS_STATUS ; INTEGER*4 DELETE_MESSAGE_ID ! SYS. SERV. CALL ; CHARACTER*16 MESSAGE_ID !MESSAGE ID TO DELETE ; INTEGER*4 Q_BLOCK(2) ! FROM ATTACH Q ; INTEGER*4 MAXMSG ! MAX NUMBER MESSAGES ; DATA MAXMSG/100/ ; DATA MESSAGE_ID/'MESSAGE ONE'/ ; C ; SYS_STATUS=ATTACH_Q(Q_BLOCK) ; IF(.NOT. SYS_STATUS)THEN ; CALL SSYS$EXIT(%VAL(SYS_STATUS)) ; ENDIF ; C ; SYS_STATUS=DELETE_MESSAGE_ID( ; 1 Q_BLOCK, ; 1 MESSAGE_ID) ; C ; IF(.NOT. SYS_STATUS)THEN ; CALL SYS$EXIT(%VAL(SYS_STATUS)) ; ENDIF ; END ; .FILL ; .SK ; POSSSBILE ERROR CODES (Can also be system service errors): ; .LIST 1,' ' ; .LE;QUE_INSFARG- Insufficient number of arguments ; .X QUE_INSFARG ; .LE;QUE_INVARG- Invalid argument (one of the parameters is ; not valid, make sure Q_BLOCK is correctly dimentsioned, MESSAGE_ID is ; of sufficient dimension, etc. ; .X QUE_INVARG ; .LE;QUE_NOTINITIALIZED- The Q_BLOCK passed is either zero, or ; does not contain valid information. ; .x QUE_NOTINITIALIZED ; .le;QUE_MIDDELETED- The requested message id has been marked ; for delete ; .x QUE_MIDDELETED ; .LE;QUE_MIDNOTFOUND- The desired message id is not in the queue. ; .x QUE_MIDNOTFOUND ; .le;QUE_NOPRIV- Calling process does not have sufficient privilege ; to delete the message id. The privelege SYSPRV is required. ; .x QUE_NOPRIV ; .ELS ; end.doc ****************************** end.doc .page ; ; Input Parameters: ; 4(ap) - q_block descriptor address ; 8(ap) - message Id name buffer descriptor block ; Output Parameters: ; R0 - status return ; .ENTRY DELETE_MESSAGE_ID,^M BBS #PRV$V_SYSPRV,PCB$Q_PRIV(R4),5$ ; Does caller have SYSPRV MOVL #QUE_NOPRIV,R0 ; no, return error status RET 5$: CMPB (AP), #2 ; enough arguments ? BLSSU 10$ ; Nope, return MOVL 4(AP),R3 ; Get the Q Block address IFNORD #8, (R3), 20$ ; insure Q_BLOCK readable MOVL 8(AP),R11 ; Get the MESSAGE ID descriptor address IFNORD #8, (R11), 20$ ; insure MID DESCIPTOR readable MOVL 4(R11),R11 ; Now get the MESSAGE ID buffer IFNORD #MID$K_SIZ, (R11), 20$ ; insure MESAGE_ID readable $CMKRNL_S ROUTIN=30$ ; Jump into Kernel RET ; R0 has the return code 10$: MOVL #QUE_INSFARG, R0 ; Insufficient arguments RET 20$: MOVL #QUE_INVARG, R0 ; Invalid arguments RET ; ; ********** In KERNEL Mode ********** ; 30$: .WORD ^M $CMKRNL_S ROUTIN=40$ ; Jump into Kernel RET ; R0 has the return code ; ; ********** In KERNEL Mode, WITH PREVIOUS MODE KERNEL !! ********** ; 40$: .WORD ^M ; ; Make sure we are initialized ; MOVL (R3), R6 ; Get the P0 starting address IFNOWRT #PEX$K_LEN, (R6), DELETE_MID_NOT_INITIALIZED ; insure writeable CMPL (R3), PEX$L_SREG(R6) ; PASSED start same as STORED ? BNEQ DELETE_MID_NOT_INITIALIZED ; no CMPL 4(R3), PEX$L_EREG(R6) ; PASSED end same as STORED ? BEQL DELETE_MID_INITIALIZED ; yes DELETE_MID_NOT_INITIALIZED: MOVL #QUE_NOTINITIALIZED, R0 ; QUEUEING functions not initialized RET .PAGE ; ; Capture the Queue lock ; DELETE_MID_INITIALIZED: MOVL PEX$Q_GSRETADR(R6),R10 ; Get queue header DSBINT #IPL$_ASTDEL ; Don't let us get deleted JSB CAPQUE ; Go monopolize the queue BLBC R0, LEAVE_DELETE_MESSAGE_ID ; jump if bad status ; ; Make sure Message ID is in the list ; JSB G^MID_INDEX ; Find MID in list (R5, R9 new) BLBC R0, D_NOT_FOUND ; ooops, not found TSTW MID$W_CNT(R9) ; are there messae in the id BEQL 5$ ; no, then maybe alright to delete MOVL #QUE_NONEMPTYQ,R0 ; return error status BRW LEAVE_DELETE_MESSAGE_ID 5$: TSTL MID$L_IPID(R9) ; is anyone attached for this id? BEQL 8$ ; no, then ok to delete MOVL #QUE_IDATTACHED,R0 ; return error code BRW LEAVE_DELETE_MESSAGE_ID 8$: ; ; R9= address of the message id list head to be deleted, however, it ; must be delinked from the hash chain. ; SUBL3 R10,R9,R1 ; calc. offset to this message id JSB HASHIT ; Get the hash key MOVAB QHD$C_HASH(R10),R2 ; Hash table address MOVL (R2)[R0],R3 ; Get offset to first MID in hash chain CMPL R3,R1 ; does it point to us? BNEQ 10$ ; No MOVL MID$L_HASH(R9),(R2)[R0] ; YES, Change thread to our successor BRB 30$ ; Done, go clean up ; ; Traverse hash chain until we find a MID that points to us, then ; replace its hash chain with ours, thereby removeing us from the chain. ; 10$: ADDL3 R3,R10,R2 ; change offset to address of the mid CMPL MID$L_HASH(R2),R1 ; Does it point to us? BNEQ 20$ ; NO, continue traversing MOVL MID$L_HASH(R9),MID$L_HASH(R2) ; Remove us from hash chain BRB 30$ ; Done, go clean up 20$: MOVL MID$L_HASH(R2),R3 ; Take forward hash chain BNEQ 10$ ; Continue (note, should always be non zero ; as we checked to make sure we were ; present first) MOVL #QUE_HASHCORUPT,R0 ; Return hash corrupt error BRB LEAVE_DELETE_MESSAGE_ID ; Go return error code ; ; mark the message id list head as deleted and available for ; use by someone else ; 30$: BISL #MID$M_DEL,MID$L_STAT(R9) ; Mark id list head as deleted DECL QHD$L_IDC(R10) ; One less message id actually in queue MOVL #QUE_SUCCESS, R0 ; Successful the return code ; ; Release the Queue lock ; LEAVE_DELETE_MESSAGE_ID: PUSHR #^M ; save status return JSB RELQUE ; go release our monopoly POPR #^M ; Restore return status ENBINT ; Allow interrupts again RET ; ; Message ID not found in tabel ; D_NOT_FOUND: MOVL #QUE_MIDNOTFOUND, R0 BRW LEAVE_DELETE_MESSAGE_ID .PAGE .SBTTL DETACH_Q - Routine to detach from queue ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&DETACH_Q\& ; .nf ; .x DETACH_Q>Defined ; Source:DETACH_Q.MOD ; Designer :PAUL VESTUTO, EARL LAKIA ; Author :PAUL VESTUTO ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update: 12-Aug-1986 12:00:00.00 ; Revision level :1.0 ; ; .C ;Formal Parameter List ; Receives: ; ; Q_BLOCK INTEGER*4(2) ; Q BLOCK DESCRIPTOR ADDRESS, CONTAINS THE START ; ADDRESS FOR P0 (Q_BLOCK(1)) AND THE END ADDRESS ; FOR P0 (Q_BLOCK(2)). ; ; Returns: ; ; DETACH_Q INTEGER*4 ; THIS IS THE RETURN CODE AS DESCRIBED BY THE VMS ; STANDARDS AND THE QUESRV STANDARDS. ; ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; ; ; This routine detaches the caller from the specified queue. ; ; This routines expects the parameter to be valid and that the caller has ; already called the appropriate initialization routines. If any of the above ; conditions are not met, an appropriate return code is returned to the caller. ; ; .tp 10 ; .nofill ; .SKIP ; INCLUDE 'MA_Q$DEF:QUEUE.TLB(QUECONST)' ; INTEGER*4 Q_BLOCK(2) ; ... ; STATUS = DETACH_Q (Q_BLOCK) ; ; .fill ; end.doc ****************************** end.doc ; .PAGE .ENTRY DETACH_Q,^M CMPB (AP), #1 ; enough arguments ? BLSSU 10$ ; Nope, return MOVL 4(AP),R3 ; Get the Q Block address IFNORD #8, (R3), 20$ ; insure Q_BLOCK readable $CMKRNL_S ROUTIN=30$ ; Jump into Kernel CLRL (R3) ; Zero the Q_BLOCK CLRL 4(R3) RET ; R0 has the return code 10$: MOVL #QUE_INSFARG, R0 ; Insufficient arguments RET 20$: MOVL #QUE_INVARG, R0 ; Invalid arguments RET ; ; ********** In KERNEL Mode ********** ; 30$: .WORD ^M ; ; Make sure we are initialized ; MOVL #QUE_NOTINITIALIZED, R0 ; Init status to "not initialized" MOVL (R3), R6 ; Get the P0 starting address IFNOWRT #PEX$K_LEN, (R6), 70$ ; insure readable CMPL (R3), PEX$L_SREG(R6) ; PASSED start same as STORED ? BNEQ 70$ ; no CMPL 4(R3), PEX$L_EREG(R6) ; PASSED end same as STORED ? BNEQ 70$ ; no ; ; Detach from the attached MIDs and delink the exit block ; JSB USER_RUNDOWN ; Let the rundown service do this ; ; Remove the lock block ; $DEQ_S LKID=PEX$C_LOCK+4(R6),- ; Lock ID ACMODE=#PSL$C_KERNEL ; Access Mode BLBS R0,55$ ; Good status? RET ; No ; ; Delete virtual address space that was used to map the queue ; 55$: MOVL (R3),R6 ; Get address of the P0 S.A. $DELTVA_S - INADR = PEX$Q_GSRETADR(R6) ; Delete V.A. mapping queue BLBS R0, 60$ ; If unsuccessful, return error code RET ; ; Now contract our P0 region ; 60$: MOVL (R3),R6 ; Get P0 address again MOVL PEX$L_EREG(R6),R2 ; end address of expanded region SUBL PEX$L_SREG(R6),R2 ; sub. start address ASHL #-9,R2,R2 ; change to number of blocks INCL R2 ; must have at least one. $CNTREG_S PAGCNT=R2,- ; number of pages to contract ACMODE=#PSL$C_KERNEL ; access mode BLBS R0,70$ ; successfull reduction of P0 space RET ; OOOPS, return stysem service error MOVL #SS$_NORMAL,R0 ; Good status 70$: RET .PAGE .sbttl display_message_id ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&DISPLAY_MESSAGE_ID\& ; .nf ; .x DISPLAY_MESSAGE_ID>Defined ; Source:DISPLAY_MESSAGE_ID.MOD ; Designer :EARL LAKIA ; Author :EARL LAKIA, PAUL VESTUDO ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update:16-APR-87 ; Revision level :1.1 ; ; .C ;Formal Parameter List ; Receives: ; ; Q_BLOCK INTEGER*4 (2) ; Q_BLOCK AS RETURNED FROM ATTACH Q ; ; MESSAGE_ID CHARACTER*15 ; MESSAGE ID LIST HEAD THAT CALLER DESIRES ; ; MHD RECORD/MIDDEF/ ; STRUCTURE TO RECIEVE THE MESSAGE ID LIST HEAD ; ; Returns: ; ; DISPLAY_MESSAGE_ID INTEGER*4 ; RETURN STATUS ; ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; This system service allows the caller to add a message id to the ; queue. The caller must have sufficient privelege (SYSNAM). ; .sk ; CALL SEQUENCE ; ; INTEGER*4 SYS_STATUS ; INTEGER*4 DISPLAY_MESSAGE_ID ! SYS. SERV. CALL ; CHARACTER*16 MESSAGE_ID !MESSAGE ID TO ADD ; INTEGER*4 Q_BLOCK(2) ! FROM ATTACH Q ; INCLUDE 'MA_Q$DEF:QUEUE.TLB(QUEDEF)' ; RECORD/MIDDEF/MHD ; DATA MAXMSG/100/ ; DATA MESSAGE_ID/'MESSAGE ONE'/ ; C ; SYS_STATUS=ATTACH_Q(Q_BLOCK) ; IF(.NOT. SYS_STATUS)THEN ; CALL SSYS$EXIT(%VAL(SYS_STATUS)) ; ENDIF ; C ; SYS_STATUS=DISPLAY_MESSAGE_ID( ; 1 Q_BLOCK, ; 1 MESSAGE_ID, ; 1 MHD) ; C ; IF(.NOT. SYS_STATUS)THEN ; CALL SYS$EXIT(%VAL(SYS_STATUS)) ; ENDIF ; END ; .FILL ; .SK ; POSSSBILE ERROR CODES (Can also be system service errors): ; .LIST 1,' ' ; .LE;QUE_INSFARG- Insufficient number of arguments ; .X QUE_INSFARG ; .LE;QUE_INVARG- Invalid argument (one of the parameters is ; not valid, make sure Q_BLOCK is correctly dimentsioned, MESSAGE_ID is ; of sufficient dimension, etc. If the program has not been recompiled ; since a new release, the size of the message id list head may have ; changed. ; .X QUE_INVARG ; .LE;QUE_NOTINITIALIZED- The Q_BLOCK passed is either zero, or ; does not contain valid information. ; .x QUE_NOTINITIALIZED ; .LE;QUE_MIDNOTFOUND- The desired message id is not in the queue. ; .x QUE_MIDNOTFOUND ; .ELS ; end.doc ****************************** end.doc .page ; ; Input Parameters: ; 4(ap) - q_block descriptor address ; 8(ap) - message Id name buffer descriptor block ; 12(AP) - message Id block descriptor block address ; Output Parameters: ; R0 - status return ; .ENTRY DISPLAY_MESSAGE_ID,^M CMPB (AP), #3 ; 3 arguments ? BLSSU 10$ ; Nope, return MOVL 4(AP),R3 ; Get the Q Block address IFNORD #8, (R3), 20$ ; insure Q_BLOCK readable MOVL 8(AP),R9 ; Get the MESSAGE ID descriptor address IFNORD #8, (R9), 20$ ; insure MID DESCIPTOR readable MOVL 4(R9),R11 ; Now get the MESSAGE ID buffer IFNORD #MID$K_SIZ, (R11), 20$ ; insure MESAGE_ID readable MOVL 12(AP),R8 ; Get the MID BUFFER DESCRIPTOR address IFNORD #MID$K_LEN, (R8), 20$ ; insure MID BUFFER readable $CMKRNL_S ROUTIN=30$ ; Jump into Kernel RET ; R0 has the return code ; ; errors ; 10$: MOVL #QUE_INSFARG, R0 ; Insufficient arguments RET 20$: MOVL #QUE_INVARG, R0 ; Invalid arguments RET ; ; ********** In KERNEL Mode ********** ; 30$: .WORD ^M $CMKRNL_S ROUTIN=40$ ; Jump into Kernel RET ; R0 has the return code ; ; ********** In KERNEL Mode, WITH PREVIOUS MODE KERNEL !! ********** ; 40$: .WORD ^M ; ; Make sure we are initialized ; MOVL (R3), R6 ; Get the P0 starting address IFNOWRT #PEX$K_LEN, (R6), DISPLAY_MID_NOT_INITIALIZED ; insure writeable CMPL (R3), PEX$L_SREG(R6) ; PASSED start same as STORED ? BNEQ DISPLAY_MID_NOT_INITIALIZED ; no CMPL 4(R3), PEX$L_EREG(R6) ; PASSED end same as STORED ? BEQL DISPLAY_MID_INITIALIZED ; yes DISPLAY_MID_NOT_INITIALIZED: MOVL #QUE_NOTINITIALIZED, R0 ; QUEUEING functions not initialized RET ; ; go get the data for the caller ; DISPLAY_MID_INITIALIZED: MOVL PEX$Q_GSRETADR(R6), R10 ; get Starting VA for Global Section DSBINT #IPL$_ASTDEL ; protect ourselves from process delete JSB CHECK_LOCK ; Gain access to queue BLBS R0, 2$ BRW 40$ ;CHECK STATUS 2$: JSB MID_INDEX ; get the message id index and address BLBC R0,40$ ; found it ; ; Return Message ID header ; MOVL #MID$K_LEN, R1 ; Get length of area to move MOVC3 R1, (R9), (R8) ; Move the data (R0-R5 not valid now) MOVL #QUE_SUCCESS, R0 ; Successful the return code 40$: DECL QHD$L_INSRV(R10) ; we are no longer in the service ENBINT ; enable interupts again RET .PAGE .sbttl DISPLAY_QUEUE_HEAD ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&DISPLAY_QUEUE_HEAD\& ; .nf ; .x DISPLAY_QUEUE_HEAD>Defined ; Source:DISPLAY_QUEUE_HEAD.MOD ; TO BECOME PART OF LIBRARY:MA_Q:[SUBROUTINES]QUEUE.OLB ; Designer :EARL LAKIA, PAUL VESTUTO ; Author :Paul VESTUDO, Earl Lakia ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update: 2-JUL-1986 13:05:40.89 ; Revision level :1.0 ; ; .C ;Formal Parameter List ; Receives: ; ; Q_BLOCK INTEGER*4(2) ; Q BLOCK DESCRIPTOR ADDRESS, CONTAINS THE START ; ADDRESS FOR P0 (Q_BLOCK(1)) AND THE END ADDRESS ; FOR P0 (Q_BLOCK(2)). ; ; Q_STRUCTURE QUEUE HEADER STRUCTURE ; THIS PARAMETER IS AN ADDRESS POINTING TO THE ; STRUCTURE IN THE USER PROGRAM WHICH MAPS THE ; AREA OF THE QUEUE HEADER. ; ; Returns: ; ; R0 INTEGER*4 ; THIS IS THE RETURN CODE AS DESCRIBED BY THE VMS ; STANDARDS AND THE QUESRV STANDARDS. ; ; Q_STRUCTURE RECORD/QUEHED/ ; THE STRUCTURE DEFINED IN THE CALLER PROGRAM ; WILL BE FILLED IN BY THE DATA CONTAINED IN THE ; QUEUE HEADER. ; ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; ; ; This routines returns the data from the queue header area in the MA_Q ; GLOBAL SECTION. ; ; This routines expects the parameters to be valid and that the caller has ; already called the appropriate initialization routines. If any of the above ; conditions are not met, an appropriate return code is returned to the caller. ; ; .nofill ; INCLUDE 'MA_Q$DEF:QUECONST' ; RECORD /QHDDEF/ QUEUE_HEAD ; ... ; STATUS = DISPLAY_QUEUE_HEAD( Q_BLOCK, QUEUE_HEAD) ; .sk ; POSSSBILE ERROR CODES (Can also be system service errors): ; .LIST 1,' ' ; .LE;QUE_INSFARG - Insufficient arguments ; .X QUE_INSFARG ; .LE;QUE_INVARG - Passed arguments are not readable/writeabl, or corrupt. ; If a new release of the queue software has been installed, then possibly, ; the size of the QHDDEF record may be of a new larger size. ; .X QUE_INVARG ; .LE;QUE_NOTINITIALIZED - The caller has not attached to the queue ; via the ATTACH_Q service. ; .X QUE_NOTINITIALIZED ; .ELS ; .fill ; end.doc ****************************** end.doc .page ; ; (ap)= number of arguments ; 4(ap)= Q_block address ; 8(ap)= queue head record structure ; .ENTRY DISPLAY_QUEUE_HEAD,^M CMPB (AP), #2 ; enough arguments ? BLSSU 10$ ; Nope, return MOVL 4(AP),R3 ; Get the Q Block address IFNORD #8, (R3), 20$ ; insure Q_BLOCK readable MOVL 8(AP),R7 ; Get the QUEUE HEAD structure address IFNOWRT #QHD$K_SIZ, (R7), 20$ ; insure structure writeable $CMKRNL_S ROUTIN=30$ ; Jump into Kernel RET ; R0 has the return code 10$: MOVL #QUE_INSFARG, R0 ; Insufficient arguments RET 20$: MOVL #QUE_INVARG, R0 ; Invalid arguments RET 25$: MOVL #QUE_NOTINITIALIZED, R0 ; QUEUEING functions not initialized RET ; ; ********** In KERNEL Mode ********** ; 30$: .WORD ^M ; $CMKRNL_S ROUTIN=40$ ; Jump into Kernel ; RET ; R0 has the return code ; ; ********** In KERNEL Mode, WITH PREVIOUS MODE KERNEL !! ********** ; 40$: .WORD ^M ; ; Make sure we are initialized ; MOVL (R3), R6 ; Get the P0 starting address IFNOWRT #PEX$K_LEN, (R6), 25$ ; insure readable CMPL (R3), PEX$L_SREG(R6) ; PASSED start same as STORED ? BNEQ 25$ ; no CMPL 4(R3), PEX$L_EREG(R6) ; PASSED end same as STORED ? BNEQ 25$ ; no ; ; Return Queue header to the caller ; MOVL PEX$Q_GSRETADR(R6), R10 ; Get starting VA for Global Section MOVL #QHD$K_SIZ, R1 ; Get length of area to move MOVC3 R1, (R10), (R7) ; Move the data (R0-R5 not valid now) MOVL #QUE_SUCCESS, R0 ; Successful the return code RET .PAGE .sbttl DISPLAY_REGION - Routines to manipulate Expanded region ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&DISPLAY_REGION\& ; .nf ; .x DISPLAY_REGION>Defined ; Source:SSDISP.MAR ; TO BECOME PART OF LIBRARY:MA_Q:[SUBROUTINES]QUEUE.OLB ; Designer :PAUL VESTUTO, EARL LAKIA ; Author :EARL LAKIA, PAUL VESTUTO ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update: 14-FEB-1987 ; Revision level :1.1 ; ; .C ;Formal Parameter List ; Receives: ; ; Q_BLOCK INTEGER*4(2) ; Q BLOCK DESCRIPTOR ADDRESS, CONTAINS THE START ; ADDRESS FOR P0 (Q_BLOCK(1)) AND THE END ADDRESS ; FOR P0 (Q_BLOCK(2)). ; ; PEX_STRUCTURE EXPANDED REGION STRUCTURE ; THIS PARAMETER IS AN ADDRESS POINTING TO THE ; STRUCTURE IN THE USER PROGRAM WHICH MAPS THE ; EXPANDED AREA. ; ; Returns: ; ; R0 INTEGER*4 ; THIS IS THE RETURN CODE AS DESCRIBED BY THE VMS ; STANDARDS AND THE QUESRV STANDARDS. ; ; PEX_STRUCTURE EXPANDED REGION STRUCTURE ; THE STRUCTURE DEFINED IN THE CALLER PROGRAM ; WILL BE FILLED IN BY THE DATA CONTAINED IN THE ; EXPANDED REGION. ; ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; ; ; This routines returns the data from the expanded region area as ; defined for the MA_Q routines. ; ; This routines expects the parameters to be valid and that the caller has ; already called the appropriate initialization routines. If any of the above ; conditions are not met, an appropriate return code is returned to the caller. ; ; .nofill ; INCLUDE 'MA_Q:[DEF]QUECONST.FOR' ; RECORD /PEXDEF/ EXPANDED_REGION ; ... ; STATUS = DISPLAY_REGION( Q_BLOCK, EXPANDED_REGION) ; ; .fill ; end.doc ****************************** end.doc ; .PAGE .ENTRY DISPLAY_REGION,^M CMPB (AP), #2 ; enough arguments ? BLSSU DER_INSFARG ; Nope, return MOVL 4(AP),R3 ; Get the Q Block address IFNOWRT #8, (R3), DER_INVARG ; insure Q_BLOCK readable MOVL 8(AP),R7 ; Get the region structure address IFNOWRT #PEX$K_LEN, (R7), DER_INVARG ; insure structure writeable $CMKRNL_S ROUTIN=DISPLAY_REGION_KERNEL_1 ; To Kernel RET ; R0 has the return code ; DER_INSFARG: MOVL #QUE_INSFARG, R0 ; Insufficient arguments RET DER_INVARG: MOVL #QUE_INVARG, R0 ; Invalid arguments RET ; ; ********** In KERNEL Mode ********** ; .ENTRY DISPLAY_REGION_KERNEL_1,^M ; ; Make sure we are initialized ; MOVL (R3), R6 ; Get the P0 starting address IFNOWRT #PEX$K_LEN, (R6), DER_NOT_INITIALIZED ; insure readable CMPL (R3), PEX$L_SREG(R6) ; PASSED start same as STORED ? BNEQ DER_NOT_INITIALIZED ; no CMPL 4(R3), PEX$L_EREG(R6) ; PASSED end same as STORED ? BEQL DER_INITIALIZED ; yes DER_NOT_INITIALIZED: MOVL #QUE_NOTINITIALIZED, R0 ; QUEUEING functions not initialized RET DER_INITIALIZED: ; ; Return buffer ; MOVL #PEX$K_LEN, R1 ; Get length of area to move MOVL R4,R10 ; Save PCB address MOVC3 R1, (R6), (R7) ; Move the data (R0-R5 not valid now) MOVL R10,R4 ; Restore PCB address MOVL #QUE_SUCCESS, R0 ; Successful the return code RET .PAGE .SBTTL FIND_Q_PROCESSES ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&FIND_Q_PROCESSES\& ; .nf ; .x FIND_Q_PROCESSES>Defined ; Source:FIND_Q_PROCESSES.MOD ; Designer :EARL LAKIA ; Author :EARL LAKIA ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update: 6-MAR-1987 06:07:38.77 ; Revision level :1.0 ; ; .C ;Formal Parameter List ; Receives: ; ; Q_BLOCK INTEGER*4 (2) ; Q BLOCK AS RETURNED BY ATTACH_Q OR ATTACH_QE. ; ; PCB RECORD/PCBDEF/PCB(SIZE) ; RECORD ARRAY TO RECIEVE PCB OF THE PROCESS ; OR PROCESSES THAT ARE ATTACHED TO QUEUE. ; ; SIZE INTEGER*4 (BY VALUE) ; SIZE OF THE PCB RECORD (NUMBER OF RECORDS) ; ; Returns: ; ; FIND_Q_PROCESSES INTEGER*4 ; RETURN STATUS ; ; FOUND_CNT INTEGER*4 (BY REFERENCE) ; Number of PCB's found ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; This system service allows the caller to find all processes that ; are currently attached to the queue (the queue is specified and mapped ; when caller attached to the queue). The method that is used is to ; get the RSB address from the queue header and traverse lock blocks (LKB) ; from the three linked lists (Granted, Conversion, and Waiting) in the ; RSB. From the LKB, the PCB can be found. The user's array if ; filled until all of the lists are exhausted or the users array is ; full. In either case, the number found is ; returned in FOUND_COUNT. ; .SK ; .NOFILL ; The calling sequence is: ; ; INCLUDE '(PCBDEF)' ; INCLUDE 'MA_Q$DEF:QUEUE.TLB(QUEDEF)' ; INCLUDE 'MA_Q$DEF:QUEUE.TLB(QUECONST)' ; INTEGER*4 SYS_STATUS ; INTEGER*4 FOUND_COUNT ; INTEGER*4 SIZE ; PARAMETER (SIZE=10) ; INTEGER*4 ; C ; RECORD/PCBDEF/PCB(SIZE) ; C ; SYS_STATUS=ATTACH_Q(Q_BLOCK) ; IF(.NOT. SYS_STATUS)THEN ; ... ERROR ... ; ENDIF ; C ; SYS_STATUS=FIND_Q_PROCESSES(Q_BLOCK,PCB, ; 1 %VAL(SIZE),FOUND_COUNT) ; IF(.NOT. SYS_STATUS)THEN ; ... ERROR ... ; ELSE ; DO I = 1,FOUND_COUNT ; TYPE *,' PROCESS NAME: ',PCB(I).PCB$T_LNAME ; TYPE *,' EXTENDED PID: ',PCB(I).PCB$L_EPID ; TYPE *,' INDEX PID: ',PCB(I).PCB$L_PID ; ENDDO ; ENDIF ; ; .FILL ; end.doc ****************************** end.doc .page .ENTRY FIND_Q_PROCESSES,^M ; ; 0(AP)= 4 (number of arguments) ; 4(AP)= Address of Q_BLOCK ; 8(AP)= PCB array ; 12(AP)= Number of PCB that can be returned ; 16(AP)= Actual number found ; MOVL 12(AP),R0 ; Find how big user array is BLSS 10$ ; Negative?, then no good MULL2 #PCB$C_LENGTH,R0 ; Calculate size array should be MOVL 8(AP),R9 ; Get address of PCB array from user IFWRT R0,(R9),20$ ; Writeable? 10$: MOVL #QUE_INVARG,R0 ; Invalid argument RET 20$: MOVL 16(AP),R0 ; Address of future found count IFNOWRT #4,(R0),10$ ; Oops MOVL 4(AP),R3 ; Q_block address IFNOWRT #8,(R3),10$ ; Is the q_block readable? ; ; Everything seems to be in place ; MOVL AP,R9 ; Save AP for call to kernel again $CMKRNL_S ROUTIN=25$ ; Change mode to kernel to make RET ; make previous mode kernel too. ; ; current mode kernel, previous mode kernel (so can probe P0 region) ; 25$: .WORD ^M ; Save registers ; ; Make sure we are initialized ; MOVL (R3), R6 ; Get the P0 starting address IFNOWRT #PEX$K_LEN, (R6), 40$ ; insure readable CMPL (R3), PEX$L_SREG(R6) ; PASSED start same as STORED ? BNEQ 40$ ; no CMPL 4(R3), PEX$L_EREG(R6) ; PASSED end same as STORED ? BEQL 50$ ; YES, then must be initialized 40$: MOVL #QUE_NOTINITIALIZED,R0 ; Return eror code RET .page ; ; Initialized, now can return the poop for the caller ; ; R6= Expanded Region ; PEX$L_SREG(R6)= Global Section address ; 50$: DSBINT #IPL$_ASTDEL ; Protect from process deletion MOVL 12(R9),R11 ; User counter CLRL @16(R9) ; Zero number found MOVL PEX$Q_GSRETADR(R6),R10 ; Get global section starting address MOVL QHD$L_RSB(R10),R7 ; Get RSB address BNEQ 60$ ; Valid? MOVL #QUE_RSBBAD,R0 ; Return error status ENBINT RET ; ; look at the granted thread first (these are normally where the processes ; are threaded into ; 60$: ; JSB G^INI$BRK MOVL 8(R9),R10 ; Return user buffer MOVL RSB$L_GRQFL(R7),R1 ; Get forward thread MOVAL RSB$L_GRQFL(R7),R2 ; know when to end (points back to here) BSB 90$ ; get any from granted list BLBC R0,70$ ; Done MOVL RSB$L_CVTQFL(R7),R1 ; Get forward thread MOVAL RSB$L_CVTQFL(R7),R2 ; Know when to stop BSB 90$ ; get any from converted list BLBC R0,70$ ; Done MOVL RSB$L_WTQFL(R7),R1 ; Get forward thread MOVAL RSB$L_WTQFL(R7),R2 ; Know when to stop BSB 90$ ; get any from wait list BLBC R0,70$ ; Done MOVL #SS$_NORMAL,R0 ; good status 70$: ENBINT RET .PAGE ; ; subroutine to get any processes in this lock block chain ; ; ; r1= LKB (plus LKB$L_SQFL) if non lkbs are in tread (else pts to self) ; r2= points to last lkb in chain or else = r1 if none in chain ; @16(R9)= found counter ; r10= user buffer for pcbs to be returned into ; r11= number pcbs that will fit in user buffer ; ; On return, ; r10= next available position for next pcb ; @16(R9)= incremented for each pcb found/moved to user buffer ; 90$: CMPL R2,R1 ; At end of the list? BNEQ 100$ ; No MOVL #SS$_NORMAL,R0 ; Good status RSB ; 100$: DECL R11 ; see if still room BLSS 120$ ; full, too many PCBs PUSHR #^M ; Save our threads MOVAL -LKB$L_SQFL(R1),R6 ; Point to beginning of LKB MOVZWL LKB$L_PID(R6),R8 ; Get Index from IPID MOVL G^SCH$GL_PCBVEC,R0 ; Get PCB vector MOVL (R0)[R8],R8 ; Get PCB address from vector table ; MOVL #PCB$C_LENGTH,R0 ; Length of the PCB MOVC3 R0,(R8),(R10) ; copy PCB to user buffer ADDL #PCB$C_LENGTH,R10 ; Point to next user position INCL @16(R9) ; Increment the found counter POPR #^M ; Restore threads MOVL LKB$L_SQFL(R6),R1 ; Get forward thread BRB 90$ ; Take next thread 120$: MOVL #QUE_TOOMANYPCBS,R0 RSB .PAGE .SBTTL SHUTDOWN_Q- Mark queue as down, disable queue ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&SHUTDOWN_Q\& ; .nf ; .x SHUTDOWN_Q>Defined ; Source:SHUTDOWN_Q.MOD ; Designer :EARL LAKIA ; Author :EARL LAKIA ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update: 16-APR-87 ; Revision level :1.1 ; ; .C ;Formal Parameter List ; Receives: ; ; Q_BLOCK INTEGER*4(2) ; Q_BLOCK AS RETURNED FROM ATTACH_Q ; ; Returns: ; ; SHUTDOWN_Q INTEGER*4 ; RETURN STATUS ; ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; This system service is responsible for the shutdown of a ; particular installed queue. The service will capture the queue, ; mark the queue as being shutdown, and request a final checkpoint ; of the queue by the QUEUE_CHKR process. This service requires ; SYSPRV. ; .x QUEUE_CHKR>Referenced ; The calling sequence is: ; .nofilll ; .sk ; INTEGER*4 SYS_STATUS ; INTEGER*4 SHUTDOWN_Q ; INTEGER*4 ATTACH_Q ; INTEGER*4 Q_BLOCK(2) ; C ; SYS_STATUS=ATTACH_Q(Q_BLOCK) ; IF (.NOT. STATUS)THEN ; . ; . ; ENDIF ; C ; SYS_STATUS=SHUTDOWN_Q(Q_BLOCK) ; IF (.NOT. STATUS)THEN ; . ; . ; ENDIF ; ; .FILL ; The following error codes may be returned: ; .list 1,' ' ; .LE;QUE_INSFARG- Insufficient number of arguments ; .X QUE_INSFARG ; .LE;QUE_INVARG- Invalid argument (one of the parameters is ; not valid, make sure Q_BLOCK is correctly dimentsioned, MESSAGE_ID is ; of sufficient dimension, etc. ; .X QUE_INVARG ; .LE;QUE_NOTINITIALIZED- The Q_BLOCK passed is either zero, or ; does not contain valid information. ; .x QUE_NOTINITIALIZED ; .LE;QUE_NOPRIV- Calling process does not have sufficient privelege to ; add the message id to the queue. SYSPRV is required. ; .x QUE_NOPRIV ; .x SYSPRV ; .ELS ; end.doc ****************************** end.doc ; ; ; Input Parameters: ; R4= PCB OF CURRENT PROCESS ; 4(ap) - Q block descriptor address ; Output Parameters: ; R0 - status return ; .ENTRY SHUTDOWN_Q,^M BBS #PRV$V_SYSPRV,PCB$Q_PRIV(R4),5$ ; Does caller have SYSPRV MOVL #QUE_NOPRIV,R0 ; no, return error status RET 5$: CMPB (AP), #1 ; enough arguments ? BLSS 10$ ; Nope, return MOVL 4(AP),R3 ; Get the Q Block address IFNOWRT #8, (R3), 20$ ; insure Q_BLOCK readable $CMKRNL_S ROUTIN=30$ ; Jump into Kernel mode RET ; R0 has the return code 10$: MOVL #QUE_INSFARG, R0 ; Insufficient arguments RET 20$: MOVL #QUE_INVARG, R0 ; Invalid arguments RET ; ; ********** In KERNEL Mode ********** ; 30$: .WORD ^M $CMKRNL_S ROUTIN=40$ ; Jump into Kernel mode RET ; R0 has the return code ; ; ********** In KERNEL Mode, WITH PREVIOUS MODE KERNEL !! ********** ; 40$: .WORD ^M ; ; Make sure we are initialized ; MOVL (R3), R6 ; Get the P0 starting address IFNOWRT #PEX$K_LEN, (R6), 45$ ; insure writeable CMPL (R3), PEX$L_SREG(R6) ; PASSED start same as STORED ? BNEQ 45$ ; no CMPL 4(R3), PEX$L_EREG(R6) ; PASSED end same as STORED ? BEQL 50$ ; yes 45$: MOVL #QUE_NOTINITIALIZED, R0 ; QUEUEING functions not initialized RET .PAGE ; ; Capture the Queue lock and do our thing ; 50$: DSBINT #IPL$_ASTDEL ; protect from process deletion MOVL PEX$Q_GSRETADR(R6), R10 ; get Starting VA for Global Section JSB CAPQUE ; Capture the queue BLBS R0,60$ ; Did we capture the queue, jump if yes BRW 90$ ; No, ; 60$: BISL2 #QHD$M_SHUTDOWN,QHD$L_STAT(R10) ; MARK SHUTDOWN ; ; Wake up check_point task ; MOVL QHD$L_PCB(R10), R0 ; Get check point process PCB address BEQL 70$ ; Check point process not there CMPL PCB$L_PID(R0), QHD$L_IPID(R10) ; Real PID same as stored ? BNEQ 70$ ; Inconsistant, return error code MOVL QHD$L_IPID(R10), R1 ; Get Index PID MOVL #PRI$_IOCOM, R2 ; I/O complete boost MOVZWL QHD$L_EFN(R10), R3 ; EFN to set PUSHR #^M JSB G^SCH$POSTEF ; Post the event flag POPR #^M BRW 90$ ; Go return ; 70$: MOVL #QUE_NOCHK,R0 ; checkpoint process not available error 90$: PUSHR #^M ; SAVE STATUS JSB RELQUE ; RELEASE THE QUEUE POPR #^M ; RESTORE STATUS RET .PAGE .sbttl update_mid_stat ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&UPDATE_MID_STAT\& ; .nf ; .x UPDATE_MID_STAT>Defined ; Source:UPDATE_MID_STAT.MAR ; Designer :EARL LAKIA ; Author :EARL LAKIA ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update06-APR-87 ; Revision level :1.1 ; ; .C ;Formal Parameter List ; Receives: ; ; Q_BLOCK INTEGER*4 (2) ; SEE ATTACH_Q FOR DESCRIPTION OF THIS ; ARRAY. ; ; MESSAGE_ID CHARACTER*16 ; Message id that is to have the ; bit cleared. ; ; MIDSTAT INTEGER*4 ; New message id status word, ; NOTE: PASSED BY VALUE!!!! ; ; Returns: ; ; MARK_ROUTABL INTEGER*4 ; Return status ; ; ; .SK ; .fill ; .SK ; Description: ; .sk ; This subroutine is passed a message id name and the Q_BLOCK ; for the queue. ; This subroutine is responsible for updating the MID$L_STAT ; long word in the message id list head with MIDSTAT. The caller ; must have connected to this message id with read. ; ; .LITERAL ; INTEGER*4 Q_BLOCK(2) ; INTEGER*4 STATUS ; INTEGER*4 MIDSTAT ; CHARACTER*16 MESSAGE_ID ; PARAMETER(MESSAGE_ID='TEST_ID') ; ; STATUS=ATTACH_Q(Q_BLOCK) ; STATUS=CONNECT_READ(Q_BLOCK,MESSAGE_ID) ; MIDSTAT=0 ; STATUS=UPDATE_MID_STAT(Q_BLOCK,MESSAGE_ID,%VAL(MIDSTAT)) ; STATUS=DETACH_Q(Q_BLOCK) ; .END LITERAL ; end.doc ****************************** end.doc .page ; ; CALL SEQUENCE: ; ; 0(AP)= 2 NUMBER OF ARGUMENTS ; 4(AP)= Q_BLOCK ADDRESS ; 8(AP)= MESSAGE ID DESCRIPTOR ; 12(AP)= NEW STATUS WORD ; .ENTRY UPDATE_MID_STAT,^M ; ; current mode kernel, previous mode user. ; make sure character descriptor readable and the q_block. ; (don't have to check MIDSTAT as dispatcher made sure readable) ; 30$: BBS #PRV$V_SYSPRV,PCB$Q_PRIV(R4),5$ ; Does caller have SYSPRV MOVL #QUE_NOPRIV,R0 ; no, return error status RET 5$: MOVL 4(AP),R3 ; Get address of q_block IFWRT #8,(R3),40$ ; can we read/write in user mode? 35$: MOVL #QUE_INVARG,R0 ; return error status RET 40$: MOVL 8(AP),R4 ; get character descriptor IFNOWRT #8,(R4),35$ ; is descriptor readable MOVL 4(R4),R11 ; see if the character buffer readable IFNOWRT #MID$K_SIZ,(R11),35$ ; can't read message id ; ; Have the q_block, now make sure that the P0 expanded region is valid ; (will have to change mode again so can probe in kernel-kernel) ; MOVL AP,R2 ; save ap pointer $CMKRNL_S ROUTIN=50$ ; Change mode to kernel RET ; to make prev= kernel too. ; ; Current mode Kernel, previous mode Kernel ; 50$: .WORD ^M<> ; Entry mask MOVL (R3),R6 ; get the address of expanded region IFNOWRT #PEX$K_LEN,(R6),90$ ; is header valid CMPL (R3),PEX$L_SREG(R6) ; Same passed as stored? BNEQ 90$ ; NO CMPL 4(R3),PEX$L_EREG(R6) ; BNEQ 90$ ; NO DSBINT #IPL$_ASTDEL ; raise IPL so won't be deleted ; ; find the message id, make sure user is connected, and if all is ; well, modify the status long word. ; R2= as called AP ; R6= Expanded region ; R11= Message id buffer ; MOVL PEX$Q_GSRETADR(R6),R10 ; get the queue virtual address JSB CHECK_LOCK ; see if queue availabe BLBS R0,55$ ; available? RET ; NO 55$: JSB MID_INDEX ; find the message id BLBC R0,70$ ; did we find it? ; ; R9= Message id list head ; 60$: CMPL MID$L_CPID(R9),PEX$L_PID(R6) ; is this process connected? BEQL 65$ ; yes, then ok MOVL #QUE_MIDNOTATT,R0 ; message id not attached error BRB 70$ ; return status 65$: MOVL 12(R2),MID$L_STAT(R9) ; update the status long word MOVL #SS$_NORMAL,R0 ; good status 70$: DECL QHD$L_INSRV(R10) ; decrement number user's in service ENBINT ; allow asts RET ; ; queue not initialized errors ; 90$: MOVL #QUE_NOTINITIALIZED,R0 ; Q_block not valid RET .PAGE .SBTTL GET_MID_INDEX - Routine to get the MID index ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&GET_MID_INDEX\& ; .nf ; .x GET_MID_INDEX>Defined ; Source:GET_MID_INDEX.MOD ; Designer :PAUL VESTUTO, EARL LAKIA ; Author :PAUL VESTUTO ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update: 29-JUL-1986 12:00:00.00 ; Revision level :1.0 ; ; .C ;Formal Parameter List ; Receives: ; ; Q_BLOCK INTEGER*4(2) ; Q BLOCK DESCRIPTOR ADDRESS, CONTAINS THE START ; ADDRESS FOR P0 (Q_BLOCK(1)) AND THE END ADDRESS ; FOR P0 (Q_BLOCK(2)). ; ; MESSAGE_ID CHARACTER*16 ; MESSAGE ID DESCRIPTOR BLOCK ; ; Returns: ; ; GET_MID_INDEX INTEGER*4 ; THIS IS THE RETURN CODE AS DESCRIBED BY THE VMS ; STANDARDS AND THE QUESRV STANDARDS. ; ; INDEX INTEGER*2 ; INDEX INTO MID LIST IN THE GLOBAL SECTION ; ; ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; ; ; This routine finds the specified message ID in the MID list and ; returns the index into the list. ; ; This routines expects the parameters to be valid and that the caller has ; already called the appropriate initialization routines. If any of the above ; conditions are not met, an appropriate return code is returned to the caller. ; ; .tp 20 ; .nofill ; .SKIP ; INCLUDE 'MA_Q$DEF:QUEUE.TLB(QUECONST)' ; INTEGER*4 Q_BLOCK(2) ; INTEGER*2 INDEX ; CHARACTER*16 MESSAGE_ID ; MESSAGE_ID = 'STEEL_AVAILABLTY' ; ... ; STATUS = GET_MID_INDEX (Q_BLOCK, MESSAGE_ID, INDEX) ; ; POSSIBLE ERRORS: ; .SK ; .list 1,' ' ; .LE;QUE_INSFARG - Insufficient arguments ; .X QUE_INSFARG ; .LE;QUE_INVARG - Invalid arguments ; .X QUE_INVARG ; .LE;QUE_NOTINITIALIZED - Queueing functions have not been initialized ; .X QUE_NOTINITIALIZED ; .LE;QUE_MIDNOTFOUND - Message ID not found in list ; .X QUE_MIDNOTFOUND ; .ELS ; ; .fill ; end.doc ****************************** end.doc ; .PAGE .ENTRY GET_MID_INDEX,^M CMPB (AP), #3 ; enough arguments ? BLSSU 10$ ; Nope, return MOVL 4(AP),R3 ; Get the Q Block address IFNOWRT #8, (R3), 20$ ; insure Q_BLOCK readable MOVL 8(AP),R11 ; Get the Message ID Descriptor address IFNOWRT #8, (R11), 20$ ; insure MID descriptor readable MOVL 4(R11), R11 ; Now get the message ID buffer IFNORD #MID$K_SIZ, (R11), 20$ ; insure structure readable MOVL 12(AP), R8 ; Get index buffer IFNOWRT #2, (R8), 20$ ; insure buffer writeable $CMKRNL_S ROUTIN=30$ ; Jump into Kernel RET ; R0 has the return code 10$: MOVL #QUE_INSFARG, R0 ; Insufficient arguments RET 20$: MOVL #QUE_INVARG, R0 ; Invalid arguments RET 25$: MOVL #QUE_NOTINITIALIZED, R0 ; Not initialized RET ; ; ********** In KERNEL Mode ********** ; 30$: .WORD ^M ; ; Make sure we are initialized ; MOVL (R3), R6 ; Get the P0 starting address IFNOWRT #PEX$K_LEN, (R6), 25$ ; insure readable CMPL (R3), PEX$L_SREG(R6) ; PASSED start same as STORED ? BNEQ 25$ ; no CMPL 4(R3), PEX$L_EREG(R6) ; PASSED end same as STORED ? BNEQ 25$ ; no ; ; Protect this process from being deleted ; DSBINT #IPL$_ASTDEL ; Disable AST interrupts and below ; ; Find MID index ; MOVL PEX$Q_GSRETADR(R6), R10 ; Global Section Virtual Address JSB CHECK_LOCK ; Wait if MID list is locked BLBS R0,60$ ; Are we still mapped correctly? BRW 77$ ; NO 60$: JSB MID_INDEX ; Get mid index MOVW R5, (R8) ; Return the index 77$: DECL QHD$L_INSRV(R10) ; decrement count of processes in service ENBINT ; Enable interrupts to previous level RET .page .sbttl MID_INDEX ; ; This subroutine returns the index and the MID address if the specified ; MID is found in the list. If not found, an index of zero is returned ; with an appropriate error code. ; ; Inputs: R10 = GS VA ; R11 = MID buffer ; Outputs: R5 = Index into list ; (0 if not found), ; R9 = MID address in GS ; (Address following last MID if R5=0) ; R0= SS$_NORMAL or QUE_MIDNOTFOUND ; MID_INDEX:: ; PUSHR #^M ; Save some registers BSBW HASHIT ; calculate hash key ; ; R0= HASH KEY (0 to 127) ; MOVL #MID$K_SIZ,R5 ; size of a message id to verify ADDL3 #QHD$C_HASH,R10,R4 ; point to start of hash table MOVL (R4)[R0],R9 ; Get first thread from hash table BEQL 60$ ; Message ID not found ; ; Note: All threads are with respect to beginning of the queue. ; 50$: ADDL2 R10,R9 ; Relocate offset to address CMPC3 R5,MID$C_MID(R9),(R11) ; Message ID's match? BEQL 70$ ; Yes, found the message id then MOVL MID$L_HASH(R9),R9 ; Get forward hash chain thread BNEQ 50$ ; End of chain?, continue thread if not ; ; not found ; 60$: MOVL #QUE_MIDNOTFOUND, R0 ; MID not found CLRL R5 ; Zero index POPR #^M ; Restore registers RSB ; ; Found the message id ; 70$: BITL #MID$M_DEL,MID$L_STAT(R9) ; Has this ID been deleted? BEQL 80$ ; No, must have it then MOVL #QUE_MIDDELETED,R0 ; Error code CLRL R5 ; No index if deleted POPR #^M ; Restore registers RSB 80$: MOVL R9,R5 ; Copy the message id address SUBL2 #QHD$K_SIZ,R5 ; Remove header size SUBL2 R10,R5 ; Change to offset within quuee DIVL2 #MID$K_LEN,R5 ; Change to mid offset (MID relative) INCL R5 ; Change offset to index MOVL #SS$_NORMAL,R0 ; Good status POPR #^M ; Restore registers RSB .page .SBTTL HASHIT ; ; This subroutine will calculate the hash key for a message id. ; ; INPUTS: ; R11= Message id ; OUTPUTS: ; R0= Hash key ; R2= Destroyed ; HASHIT: PUSHR #^M MOVL #MID$K_SIZ,R2 ; 16 bytes to sum over CLRL R0 ; Init hash key 10$: ADDB2 (R11)+,R0 ; Calculate by adding all bytes along XORB2 R2,R0 ; with XOR char. position backwards. SOBGTR R2,10$ ; Loop until addition complete BICL2 #^XFFFFFF80,R0 ; Only want 7 Bits POPR #^M RSB .page .SBTTL CHECK_MID_INDEX ; ; This subroutine compares the specified MID index with the specified MID name. ; If not compatible, the PEX$M_INVIDX bit is set in the PEX$L_STAT long word ; in the P0 region. It is up to the caller to check this flag to insure the ; two are compatible. ; ; Inputs: R6=P0 Address, R9=index address, R10=GS VA, R11=MID buffer ; Outputs: R9 = MID address in GS (Invalid if not found) ; CHECK_MID_INDEX:: ; PUSHR #^M ; Save some registers BICL2 #PEX$M_INVIDX, PEX$L_STAT(R6) ; Clear the INCOMPATIBLE flag CMPW (R9), QHD$L_IDC(R10) ; Is this index beyond the limit ? BGTR 30$ ; Yes, return ERROR MOVZWL (R9), R9 ; Get index into MID list BLEQ 30$ ; Zero value, return ERROR DECL R9 ; (convert to offset) MULL2 #MID$K_LEN, R9 ; Get offset into MID list ADDL2 R10, R9 ; Add address of MID list ADDL2 #QHD$K_SIZ, R9 ; Get past Q header MOVL #MID$K_SIZ, R3 ; Get size to check CMPC3 R3, MID$C_MID(R9), (R11) ; Is this the same ? (R0-R5 invalid) BNEQ 20$ ; No, return WARNING (set flag) MOVL #SS$_NORMAL, R0 ; MID found POPR #^M ; Restore registers RSB 20$: BISL2 #PEX$M_INVIDX, PEX$L_STAT(R6) ; Set the INCOMPATIBLE flag 30$: MOVL #QUE_MIDNOTFOUND, R0 ; MID not found POPR #^M ; Restore registers RSB .PAGE .SBTTL CHECK_LOCK ; ; This subroutine checks the MID list lock flag. If set, the Null lock is ; converted to see if the list may be accessed. This check is basically ; for the Queue utilities when the MID list is being reorganized. ; ; To provide for the ability to gracefully shutdown the queue and ; insure that it will be in a good state next time, then also ; check the queue status long word to see if the queue is being ; shutdown. ; ; The protection logic is as follows: ; ; TO ACCESS QUEUE ; To gain access to the queue, the following proceedure must ; be followed by the system service: ; ; 1)Status the queue header QHD$_STAT to see if the QHD$M_LOCK ; bit is set. If it is: ; Attempt to capture the QHD$C_CLOCK lock. ; When the lock is captured, release the lock and ; go to 1 above. ; If it is not set, then: ; Promote IPL to ASTDEL (so we can ; not be deleted and leave the QUEUE in a not accessible or ; never lockable state). ; ; Increment the in use counter (QHD$L_INSRV) ; Test the flag in the queue header QHD$L_STAT one more ; time, if it is now set (there is a couple instruction ; window that could occurr) then decrement QHD$L_INSRV and ; go to 1 above. ; ; Otherwise do the processing ; Decrement the in use counter (QHD$L_INSRV) ; Drop IPL back down ; ; TO MONOPOLIZE QUEUE ; To monopolize the queue (in particular the Q_UTL program) ; the following must be performed: ; Capture the QHD$L_CLOCK for exclusive mode. ; Set the QHD$M_LOCK in the QHD$L_STAT flag word. ; If the in use counter (QHD$L_INSRV) is zero, then ; the queue has been successfully been monopolized. ; ; Otherwise, wait until the QHD$L_INSRV goes to ; zero (wait and check type loop). ; Do the processing ; Clear the QHD$M_LOCK bit in QHD$L_STAT ; and then release the QHD$M_LOCK. ; ; Inputs: R6 = P0 VA, R10 = GS VA ; ASSUMES IPL=IPL$_ASTDEL ; Outputs: none ; CHECK_LOCK:: ; RSB;;; ; 10$: ;;; JSB G^INI$BRK BITL #QHD$M_SHUTDOWN,QHD$L_STAT(R10) ; is queue shut down? BEQL 12$ ; NO MOVL #QUE_SHUTDOWN,R0 ; Return status RSB 12$: BITL #QHD$M_LOCK, QHD$L_STAT(R10) ; Is the Lock flag set ? BEQL 20$ ; No let the caller keep processing ; ; Capture the Queue lock ; 15$: SETIPL #0 ; LOWER OUR IPL BACK $ENQW_S LKMODE=#LCK$K_EXMODE, - ; Exclusive mode LKSB=PEX$C_LOCK(R6), - ; 24B Status block for ENQW FLAGS=#LCK$M_SYSTEM!LCK$M_VALBLK!LCK$M_CONVERT BLBC R0, 20$ ;CHECK STATUS ; ; Release the Queue lock ; $ENQW_S LKMODE=#LCK$K_NLMODE, - ; Null mode LKSB=PEX$C_LOCK(R6), - ; 24B Status block for ENQW FLAGS=#LCK$M_SYSTEM!LCK$M_VALBLK!LCK$M_CONVERT SETIPL #IPL$_ASTDEL ; BACK TO AST DEL BRW 10$ ; Check the flag again 20$: INCL QHD$L_INSRV(R10) ; INCREMENT IN SERVICE COUNT BITL #QHD$M_LOCK,QHD$L_STAT(R10) ; WAS SOMEONE TRYING TO CAPTURE BEQL 30$ ; WHILE WE INCRMENTED IT?, JUMP IF NOT DECL QHD$L_INSRV(R10) ; DECREMENT AS BEING IN SERVICE BRW 15$ ; SOMEONE GOT IT. GO GET LOCK ETC. 30$: CMPL PEX$L_RSB(R6),QHD$L_RSB(R10) ; Are we mapped to same resource BEQL 40$ ; YES MOVL #QUE_BADLOCK,R0 ; No, return lock problem RSB 40$: MOVL #SS$_NORMAL,R0 RSB .page .SBTTL CAPQUE ; ; This subroutine is called to monopolize the queue (see ; description in check_queue subroutine). The only exception ; is that the in service counter is not checked as any caller ; to this must also capture the lock which will protect the ; queue from two modifiying processes. ; ; There exists a small time while another process could be ; cleaning up when this process could be deleted. However, ; this would only disable the queue and not corrupt the system. ; ; ; INPUTS: ; R6 = P0 Expanded region address ; R10 = Global section address ; OUTPUTS: ; R0= Status code (in the event the ENQ fails or the like) ; R6, R10 are preserved ; CAPQUE: ; ; Capture the Queue lock ; $ENQW_S LKMODE=#LCK$K_EXMODE, - ; Exclusive mode LKSB=PEX$C_LOCK(R6), - ; 24B Status block for ENQW FLAGS=#LCK$M_SYSTEM!LCK$M_VALBLK!LCK$M_CONVERT BLBS R0,80$ ; Bad status?, jump if yes ; ; Now tell everyone to capture the lock. (ie: put some ; constipation into the queue. ; BISL2 #QHD$M_LOCK,QHD$L_STAT(R10) ; SET THE BIT 10$: TSTL QHD$L_INSRV(R10) ; is there still someone in the ; service to wait to finish BEQL 80$ ; no, then we got it ; ; Must wait for other user(s) to finish, therefore, drop pritority ; until other's get out. ; ENBINT ; Enable interrupts while we wait CLRL -(SP) ; Make room for the old priority MOVL SP,R0 ; Where that will be $SETPRI_S- PRI=#1,- ; lowest priority PRVPRI=(R0) ; where to store previous priority ; so we will be able to reset it 20$: TSTL QHD$L_INSRV(R10) ; is the queue all our's yet? BNEQ 20$ ; Is it our's yet? MOVL SP,R0 ; Get old priority address $SETPRI_S - PRI=(R0) ; Restore the priority TSTL (SP)+ ; Pop stack DSBINT #IPL$_ASTDEL ; Don't let anyone delete us again 80$: RSB .PAGE .SBTTL RELQUE ; ; This subroutine is called to release a monopolized queue (see ; description in the check_queue subroutine). ; ; INPUTS: ; R6 = P0 Expanded region address ; R10 = Global section address ; OUTPUTS: ; R0= Status code (in the event the ENQ fails or the like) ; R6, R10 are preserved ; RELQUE: BICL #QHD$M_LOCK,QHD$L_STAT(R10) ; Tell everyone we ; are done with the queue ; ; Release the lock ; $ENQW_S LKMODE=#LCK$K_NLMODE, - ; Null mode LKSB=PEX$C_LOCK(R6), - ; 24B Status block for ENQW FLAGS=#LCK$M_SYSTEM!LCK$M_VALBLK!LCK$M_CONVERT RSB .PAGE .SBTTL Read Queue ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&READ_Q\& ; .nf ; .x READ_Q>Defined ; Source:READ_Q.MOD ; Designer :PAUL VESTUTO, EARL LAKIA ; Author :PAUL VESTUTO, Earl Lakia ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update: 16-jun-1988 ; Revision level :1.1 ; ; .C ;Formal Parameter List ; ; ; Q_BLOCK INTEGER*4(2) ; Q BLOCK DESCRIPTOR ADDRESS, WILL CONTAIN THE ; START ADDRESS FOR P0 (Q_BLOCK(1)) AND THE END ; ADDRESS FOR P0 (Q_BLOCK(2)). ; ; MESSAGE_ID CHARACTER*16 ; MESSAGE ID TO READ FROM. ; ; MIDX INTEGER*2 (OPTIONAL) ; INDEX OF MESSAGE ID. USED FOR FASTER ACCESS ; TO THE MESSAGE ID HEADER. IF NOT SPECIFIED, ; THE MESSAGE ID NAME IS USED. IF SPECIFIED, ; THE NAME CALCULATED FROM THE INDEX IS ; COMPARED WITH THE PASSED NAME, AND IF NOT ; THE SAME, THE PASSED NAME IS USED. ; ; Returns: ; ; MESSAGE_BUFFER CHARACTER*(LENGTH) ; BUFFER TO READ INTO. THE SPECIFIED LENGTH ; MUST BE LARGE ENOUGH TO HOLD THE LARGEST ; POSSIBLE MESSAGE PLUS THE MESSAGE HEADER. ; FOR EXAMPLE: IF A MESSAGE WAS WRITTEN AS 230 ; BYTES, THE READER MUST HAVE A BUFFER LARGE ; ENOUGH TO HOLD THE 230 TEXT BYTES, PLUS ; HDR$K_SIZ BYTES FOR THE MESSAGE HEADER. ; IF NOT LARGE ENOUGH, AN APPROPRIATE ERROR ; MESSAGE WILL BE RETURNED. ; ; RNA_POINTER INTEGER*4 ; POINTER TO THIS MESSAGE, WHICH HAS JUST BECOME ; THE NEW RNA MESSAGE. THIS VALUE IS USED FOR ; ACKNOWLEGING READING A MESSAGE. ; ; READ_Q INTEGER*4 ; THIS IS THE RETURN CODE AS DESCRIBED BY THE VMS ; STANDARDS AND THE QUESRV STANDARDS. ; ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; ; This routine reads a message from the specified message ID. ; The following conditions are checked: ; .LIST 1,' ' ; .LE;the message ID exists ; .LE;the message ID does not have an RNA message ; .LE;the message ID does have an unread message ; .LE;the calling process is connected to the specified message ID ; .LE;the user buffer is large enough to hold the next message ; .ELS ; ; If any of the above conditions are not met, an appropriate error ; message is returned. ; ; The queue does not get checkpointed because the read information ; is considered to be volatile. ; ; This routines expects the parameters to be valid, if not an ; appropriate return code is returned to the caller. ; ; .tp 27 ; .nofill ; .SKIP ; INCLUDE 'MA_Q$DEF:QUEUE.TLB(QUECONST)' ; INCLUDE 'MA_Q$DEF:QUEUE.TLB(HDRDEF)' ; INTEGER*4 Q_BLOCK(2) ; INTEGER*4 RNA_POINTER ; INTEGER*2 MIDX ; CHARACTER MESSAGE_ID*16 ; MESSAGE_ID = 'STEEL_AVAILABLTY' ; CHARACTER MESSAGE_BUFFER*512 ; C ; C Define the message header and the rest of the read message packet ; C ; C NOTE: This structure is used to define both sections of the message ; C coming back from the queue, the message header and the message ; C body. The UNION is used to allow the caller to pass a buffer ; C large enough to read the entire message. That is, if just the ; C MESBUFHDR sub-structure was passed, the system service would ; C reject the call due to the buffer being too small (if the ; C message had a non-zero length) since the buffer is passed ; c by descriptor. ; C ; STRUCTURE /MESBUF/ ; UNION ; MAP ; CHARACTER MESSAGE_ALL*(1024) ; END MAP ; MAP ; RECORD /HDRDEF/ MESBUFHDR ; CHARACTER MESSAGE_BUF*(512) ; END MAP ; END UNION ; END STRUCTURE ; RECORD /MESBUF/ MESSAGE ; ... ; STATUS = READ_Q (Q_BLOCK, MESSAGE_ID, MESSAGE.MESSAGE_ALL, ; RNA_POINTER) ; or ; STATUS = READ_Q (Q_BLOCK, MESSAGE_ID, MESSAGE.MESSAGE_ALL, ; RNA_POINTER, MIDX) ; ; POSSIBLE ERRORS: ; .SK ; .list 1,' ' ; .LE;QUE_INSFARG - Insufficient arguments ; .X QUE_INSFARG ; .LE;QUE_INVARG - Invalid arguments ; .X QUE_INVARG ; .LE;QUE_NOTINITIALIZED - Queueing functions have not been initialized ; .X QUE_NOTINITIALIZED ; .LE;QUE_NOMESS - No message for the specified message ID ; .X QUE_NOMESS ; .LE;QUE_INVIDX - MID index is not consistant with MID name ; .X QUE_INVIDX ; .LE;QUE_IDXOOR - MID index is out of range ; .X QUE_IDXOOR ; .LE;QUE_MIDNOTFOUND - Message ID not found in list ; .X QUE_MIDNOTFOUND ; .LE;QUE_BUFTOOSMALL - User buffer is too small for message ; .X QUE_BUFTOOSMALL ; .LE;QUE_RNAMESS - There is an outstanding read-not-acknowleged mesage ; .X QUE_RNAMESS ; .LE;QUE_MIDNOTATT - Message ID is not attached ; .X QUE_MIDNOTATT ; .LE;QUE_HEADNOTREM - Message header unable to be removed from Message ID list ; .X QUE_HEADNOTREM ; .ELS ; ; .fill ; end.doc ****************************** end.doc ; .PAGE .ENTRY READ_Q,^M ; ; Check the passed parameter ; CMPB (AP), #4 ; enough arguments? BLSSU 10$ ; NO MOVL 4(AP), R3 ; Get the Q_BLOCK address IFNOWRT #8, (R3), 20$ ; insure Q_BLOCK readable MOVL AP, R8 ; Save argument pointer MOVL 8(AP), R11 ; Get MID descriptor buffer address IFNORD #8,(R11), 20$ ; insure readable MOVL 4(R11), R11 ; Get MID buffer address IFNORD #MID$K_SIZ, (R11), 20$ ; insure readable MOVL 12(AP), R5 ; Get user buffer descriptor IFNORD #8,(R5),20$ ; descriptor readable? ++6.26 MOVZWL (R5),R0 ; get user buffer byte count ++6.26 MOVL 4(R5),R1 ; get user buffer address ++6.26 IFNOWRT R0,(R1),20$ ; will we be able to write to it? ++6.26 $CMKRNL_S ROUTIN=30$ ; Jump into Kernel mode RET ; R0 has the return code ; 10$: MOVL #QUE_INSFARG, R0 ; Insufficient arguments RET 20$: MOVL #QUE_INVARG, R0 ; Invalid arguments RET 22$: MOVL #QUE_NOTINITIALIZED, R0 ; Not initialized RET ; ; ********** In KERNEL Mode/PREVIOUS MODE KERNEL ********** ; 30$: .WORD ^M<> ; ; Make sure we are initialized ; R3=Q_BLOCK ; R8=AP in original call frame ; R11= MID Name buffer ; MOVL #QUE_NOTINITIALIZED, R0 ; Init status to "not initialized" MOVL (R3), R6 ; Get the P0 starting address IFNOWRT #PEX$K_LEN, (R6), 22$ ; insure readable CMPL (R3), PEX$L_SREG(R6) ; PASSED start same as STORED ? BNEQ 22$ ; no CMPL 4(R3), PEX$L_EREG(R6) ; PASSED end same as STORED ? BNEQ 22$ ; no ; ; Protect this process from being deleted ; DSBINT #IPL$_ASTDEL ; Disable AST interrupts and below ; ; Find the message ID in the list ; BICL #PEX$M_INVIDX, PEX$L_STAT(R6) ; Clear INCOMPATIBLE flag MOVL PEX$Q_GSRETADR(R6), R10 ; Get virtual address for GS JSB CHECK_LOCK ; Wait if MID list is locked BLBS R0,31$ ; locks still in place? RET ; no 31$: ; Use the index if found CMPB (R8), #5 ; passed MID index ? BLSS 32$ ; No MOVL 20(R8), R9 ; Get index address IFNORD #2, (R9), 41$ ; Insure readable JSB CHECK_MID_INDEX ; Check MID index BLBS R0, 34$ ; Passed index same as passed name BITL #PEX$M_INVIDX, PEX$L_STAT(R6) ; Was this a warning error? BNEQ 32$ ; yes, then go use name then instead 48$: MOVL #QUE_IDXOOR, R0 ; No, index must be out of range BRW LEAVE_READ_Q ; Return ; ; use the MID name ; 32$: JSB MID_INDEX ; find this MID (R5, R9 NEW) BLBC R0, 42$ ; not found 34$: CMPL MID$L_CPID(R9), PEX$L_PID(R6) ; This process attached ? BNEQ 44$ ; No TSTL MID$L_RNA(R9) ; Is there an RNA message? BNEQ 46$ ; Yes TSTL MID$L_FLK(R9) ; Is there a forward link? BEQL 47$ ; No MOVAB MID$L_FLK(R9), R7 ; Get address of forward link ADDL2 MID$L_FLK(R9), R7 ; Add in forward link offset MOVZWL QS2$C_HDR+HDR$W_LEN(R7), R11 ; Get length of message ADDL2 #HDR$K_SIZ, R11 ; Transfer header also MOVL 12(R8),R3 ; get buffer descriptor CMPW (R3), R11 ; Enough room in user buffer? BLSS 43$ ; No BRW 60$ ; 41$: MOVL #QUE_INVARG, R0 ; Invalid arguments BRW LEAVE_READ_Q 42$: MOVL #QUE_MIDNOTFOUND, R0 ; MID not found BRW LEAVE_READ_Q 43$: MOVL #QUE_BUFTOOSMALL, R0 ; Buffer too small BRW LEAVE_READ_Q 44$: MOVL #QUE_MIDNOTATT, R0 ; MID not attached BRW LEAVE_READ_Q 45$: MOVL #QUE_HEADNOTREM, R0 ; Message header not removed BRW LEAVE_READ_Q 46$: MOVL #QUE_RNAMESS, R0 ; There is an RNA message BRW LEAVE_READ_Q 47$: MOVL #QUE_NOMESS, R0 ; No outstanding message BRW LEAVE_READ_Q .page ; ; Remove the first control block from the message list ; and insert it in the RNA pointer header. ; ; R3= user buffer descriptor ; 60$: REMQHI MID$L_FLK(R9), R2 ; remove block BVC 70$ ; successful, control block removed BCS 60$ ; Interlock failed, try again JMP 45$ ; Remove failed 70$: INSQTI (R2), MID$L_RNA(R9) ; Insert this into the RNA header BCS 70$ ; Interlock failed, try again MOVL MID$L_RNA(R9), @16(R8) ; Pass back RNA pointer CLRL PEX$L_HEADLINK(R6) ; Clear next block pointer TSTL QS2$L_DLNK(R2) ; More control blocks ? BEQL 74$ ; Nope MOVAB QS2$L_DLNK(R2), PEX$L_HEADLINK(R6) ; Get address of control block pointer ADDL2 QS2$L_DLNK(R2), PEX$L_HEADLINK(R6) ; Add offset to get address of control block 74$: MOVAB QS2$L_DLNK(R2), R9 ; Save address of data link header ADDL2 #QS2$C_HDR, R2 ; Get to header area of control block 1 MOVL #QS2$K_MSGL+HDR$K_SIZ, R7 ; Move message chunk + header from block 1 ; ; Transfer control block data ; MOVL 4(R3), R8 ; user buffer address CHECK_LENGTH: CMPL R7, R11 ; Is there less than one chunk ? BLSS 20$ ; No MOVL R11, R7 ; Move what is left 20$: MOVL R4, R10 ; Save PCB address MOVC3 R7, (R2), (R8) ; Move data (R0-R5 invalid) MOVL R10, R4 ; restore PCB address ADDL R7, R8 ; Point to next byte in user buffer SUBL2 R7, R11 ; subtract what we moved MOVL PEX$L_HEADLINK(R6), R2 ; Get address of next control block BEQL 60$ ; No more MOVAB QST$L_FLNK(R2), PEX$L_HEADLINK(R6) ; Get address of control block pointer ADDL2 QST$L_FLNK(R2), PEX$L_HEADLINK(R6) ; Add offset to get address of control block CMPL PEX$L_HEADLINK(R6), R9 ; Does this point back to link head? BNEQ 50$ ; Nope, leave it alone CLRL PEX$L_HEADLINK(R6) ; Clear the pointer for next time around 50$: ADDL2 #QST$C_MSG, R2 ; Get to data area of control block 2-N MOVL #QST$K_MSGL, R7 ; Move 1 message chunk BRW CHECK_LENGTH ; More data, Do it ; ; All done, return status ; 60$: BITL #PEX$M_INVIDX, PEX$L_STAT(R6) ; INCOMPATIBLE flag set ? BEQL 76$ ; No MOVL #QUE_INVIDX, R0 ; Yes, return warning status BICL #PEX$M_INVIDX, PEX$L_STAT(R6) ; Clear flag BRW LEAVE_READ_Q ; return control to caller 76$: MOVL #SS$_NORMAL, R0 ; successful completion status LEAVE_READ_Q: MOVL PEX$Q_GSRETADR(R6), R10 ; Get virtual address for GS DECL QHD$L_INSRV(R10) ; decrement count of processes in service ENBINT ; Enable interrupts to previous level RET .PAGE .SBTTL Router Write Queue ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&RTR_WRITE_Q\& ; .nf ; .x RTR_WRITE_Q>Defined ; Source:RTR_WRITE_Q.MOD ; Designer :PAUL VESTUTO, EARL LAKIA ; Author :PAUL VESTUTO, Earl Lakia ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update: 16-jun-1988 ; Revision level :1.1 ; ; .C ;Formal Parameter List ; ; ; Q_BLOCK INTEGER*4(2) ; Q BLOCK DESCRIPTOR ADDRESS, WILL CONTAIN THE ; START ADDRESS FOR P0 (Q_BLOCK(1)) AND THE END ; ADDRESS FOR P0 (Q_BLOCK(2)). ; ; MESSAGE_ID CHARACTER*16 ; MESSAGE ID ; ; MESSAGE_BUF CHARACTER*(x) ; BUFFER CONTAINING TEXT OF MESSAGE TO ADD TO ; QUEUE. ; ; MESSAGE_LENGTH INTEGER*2 ; LENGTH OF MESSAGE. ; ; MESAGE_TYPE INTEGER*2 ; TYPE OF MESSAGE ; ; MIDX INTEGER*2 (OPTIONAL) ; INDEX OF MESSAGE ID. USED FOR FASTER ACCESS ; TO THE MESSAGE ID HEADER. IF NOT SPECIFIED, ; THE MESSAGE ID NAME IS USED. IF SPECIFIED, ; THE NAME CALCULATED FROM THE INDEX IS ; COMPARED WITH THE PASSED NAME, AND IF NOT ; THE SAME, THE PASSED NAME IS USED. ; ; Returns: ; ; RTR_WRITE_Q INTEGER*4 ; THIS IS THE RETURN CODE AS DESCRIBED BY THE VMS ; STANDARDS AND THE QUESRV STANDARDS. ; ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; ; ; This routine adds a message to the specified Message ID. ; The only difference between this routine and WRITE_Q is that the header ; does not get added to the front of the text in this routine. The MAQ ; router uses this routine to bypass adding the header since it already ; precedes the data. ; ; This routines expects the parameters to be valid, if not an ; appropriate return code is returned to the caller. ; ; .tp 30 ; .nofill ; .SKIP ; INCLUDE 'MA_Q$DEF:QUEUE.TLB(QUECONST)' ; INTEGER*4 STATUS ! System service return status ; INTEGER*4 Q_BLOCK(2) ! from ATTACH_Q ; CHARACTER MESSAGE_ID*16 ! Id we will be writing ; CHARACTER MESSAGE*512 ! message buffer (passed by descp.) ; INTEGER*2 LENGTH ! size of messasge (note: word) ; INTEGER*2 MTYPE ! type: deletable or not (note: word) ; INTEGER*2 MIDX ! Index of Message ID ; MESSAGE_ID = 'STEEL_AVAILABLTY' ; MESSAGE = 'BOF OXYGEN ON, HEAT=60010, TIME=30-JUL-1986 10:44:55.37' ; LENGTH = 55 ; MTYPE = 0 ; ... ; STATUS = RTR_WRITE_Q (Q_BLOCK, MESSAGE_ID, MESSAGE, LENGTH, MTYPE) ; or ; STATUS = RTR_WRITE_Q (Q_BLOCK, MESSAGE_ID, MESSAGE, LENGTH, ; MTYPE, MIDX) ; IF (STATUS .NE. %LOC(QUE_SUCCESS))THEN ; ... ERROR ... ; ENDIF ; ; POSSIBLE ERRORS: ; .SK ; .list 1,' ' ; .LE;QUE_INVIDX - MID index is not consistant with MID name ; .X QUE_INVIDX ; .LE;QUE_IDXOOR - MID index is out of range ; .X QUE_IDXOOR ; .LE;QUE_MIDNOTFOUND - Message ID not found in list ; .X QUE_MIDNOTFOUND ; .LE;QUE_INSFARG - Insufficient arguments ; .X QUE_INSFARG ; .LE;QUE_INVARG - Invalid arguments ; .X QUE_INVARG ; .LE;QUE_NOTINITIALIZED - Queueing functions have not been initialized ; .X QUE_NOTINITIALIZED ; .LE;QUE_INSFREE - Insufficient number of free blocks ; .X QUE_INSFREE ; .LE;QUE_MIDMAX - Message ID is at maximum allowed messages ; .X QUE_MIDMAX ; .LE;QUE_NOCHK - Checkpoint process is not available ; .X QUE_NOCHK ; .ELS ; ; .fill ; end.doc ****************************** end.doc ; .PAGE .ENTRY RTR_WRITE_Q,^M ; ; Check the passed parameter ; CMPB (AP), #5 ; enough arguments? BLSSU 10$ ; NO MOVL 4(AP), R3 ; Get the Q_BLOCK address IFNOWRT #8, (R3), 20$ ; insure Q_BLOCK readable ; check message_id parameter MOVL 8(AP), R2 ; Get MID descriptor address IFNORD #8, (R2), 20$ ; Insure descriptor readable MOVL 4(R2), R2 ; Get MID buffer IFNORD #MID$K_SIZ, (R2), 20$ ; Insure descriptor readable ; check message parameter MOVL 12(AP), R2 ; Get message descriptor address IFNORD #8, (R2), 20$ ; Insure descriptor readable MOVZWL (R2),R0 ; Get user buffer byte count ++6.26 MOVL 4(R2),R1 ; Get user buffer address ++6.26 IFNORD R0,(R1),20$ ; Make sure it is all readable ++6.26 ; check message length parameter MOVL 16(AP), R1 ; Get message length address IFNORD #2, (R1), 20$ ; Insure descriptor readable CMPW (R1), (R2) ; Passed length greater than actual ? BGTR 20$ ; Yes, don't let user add message ; check message type parameter MOVL 20(AP), R2 ; Get message type address IFNORD #2, (R2), 20$ ; Insure descriptor readable ; MOVL AP, R8 ; Save argument pointer $CMKRNL_S ROUTIN=30$ ; Jump into Kernel mode RET ; R0 has the return code 10$: MOVL #QUE_INSFARG, R0 ; Insufficient arguments RET 20$: MOVL #QUE_INVARG, R0 ; Invalid arguments RET 25$: MOVL #QUE_NOTINITIALIZED, R0 ; Not initialized RET ; ; ********** In KERNEL Mode/PREV=KERNEL ********** ; 30$: .WORD ^M ; ; Make sure we are initialized ; MOVL (R3), R6 ; Get the P0 starting address IFNOWRT #PEX$K_LEN, (R6), 25$ ; insure readable CMPL (R3), PEX$L_SREG(R6) ; PASSED start same as STORED ? BNEQ 25$ ; no CMPL 4(R3), PEX$L_EREG(R6) ; PASSED end same as STORED ? BNEQ 25$ ; no BISL2 #PEX$M_RTRFLAG, PEX$L_STAT(R6) ; Set flag to indicate router call JSB WRITE_Q_BODY ; Write the data to the queue RET .PAGE .SBTTL Write Queue ;.begin.doc ************************** begin.doc ; ; .c ;MODULE ; .c ;^&WRITE_Q\& ; .nf ; .x WRITE_Q>Defined ; Source:WRITE_Q.MOD ; Designer :PAUL VESTUTO, EARL LAKIA ; Author :PAUL VESTUTO, Earl Lakia ; Inland Steel ; Process Automation Department ; 3210 Watling St. MS 2-465 ; East Chicago, IN 46312 ; ; Date of last update: 16-jun-1988 ; Revision level :1.1 ; ; .C ;Formal Parameter List ; ; ; Q_BLOCK INTEGER*4(2) ; Q BLOCK DESCRIPTOR ADDRESS, WILL CONTAIN THE ; START ADDRESS FOR P0 (Q_BLOCK(1)) AND THE END ; ADDRESS FOR P0 (Q_BLOCK(2)). ; ; MESSAGE_ID CHARACTER*16 ; MESSAGE ID ; ; MESSAGE_BUF CHARACTER*(x) ; BUFFER CONTAINING TEXT OF MESSAGE TO ADD TO ; QUEUE. ; ; MESSAGE_LENGTH INTEGER*2 ; LENGTH OF MESSAGE. ; ; MESAGE_TYPE INTEGER*2 ; TYPE OF MESSAGE ; ; MIDX INTEGER*2 (OPTIONAL) ; INDEX OF MESSAGE ID. USED FOR FASTER ACCESS ; TO THE MESSAGE ID HEADER. IF NOT SPECIFIED, ; THE MESSAGE ID NAME IS USED. IF SPECIFIED, ; THE NAME CALCULATED FROM THE INDEX IS ; COMPARED WITH THE PASSED NAME, AND IF NOT ; THE SAME, THE PASSED NAME IS USED. ; ; Returns: ; ; WRITE_Q INTEGER*4 ; THIS IS THE RETURN CODE AS DESCRIBED BY THE VMS ; STANDARDS AND THE QUESRV STANDARDS. ; ; Accesses common(s): ; ; Accesses file(s): ; ; Other modules referenced: ; .SK ; .fill ; .SK ; Description: ; .sk ; ; ; This routine adds a message to the specified Message ID. ; ; This routines expects the parameters to be valid, if not an ; appropriate return code is returned to the caller. ; ; .tp 35 ; .nofill ; .SKIP ; INCLUDE 'MA_Q$DEF:QUEUE.TLB(QUECONST)' ; INTEGER*4 STATUS ! System service return status ; INTEGER*4 Q_BLOCK(2) ! from ATTACH_Q ; CHARACTER MESSAGE_ID*16 ! Id we will be writing ; CHARACTER MESSAGE*512 ! message buffer (passed by descp.) ; INTEGER*2 LENGTH ! size of messasge (note: word) ; INTEGER*2 MTYPE ! type: deletable or not (note: word) ; INTEGER*2 MIDX ! Index of Message ID ; MESSAGE_ID = 'STEEL_AVAILABLTY' ; MESSAGE = 'BOF OXYGEN ON, HEAT=60010, TIME=30-JUL-1986 10:44:55.37' ; LENGTH = 55 ; MTYPE = 0 ; ... ; STATUS = WRITE_Q (Q_BLOCK, MESSAGE_ID, MESSAGE, LENGTH, MTYPE) ; or ; STATUS = WRITE_Q (Q_BLOCK, MESSAGE_ID, MESSAGE, LENGTH, ; MTYPE, MIDX) ; IF (STATUS .NE. %LOC(QUE_SUCCESS))THEN ; ... ERROR ... ; ENDIF ; ; POSSIBLE ERRORS: ; .SK ; .list 1,' ' ; .LE;QUE_INVIDX - MID index is not consistant with MID name ; .X QUE_INVIDX ; .LE;QUE_IDXOOR - MID index is out of range ; .X QUE_IDXOOR ; .LE;QUE_MIDNOTFOUND - Message ID not found in list ; .X QUE_MIDNOTFOUND ; .LE;QUE_INSFARG - Insufficient arguments ; .X QUE_INSFARG ; .LE;QUE_INVARG - Invalid arguments ; .X QUE_INVARG ; .LE;QUE_NOTINITIALIZED - Queueing functions have not been initialized ; .X QUE_NOTINITIALIZED ; .LE;QUE_MIDATTACHED - Message ID is already attached ; .X QUE_MIDATTACHED ; .LE;QUE_INSFREE - Insufficient number of free blocks ; .X QUE_INSFREE ; .LE;QUE_MIDMAX - Message ID is at maximum allowed messages ; .X QUE_MIDMAX ; .LE;QUE_NOCHK - Checkpoint process is not available ; .X QUE_NOCHK ; .ELS ; ; .fill ; end.doc ****************************** end.doc ; .PAGE .PSECT QUEUE_CODE,BYTE,NOWRT,EXE,PIC .ENTRY WRITE_Q,^M ; ; Check the passed parameter ; CMPB (AP), #5 ; enough arguments? BLSSU 10$ ; NO MOVL 4(AP), R3 ; Get the Q_BLOCK address IFNOWRT #8, (R3), 20$ ; insure Q_BLOCK readable ; check message_id parameter MOVL 8(AP), R2 ; Get MID descriptor address IFNORD #8, (R2), 20$ ; Insure descriptor readable MOVL 4(R2), R2 ; Get MID buffer IFNORD #MID$K_SIZ, (R2), 20$ ; Insure descriptor readable ; check message parameter MOVL 12(AP), R2 ; Get message descriptor address IFNORD #8, (R2), 20$ ; Insure descriptor readable MOVZWL (R2),R0 ; get byte count user buffer ++6.26 MOVL 4(R2),R1 ; get addr. user buffer ++6.26 IFNORD R0,(R1),20$ ; make sure it is readable ++6.26 ; check message length parameter MOVL 16(AP), R1 ; Get message length address IFNORD #2, (R1), 20$ ; Insure descriptor readable CMPW (R1), (R2) ; Passed length greater than actual ? BGTR 20$ ; Yes, don't let user add message ; check message type parameter MOVL 20(AP), R2 ; Get message type address IFNORD #2, (R2), 20$ ; Insure descriptor readable ; MOVL AP, R8 ; Save argument pointer $CMKRNL_S ROUTIN=30$ ; Jump into Kernel mode RET ; R0 has the return code 10$: MOVL #QUE_INSFARG, R0 ; Insufficient arguments RET 20$: MOVL #QUE_INVARG, R0 ; Invalid arguments RET 25$: MOVL #QUE_NOTINITIALIZED, R0 ; Init status to "not initialized" RET ; ; ********** In KERNEL Mode/Previous mode kernel ********** ; 30$: .WORD ^M ; ; Make sure we are initialized ; MOVL (R3), R6 ; Get the P0 starting address IFNOWRT #PEX$K_LEN, (R6), 25$ ; insure readable CMPL (R3), PEX$L_SREG(R6) ; PASSED start same as STORED ? BNEQ 25$ ; no CMPL 4(R3), PEX$L_EREG(R6) ; PASSED end same as STORED ? BNEQ 25$ ; no BICL2 #PEX$M_RTRFLAG, PEX$L_STAT(R6) ; Clear router flag JSB WRITE_Q_BODY ; Do the rest RET .PAGE .SBTTL WRITE_Q_BODY Write the data into the queue WRITE_Q_BODY: ; ; INPUTS: ; R6 = P0 VA ; R8 = Pseudo argument pointer ; PUSHR #^M ; Save some registers ; ; Protect this process from being deleted ; DSBINT #IPL$_ASTDEL ; Disable AST interrupts and below ; ; Find the message ID in the list ; BICL #PEX$M_INVIDX, PEX$L_STAT(R6) ; Clear INCOMPATIBLE flag MOVL PEX$Q_GSRETADR(R6), R10 ; Get virtual address for GS JSB CHECK_LOCK ; Wait if MID list is locked BLBS R0,10$ ; Locks still in place RET ; NO 10$: MOVL 8(R8), R11 ; Get MID descriptor buffer address MOVL 4(R11), R11 ; Get MID buffer address ; Use the index if found CMPB (R8), #6 ; passed MID index ? BLSS 16$ ; No MOVL 24(R8), R9 ; Get index address IFNORD #2, (R9), INV_ARG ; Insure readable JSB CHECK_MID_INDEX ; Check MID index BLBS R0, 20$ ; Passed index same as passed name BITL #PEX$M_INVIDX, PEX$L_STAT(R6) ; Was this a warning error? BEQL IDX_OOR ; No, index must be out of range ; use the MID name 16$: JSB MID_INDEX ; find this MID (R5, R9 NEW) BLBC R0, INV_MID ; not found 20$: CMPW MID$W_CNT(R9), MID$W_MAX(R9) ; at maximum number of messages ? BLSS 30$ ; No JSB MAKE_ROOM ; Try and make room BLBC R0, MAX_MID ; Unsuccessful attempt BRW 20$ ; See if we have enough now ; ; Get the needed number of control blocks ; 30$: MOVL 16(R8), R7 ; Message length buffer address MOVZWL (R7), R7 ; Message length (word) ADDL3 #HDR$K_SIZ+8, R7, R3 ; Add length of header and datalinks ADDL2 #QST$K_MSGL-1, R3 ; add length (-1) of one chunk of data DIVL2 #QST$K_MSGL, R3 ; This gives us needed number of chunks GET_FIRST: ; SUBL2 R3, QHD$L_FREE(R10) ; see if there is enough free chunks BGEQ REM_FIRST ; YES, now add the message ADDL2 R3, QHD$L_FREE(R10) ; add back requested number of chunks JSB MAKE_ROOM ; Try and make room BLBC R0, NO_ROOM_AT_ALL ; Unsuccessful attempt BRW GET_FIRST ; See if we have enough now ; Inavlid argument INV_ARG: MOVL #QUE_INVARG, R0 ; Invalid arguments JMP LEAVE_WRITE_Q ; Leave ; Invalid MID INV_MID: MOVL #QUE_MIDNOTFOUND, R0 ; MID not found JMP LEAVE_WRITE_Q ; Leave ; Maximum number of messages already MAX_MID: MOVL #QUE_MIDMAX, R0 ; MID at maximum JMP LEAVE_WRITE_Q ; Leave ; Insufficient number of free control blocks NO_ROOM_AT_ALL: MOVL #QUE_INSFREE, R0 ; insufficient # of free control blocks JMP LEAVE_WRITE_Q ; Index out of range IDX_OOR: MOVL #QUE_IDXOOR, R0 ; Index out of range JMP LEAVE_WRITE_Q .PAGE .SBTTL Write Queue - Load message text ; ; section inputs: ; R10 - Global section Virtual address ; R9 - Message Id virtual address in MID list ; R8 - Pseudo argument pointer ; R7 - message length in bytes ; R6 - P0 address ; REM_FIRST: REMQHI QHD$Q_FLS(R10), PEX$L_HEADLINK(R6) ; get a free block for starters BVC 10$ ; successful, control block removed BCS REM_FIRST ; Interlock failed, try again JMP NO_ROOM_AT_ALL ; Queue empty ; ; Adjust the Message ID header ; 10$: INCW MID$W_CNT(R9) ; Bump this Message IDs message count MOVL 20(R8), R10 ; message type buffer address TSTW (R10) ; Test if non-volatile type BEQL 30$ ; Non-zero, volatile INCW MID$W_NVCNT(R9) ; Bump Non-volatile count 30$: CLRQ PEX$Q_WORKLINKS(R6) ; Work links for data control blocks MOVL 12(R8), R8 ; Get message descriptor buffer address MOVL 4(R8), R8 ; Get message buffer address MOVL PEX$L_HEADLINK(R6), R2 ; Get address of header control block CLRQ QS2$L_DLNK(R2) ; links of next data control block ; BITL #PEX$M_RTRFLAG, PEX$L_STAT(R6) ; Should we add the header ? BNEQ RTR_HDR ; No, entry was RTR_WRITE_Q ; ; Load the header information ; INCW MID$W_QSEQ(R9) ; Bump this Message IDs sequence number CMPW MID$W_QSEQ(R9), #HDR$K_MAXSEQ ; Is this past limit? BLEQ 40$ ; No CLRW MID$W_QSEQ(R9) ; Yes, start at zero again 40$: MOVW (R10), QS2$C_HDR+HDR$W_TYPE(R2) ; Load message type $GETTIM_S TIMADR=QS2$C_HDR+HDR$Q_ONQT(R2) ; Get on queue time MOVW R7, QS2$C_HDR+HDR$W_LEN(R2) ; Load mess length (including header) MOVW MID$W_QSEQ(R9), QS2$C_HDR+HDR$W_QSEQ(R2) ; Load on queue sequence number ; Load the node name into source and destination node fields MOVL PEX$Q_GSRETADR(R6), R10 ; Restore the GS address MOVL #6, R3 ; Length of name PUSHR #^M ; save registers MOVC3 R3, QHD$C_NODE(R10), QS2$C_HDR+HDR$C_SNM(R2) ; Load source node name (R0-R5 invalid) POPR #^M ; Restore registers MOVL #6, R3 ; Length of name PUSHR #^M ; save registers MOVC3 R3, QHD$C_NODE(R10), QS2$C_HDR+HDR$C_DNM(R2) ; Load destination name (R0-R5 invalid) POPR #^M ; Restore registers MOVL #QS2$K_MSGL, R11 ; Move block 1 message chunk ADDL2 #QS2$C_MSG, R2 ; Get to data area of first block BRW INS_NEXT ; ; Ignore code to load header since the router has it for us! ; RTR_HDR: MOVL #QS2$K_MSGL+HDR$K_SIZ, R11 ; Move Block 1 message chunk plus header ADDL2 #QS2$C_HDR, R2 ; Get to header area ADDL2 #HDR$K_SIZ, R7 ; Add length of header to message size ; ; Insert the data into the control block ; INS_NEXT: CMPL R11, R7 ; Is there less than one chunk ? BLSS 10$ ; No MOVL R7, R11 ; Move what is left 10$: MOVL R4, R10 ; Save PCB address MOVC3 R11, (R8), (R2) ; Move data (R0-R5 invalid) MOVL R10, R4 ; restore PCB address ADDL2 R11, R8 ; Look at next part in user buffer SUBL2 R11, R7 ; subtract what we moved BLEQ 60$ ; No more left ; ; Add rest of message ; MOVL PEX$Q_GSRETADR(R6), R10 ; Restore the GS address MOVL #QST$K_MSGL, R11 ; Setup length of data to transfer 30$: REMQHI QHD$Q_FLS(R10), R2 ; Get a free control block BVC 50$ ; successful, control block removed BCS 30$ ; Interlock failed, try again JMP NO_ROOM_AT_ALL ; Queue empty 50$: INSQTI QST$L_FLNK(R2), PEX$Q_WORKLINKS(R6) ; add control block for MID BCS 50$ ; Interlock failed, try again ADDL2 #QST$C_MSG, R2 ; Get to data area of block 2-N BRW INS_NEXT ; Insert the data ; ; All data added to queue ; 60$: MOVL PEX$L_HEADLINK(R6), R3 ; Get address of first control block ; ; Link in blocks 2-N into block 1 ; 62$: REMQHI PEX$Q_WORKLINKS(R6), R2 ; Get pointer to next control block BVS 65$ ; Queue empty BCS 62$ ; Interlock failed, try again 64$: INSQTI QST$L_FLNK(R2), QS2$L_DLNK(R3) ; add control block for MID BCS 64$ ; Interlock failed, try again BRW 62$ ; Make sure all blocks are removed ; ; Link in block 1 into the MID message chain ; 65$: INSQTI QST$L_FLNK(R3), MID$L_FLK(R9) ; add control block for MID BCS 65$ ; Interlock failed, try again ; ; Wake up the reader if around... ; CMPW MID$W_CNT(R9), #1 ; Message count just go to 1 ? BGTR 70$ ; No, don't wake the reader MOVL MID$L_PCB(R9), R0 ; Get reader's PCB address BEQL 70$ ; Nobody attached CMPL PCB$L_PID(R0), MID$L_IPID(R9) ; Real PID same as stored ? BNEQ 70$ ; Inconsistant, leave alone MOVL MID$L_IPID(R9), R1 ; Get Index PID MOVL #PRI$_IOCOM, R2 ; I/O complete boost MOVZWL MID$W_EFN(R9), R3 ; EFN to set PUSHR #^M JSB G^SCH$POSTEF ; Post the event flag POPR #^M ; ; Wake up check_point task ; 70$: MOVL PEX$Q_GSRETADR(R6), R10 ; Restore the GS address MOVL QHD$L_PCB(R10), R0 ; Get check point process PCB address BEQL NO_CHECK ; Check point process not there CMPL PCB$L_PID(R0), QHD$L_IPID(R10) ; Real PID same as stored ? BNEQ NO_CHECK ; Inconsistant, return error code MOVL QHD$L_IPID(R10), R1 ; Get Index PID MOVL #PRI$_IOCOM, R2 ; I/O complete boost MOVL QHD$L_EFN(R10), R3 ; EFN to set PUSHR #^M JSB G^SCH$POSTEF ; Post the event flag POPR #^M BITL #PEX$M_INVIDX, PEX$L_STAT(R6) ; INCOMPATIBLE flag set ? BEQL 76$ ; No MOVL #QUE_INVIDX, R0 ; Yes, return warning status BICL #PEX$M_INVIDX, PEX$L_STAT(R6) ; Clear flag BRW LEAVE_WRITE_Q ; return control to caller 76$: MOVL #SS$_NORMAL, R0 ; successful completion status ; LEAVE_WRITE_Q: MOVL PEX$Q_GSRETADR(R6), R10 ; Restore the GS address DECL QHD$L_INSRV(R10) ; decrement count of processes in service ENBINT ; Enable interrupts to previous level POPR #^M ; Restore registers RSB ; Return to main system service ; NO_CHECK: MOVL #QUE_NOCHK, R0 ; No checkpoint process BRB LEAVE_WRITE_Q ; return to caller .page .sbttl MAKE ROOM - try to delete outstanding message(s) to free space ; ; DESCRIPTION: ; ; This routines tries to delete a message from the specified Message ID ; queue. If a deletable RNA message exists, it is deleted and control is ; passed back to the caller. If the forward message link is non-zero and the ; message is deletable, it is deleted and control is passed back to the caller. ; Otherwise, an appropriate status is returned. ; ; INPUTS: ; R9 = MID POINTER ; MAKE_ROOM: PUSHR #^M ; ; Is there volatile messages in list ? ; CMPW MID$W_NVCNT(R9), MID$W_CNT(R9) ; Non-volatile same as total ? BEQL 60$ ; Yes, nothing to delete ; ; Try to delete RNA message (if any) ; TSTL MID$L_RNA(R9) ; Is there an RNA offset? BEQL 40$ ; No, try deleting oldest message MOVAB MID$L_RNA(R9), R2 ; Get RNA header Address ADDL2 MID$L_RNA(R9), R2 ; Add RNA offset to address TSTW QS2$C_HDR+HDR$W_TYPE(R2); Is this deletable? BNEQ 40$ ; no MOVAB MID$L_RNA(R9), R11 ; Get RNA header Address JSB DELETE_MESSAGE ; Delete the message and return blocks BRW 50$ ; return to caller ; ; Try and delete a message from the un-read list ; 40$: MOVAB MID$L_FLK(R9), R2 ; Get forward link header Address ADDL2 MID$L_FLK(R9), R2 ; Add link offset to address TSTW QS2$C_HDR+HDR$W_TYPE(R2) ; Is this deletable? BNEQ 60$ ; no, give up! MOVAB MID$L_FLK(R9), R11 ; Get forward link header Address JSB DELETE_MESSAGE ; Delete the message and return blocks ; ; Successful deletion ; 50$: MOVL #SS$_NORMAL, R0 ; insufficient # of free control blocks POPR #^M RSB ; ; No room ; 60$: MOVL #QUE_INSFREE, R0 ; insufficient # of free control blocks POPR #^M RSB .END