ASMB,R,L,C
*     NAME:   LURQ
*     SOURCE: 92071-18206 
*     RELOC:  92071-1X206 
*     PGMR:   HLC,DJN 
* 
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  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  92071-1X206  REV.2041  800624 
      ENT LURQ
* 
      EXT .ENTR,$RQRT,$PVCN,$ZPCN 
      EXT $LIBR,$ERMG,$ERAB,$ULLU 
      EXT $STAT,$XQT,$IDNO,$SUSP
      EXT $LUTA,$LUT#,$EXEX,$CON
      EXT $XEQ,$LIST,$SCHD,$SJP 
      EXT .XST,.XLD 
      EXT $SJS0,$SJS1 
* 
      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
* 
* 
      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 RETRY     SET UP RETRY ADDRESS FOR RESUME ON SUSPEND
      JSB .XLD      SET UP $SUSP FOR POSSIBL $ERAB EXIT 
      DEF $SUSP 
      STA B 
      LDA RETRY     ABORT MESSAGE WILL GIVE CALLING ADDRESS 
      JSB .XST
      DEF B,I 
      JMP LURQ.+1 
* 
* 
RTNAD NOP           SAVES RETURN ADDRESS
RETRY NOP           SAVES ADDRESS OF JSB LURQ 
BSAVE NOP           MOSTLY FOR SAVING REG ON XLD INSTRUCTION
LUCT1 NOP           ARRAY COUNTER 
LUCT2 NOP           ARRAY COUNTER 
LUADR NOP           ADDRESS OF LU IN PASSED LIST BEING PROCESSED
LOCKF NOP           LOCK FLAG 
DVTAD NOP           DVT ADDRESS 
RQOP  NOP 
RQTB  NOP 
RQSZ  NOP 
KEY   NOP 
LURQ. NOP           PSEUDO ENTRY POINT
      JSB .ENTR     PASS PARAMETER ADDRESSES
      DEF RQOP
      STA RTNAD     SAVE COMPLETION ADDRESS FOR RETURN
      JSB .XLD      GET NESTING LEVEL 
      DEF $PVCN 
      ADA =D-1      SHOULD BE ZERO NOW
      JSB .XST
      DEF $PVCN 
      STA BSAVE     SAVE NESTING LEVEL
      JSB .XLD
      DEF $ZPCN 
      IOR BSAVE       (NOT CALLABLE FROM PRIVILEGED ROUTINE)
      SZA 
      JMP SRERR     'PROGA ABORTED SR   66631'
* 
      LDB RQOP,I    GET OPTION WORD 
      RBL,CLE,ELB   BIT14 TO E
* 
      STB BSAVE 
      JSB .XLD      GET STAT POINTER
      DEF $STAT 
      STA TEMP      SAVE FOR LATER
      JSB .XLD      GET STAT WORD 
TEMP  NOP 
      AND =B137777  CLEAR 'NA' BIT
      SEZ,RSS       NO-ABORT OPTION?
      JMP ABCAL      NO, NORMAL CALL
      IOR =B40000   SET 'NA' BIT
      ISZ RTNAD     INCRIMENT RETURN ADDRESS
ABCAL LDB TEMP      GET ADDR OF $STAT 
      JSB .XST      RESTORE STATUS WORD 
      DEF B,I 
      LDB BSAVE     RESTORE PASSED OPTION WORD
      CPB =D2 
      JMP LUUL3     OPTION 100000 OR 140000 
* 
      JSB .XLD      HERE ON LU LOCK CALL
      DEF $XQT
      STA B         $IDNO WANTS ID ADDR IN B
      JSB $SJS0     GET THE USERS ID NUMBER 
      DEF $IDNO 
      ALF,RAR 
      STA LOCKF     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 LUCT1     SET COUNTERS
      STA LUCT2 
      LDB RQTB      GET THE LU ARRAY ADDRESS
      STB LUADR      AND SET
      LDB RQOP,I
      SLB,RSS 
      JMP LUUL1     UNLOCK REQUEST
* 
      SSB           LOCK WITH WAIT? 
      JMP LULK2     NO. 
* 
      JSB $SJS0     LOCK WITH WAIT, UNLOCK ANY PREVIOUS 
      DEF $ULLU 
* 
LULK2 JSB LFLAG     FIND LOCK FLAG FOR THIS LU
      SZA           OK IF NOT LOCKED
      CPA LOCKF     OR LOCKED TO CALLER 
      JMP LULK3 
* 
*     LOCKED TO SOME OTHER PROGRAM
* 
      LDB RQOP,I
      SSB 
      JMP LULKF     NO SUSPEND
      JSB .XLD      USER'S ID ADDR
      DEF $XQT
      STA B         PUT IN B FOR $LIST
      LDA DVTAD     PUT DVT ADDRESS IN A FOR $LIST
      JSB $SJS1     SUSPEND THE CALLER
      DEF $LIST 
      OCT 50
      LDA RETRY     RETRY CLRQ CALL ON RESUME 
      JSB .XST
      DEF $RQRT 
      JSB $SJP
      DEF $XEQ
