ASMB,R,Q,C
*     NAME:   LURQ
*     SOURCE: 92070-18206 
*     RELOC:  92070-1X206 
*     PGMR:   HLC 
* 
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS      * 
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * 
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        * 
*  **************************************************************** 
* 
* 
      NAM LURQ,6  92070-1X206  REV.1941  791003 
      ENT LURQ
* 
      EXT .ENTR,$RQRT,$PVCN,$ZPCN 
      EXT $LIBR,$ERMG,$ERAB,$ULLU 
      EXT $SUSP,$STAT,$XQT,$IDNO
      EXT $LUTA,$LUT#,$EXEX,$CON
      EXT $A,$XEQ,$LIST,$SCHD 
      EXT $RQP1,$RQP2,$RQP3,$RQP4 
      EXT $RQP5 
* 
      SUP 
A     EQU 0 
B     EQU 1 
* 
* 
* 
*     THE LU LOCK FEATURE ALLOWS A PROGRAM TO LOCK AN LU
*     TO HIS PROGRAM EXCLUSIVELY.  ANY OTHER PROGRAM IS 
*     PUT IN THE WAIT LIST WHEN IT REQUESTS EITHER
*     A LOCK ON THE SAME LU OR WHEN IT ATTEMPTS I/O 
*     ON A LOCKED LU (UNLESS THE PROPER KEYWORD IS PASSED). 
* 
*     THE WAITING PROGRAM WILL BE RESTARTED WHEN THE
*     LU IS UNLOCKED.  ALL LU'S LOCKED TO A PROGRAM WILL BE 
*     UNLOCKED WHEN THE PROGRAM TERMINATES.  LU'S MAY 
*     ALSO BE UNLOCKED SELECTIVELY WITH THE FOLLOWING 
*     CALL. 
* 
*     CALL TO LOCK/UNLOCK AN LU 
* 
*     EXT LURQ
* 
*     JSB LURQ
*     DEF RTN 
*     DEF IOPT      OPTION FLAG WORD
*     DEF LUARY     ARRAY OF LU'S 
*     DEF NOLU      NUMBER OF LU'S TO LOCK/UNLOCK 
*     DEF KEY       KEYWORD FOR ACCESS BY OTHER PROGRAMS (OPTIONAL) 
*RTN  EQU * 
*      .
*      .
*      .
*LUARY DEC N1       ARRAY OF LU'S TO BE LOCKED
*      DEC N2 
*       . 
*       . 
*       . 
*IOPT OCT OPTION    OPTIONS FOR THIS CALL SEE BELOW 
*NOLU DEC NO        NUMBER OF LU'S IN THE ARRAY 
* 
*     OPTIONS ARE:
*     IOPT          MEANING 
*     000000B       UNLOCK SPECIFIED LU'S 
*     100000B       UNLOCK ALL OWNED LOCKS
*     000001B       LOCK WITH WAIT THE SPECIFIED LU'S 
*     100001B       LOCK WITHOUT WAIT THE SPECIFIED LU'S. 
* 
*     TO PREVENT A DEAD LOCK AN ARRAY OF LU'S IS TO BE USED 
*     IT IS POSSIBLE TO RELEASE LOCKS ON AN LU AT ANY TIME. 
*     IF A NO WAIT LOCK REQUEST IS MADE AND THE CALLER ALREADY
*     HAS ONE OR MORE LU'S LOCKED THEY ARE UNLOCKED BEFORE THE
*     REQUEST IS EXECUTED.
* 
*     ON A NO WAIT RETURN THE A REGISTER INDICATES THE
*     STATUS AS FOLLOWS:
* 
*     A REGISTER    MEANING 
*     0             REQUEST SUCESSFUL 
*     1             ONE OR MORE OF THE LU'S IS ALREADY LOCKED TO
*                   ANOTHER PROGRAM 
* 
*     POSSIBLE ABORT ERRORS ON THIS REQUEST ARE:
*     ERROR         MEANING 
*     LU02          ILLEGAL LU
* 
* 
*     THE SYSTEM PARAMETER BUFFER IS USED AS FOLLOWS: 
*       $RQP1 - ARRAY COUNTER 
*       $RQP2 - ARRAY COUNTER 
*       $RQP3 - ARRAY POINTER 
*       $RQP4 - LOCK FLAG 
*       $RQP5 - DVT ADDRESS 
* 
*       $RQP6 - $RQP9 ARE RESERVED FOR $ULLU
* 
      SKP 
LURQ  NOP           ENTRY POINT 
      JSB $LIBR     TURN OFF MEMORY PROTECT 
      NOP 
      CLA 
      STA KEY       SET UP DEFAULT
      STA RQSZ
      LDA LURQ
      STA LURQ. 
      ADA =D-1
      STA $SUSP,I   RETRY ADDRESS 
      JMP LURQ.+1 
* 
* 
RQOP  NOP 
RQTB  NOP 
RQSZ  NOP 
KEY   NOP 
LURQ. NOP           PSEUDO ENTRY POINT
      JSB .ENTR     PASS PARAMETER ADDRESSES
      DEF RQOP
      STA $RQRT     SAVE COMPLETION ADDRESS FOR $ERAB 
      CCA 
      ADA $PVCN 
      STA $PVCN     SHOULD BE ZERO NOW
      IOR $ZPCN       (NOT CALLABLE FROM PRIVILEGED ROUTINE)
      SZA 
      JMP SRERR     'PROGA ABORTED SR   66631'