* 
* 
LULK3 ISZ LUCT1     DONE? 
      JMP LULK2     NO, TRY NEXT LU 
* 
LULK4 LDB RQTB,I    LOCK REQUESTED LU'S 
      SZB,RSS 
      JMP BUMP      LU ZERO 
      ADB =D-1
      STB BSAVE     SAVE B IN CASE XLD TRASHES IT 
      JSB .XLD      GET LUT ADDRESS 
      DEF $LUTA 
      ADA BSAVE 
      JSB .XLD      DVT ADDRESS 
      DEF A,I 
      SZA,RSS 
      JMP BUMP      BIT BUCKET
      ADA =D6 
      STA BSAVE 
      JSB .XLD      DVT WORD 7
      DEF A,I 
      IOR LOCKF      SET LOCK FLAG
      LDB BSAVE 
      JSB .XST      RESET IN THE DVT
      DEF B,I 
BUMP  ISZ RQTB      STEP ARRAY ADDRESS
      ISZ LUCT2     IF NOT DONE 
      JMP LULK4     DO THE NEXT ONE 
* 
LULKS CLA,RSS       SUCCESS!!!
LULKF CLA,INA       FAILURE 
      STA BSAVE     SAVE SUCCESS FAILE CODE TEMPORARILY 
      JSB .XLD
      DEF $CON      GET CON ADDRESS 
      JSB .XLD      GET WHAT $CON POINTS TO 
      DEF A,I 
      AND =B170000  SEQUENCE NUMBER 
      IOR LOCKF 
      STA KEY,I     USER LOCK FLAG
      LDA RTNAD     GIVE DISPATCHER CORRECT RETURN ADDRESS
      JSB .XST
      DEF $RQRT 
      LDA BSAVE     RETURN SUCCESS, FAILURE CODE IN A 
      JSB $SJP
      DEF $EXEX 
* 
ELU02 LDA RTNAD     SET $RQRT FOR NO ABORT CASE 
      JSB .XST
      DEF $RQRT 
      LDB =D2       ILLEGAL LU NUMBER 
      LDA =ALU
      JSB $SJP      ABORT PROGRAM 
      DEF $ERAB 
* 
* 
SRERR LDA =ASR
      LDB =A
      JSB $SJS0     ABORT PROGRAM 
      DEF $ERMG 
      JSB $SJP
      DEF $XEQ
* 
* 
* 
* 
LUUL1 JSB LFLAG     FIND LOCK FLAG FOR THIS LU
      CPA LOCKF     IF NOT LOCKED TO CALLER 
      RSS 
      JMP IGNOR     IGNORE THE REQUEST
      STB BSAVE     SAVE DVT7 ADDR
      JSB .XLD      GET DVT WORD
      DEF B,I 
      XOR LOCKF     ELIMINATE ID# FROM DVT7 
      LDB BSAVE     RESTORE DVT7 ADDRESS IN B 
      JSB .XST      STORE DVT7 BACK 
      DEF B,I 
* 
      LDA DVTAD     DVT ADDRESS 
      JSB $SJS1     SCHEDULE ANY WAITERS
      DEF $SCHD 
      OCT 50
* 
IGNOR ISZ LUCT1     DONE? 
      JMP LUUL1     NO TRY NEXT ONE 
      JMP LULKS     DONE
* 
LUUL3 JSB $SJS0     RELEASE ALL LU'S LOCKED BY
      DEF $ULLU 
      JMP LULKS     CALLER AND RETURN 
* 
LFLAG NOP           GET LOCK FLAG 
      CLA           CLEAR A FOR LU=0 CASE 
      LDB LUADR,I   LU PASSED IN CALL TO LURQ 
      ISZ LUADR     BUMP TO NEXT LU 
      SZB,RSS 
      JMP LFLAG,I   LU ZERO 
      ADB =D-1
      STB BSAVE     XLD MAY TRASH B 
      JSB .XLD
      DEF $LUT# 
      LDB BSAVE 
      CMA,INA 
      ADA B         SHOULD BE LESS THAN MAX 
      SSA,RSS 
      JMP ELU02     LU TOO HIGH 
      STB BSAVE 
      JSB .XLD
      DEF $LUTA 
      ADA BSAVE 
      JSB .XLD      GET DVT ADDRESS 
      DEF A,I 
      STA DVTAD 
      SZA,RSS       IF BIT BUCKET, SET A=B=0
      JMP BTBKT      YES IT IS. 
      ADA =D6 
      STA BSAVE 
      JSB .XLD      GET WORD 7
      DEF A,I 
      AND =B3770
      LDB BSAVE     CALLING PATH ASSUMES DVT7 ADDR IS IN B
      JMP LFLAG,I   RETURN
* 
BTBKT CLB           INDICATE THE BIT BUCKET 
      JMP LFLAG,I   (AN XLD A,I WHEN A=0 OR 1 GIVES INVALID RESULTS)
* 
* 
      END 
                                                                                                                                                                                                                                                  