* 
      LDB RQOP,I    GET OPTION WORD 
      RBL,CLE,ELB   BIT14 TO E
* 
      LDA $STAT,I 
      AND =B137777  CLEAR 'NA' BIT
      SEZ,RSS       NO-ABORT OPTION?
      JMP ABCAL      NO, NORMAL CALL
      IOR =B40000   SET 'NA' BIT
      ISZ $RQRT     BUMP RETURN ADDR
ABCAL STA $STAT,I 
      CPB =D2 
      JMP LUUL3     OPTION 100000 OR 140000 
* 
      LDB $XQT      HERE ON LU LOCK CALL
      JSB $IDNO     GET THE USERS ID NUMBER 
      ALF,RAR 
      STA $RQP4     LOCK FLAG 
* 
      CLA           (IN CASE OF NOT ENOUGH PARAMETERS)
      LDA RQSZ,I    GET THE # OF LU'S 
      CMA,INA,SZA,RSS 
      CCA           ONLY ONE IF NO LENGTH SPECIFIED 
      STA $RQP1     SET COUNTERS
      STA $RQP2 
      LDB RQTB      GET THE LU ARRAY ADDRESS
      STB $RQP3      AND SET
      LDB RQOP,I
      SLB,RSS 
      JMP LUUL1     UNLOCK REQUEST
* 
      SSB,RSS 
      JSB $ULLU     LOCK WITH WAIT, UNLOCK ANY PREVIOUS 
* 
LULK2 JSB LFLAG     FIND LOCK FLAG FOR THIS LU
      SZA           OK IF NOT LOCKED
      CPA $RQP4       OR LOCKED TO CALLER 
      JMP LULK3 
* 
*     LOCKED TO SOME OTHER PROGRAM
* 
      LDB RQOP,I
      SSB 
      JMP LULKF     NO SUSPEND
      LDA $RQP5     DVT ADDRESS 
      LDB $XQT
      JSB $LIST     SUSPEND THE CALLER
      OCT 50
      JMP $XEQ
* 
* 
LULK3 ISZ $RQP1     DONE? 
      JMP LULK2     NO TRY NEXT LU. 
* 
LULK4 LDA RQTB,I    LOCK REQUESTED LU'S 
      SZA,RSS 
      JMP BUMP      LU ZERO 
      ADA =D-1
      ADA $LUTA 
      LDB A,I       DVT ADDRESS 
      SZB,RSS 
      JMP BUMP      BIT BUCKET
      ADB =D6 
      LDA B,I       DVT WORD 7
      IOR $RQP4      SET LOCK FLAG
      STA B,I       RESET IN THE DVT
BUMP  ISZ RQTB      STEP ARRAY ADDRESS
      ISZ $RQP2     IF NOT DONE 
      JMP LULK4     DO THE NEXT ONE 
* 
LULKS CLA,RSS       SUCCESS!!!
LULKF CLA,INA       FAILURE 
      STA $A,I      STATUS OF REQUEST 
      LDA $CON,I
      AND =B170000  SEQUENCE NUMBER 
      IOR $RQP4 
      STA KEY,I     USER LOCK FLAG
      JMP $EXEX 
* 
ELU02 LDB =D2       ILLEGAL LU NUMBER 
      LDA =ALU
      JMP $ERAB     ABORT PROGRAM 
* 
* 
SRERR LDA =ASR
      LDB =A
      JSB $ERMG     ABORT PROGRAM 
      JMP $XEQ
* 
* 
* 
* 
LUUL1 JSB LFLAG     FIND LOCK FLAG FOR THIS LU
      CPA $RQP4     IF NOT LOCKED TO CALLER 
      RSS 
      JMP IGNOR     IGNORE THE REQUEST
      XOR B,I 
      STA B,I       CLEAR THE LOCK FLAG IN THE DVT
* 
      LDA $RQP5     DVT ADDRESS 
      JSB $SCHD     SCHEDULE ANY WAITERS
      OCT 50
* 
IGNOR ISZ $RQP1     DONE? 
      JMP LUUL1     NO  TRY NEXT ONE
      JMP LULKS 
* 
LUUL3 JSB $ULLU     RELEASE ALL LU'S LOCKED BY
      JMP LULKS     CALLER AND RETURN 
* 
LFLAG NOP           GET LOCK FLAG 
      LDA $RQP3,I   LU PASSED IN CALL 
      ISZ $RQP3     BUMP TO NEXT LU 
      SZA,RSS 
      JMP LFLAG,I   LU ZERO 
      ADA =D-1
      LDB $LUT# 
      CMB,INB 
      ADB A         SHOULD BE LESS THAN MAX 
      SSB,RSS 
      JMP ELU02     LU TOO HIGH 
      ADA $LUTA 
      LDB A,I 
      STB $RQP5     DVT ADDRESS 
      SZB           IF BIT BUCKET, SET A=B=0
      ADB =D6 
      CLA 
      LDA B,I 
      AND =B3770
      JMP LFLAG,I   RETURN
* 
* 
      END 
                    