*DECK C$DMLOK 
          IDENT  C$DMLOK
          SST 
          COMMENT  ISSUE CDCS 2 -LOCK- CALL 
          B1=1
*CALL,IOMICROS
          ENTRY  C.LOK
* 
*                ISSUE THE CDCS 2 -LOCK- CALL, AND IF A DEADLOCK
*                CONDITION, CAUSE THE EXECUTION OF THE SPECIFIED
*                -USE FOR DEADLOCK- DECLARATIVE.
* 
*                CALLED BY -ENTER "C.LOK" USING REALM-NAME.-. 
*                ON ENTRY A1=ADDRESS OF PARAMETER LIST
*                PARAMETER LIST 
*                     WORD 1 - ADDRESS OF REALM LIST
* 
 C.LOK    DATA   0
 CDCS2    IFEQ   OP.DCS,OP.DCS2 
          SB6    C.LOK
          RJ     C.ROUT1     SET UP PARAMETERS FOR CDCS CALL
          STORE  A0,EX=0
          SA1    =XC.DMPAR
          RJ     =XDB$LOKF   CDCS -LOCK- CALL 
          SB1    1
          SB6    C.LOK       RESET B6 TO ENTRY
          SA1    =XC.DMPAR   X1=FIT 
          FETCH  X1,ES,X5 
          SX5    X5-663B
          NZ     X5,C.LOK    JUMP IF NOT DEADLOCK 
          FETCH  X1,USDL,X5  DEADLOCK DECLARATIVE NUMBER
          ZR     X5,C.LOK1   JUMP IF NO DEADLOCK DECLARATIVE
          STORE  X1,USEX=X5  FIELD REQUIRED BY -C.USE-
          RJ     =XC.USE     PERFORM DECLARATIVE
          EQ     C.LOK
* 
 C.LOK1   BSS    0           OUTPUT DAYFILE MESSAGE AND ABORT 
          SX1    #DMLOK1     MESSAGE NUMBER 
          MX2    0           NO MESSAGE INSERT
          SX6    B1          ABORT JOB
          EQ     C.ROUT2A    OUTPUT MESSAGE AND ABORT 
          EJECT 
          ENTRY  C.UNLOK
* 
*                ISSUE THE CDCS 2 -UNLOCK- CALL.
* 
*                CALLED BY -ENTER "C.UNLOK" USING REALM-NAME-.
*                ON ENTRY A1=ADDRESS OF PARAMETER LIST
*                PARAMETER LIST 
*                     WORD 1 - ADDRESS OF REALM FIT 
* 
 C.UNLOK  DATA   0
          SB6    C.UNLOK
          RJ     C.ROUT1     SET UP PARAMETERS FOR CDCS CALL
          SA1    =XC.DMPAR
          RJ     =XDB$UNLK   CDCS -UNLOCK- CALL 
          EQ     C.UNLOK
          EJECT 
* 
 C.ROUT1  BSS    1           SET UP PARAMETERS FOR -DB$LOKF- AND
*                            -DB$UNLK- CDCS CALLS 
*                            B6=-C.LOK- OR -C.UNLOK-
          SX7    X1 
          MX0    54 
          LX1    60-24
          BX2    -X0*X1 
          SX3    X2-44B 
          NZ     X3,C.ROUT1A  JUMP IF NOT A FIT POINTER 
          SA7    =XC.DMPAR   FIT ADDRESS INTO PARAMETER LIST
          SA0    X7 
          RJ     =XC.DMDFO   REALM ORDINAL TO X6 AND -F.R.ORD-, AND 
          SA7    A7+B1        X7=F.R.ORD
          NZ     X6,C.ROUT1  JUMP IF A (SS) REALM 
 C.ROUT1A SA3    =7L-C.LOK- 
          SX1    B6-C.LOK 
          ZR     X1,C.ROUT1B
          SA3    =8L-C.UNLOK- 
 C.ROUT1B BX6    X3 
          SA6    =XC.MSINS   DAYFILE MESSAGE INSERT 
          SX1    #PRMERR     MESSAGE NUMBER 
          SX2    B1          MESSAGE HAS INSERT 
          MX6    0           NO ABORT BY -CBMSG-
          EJECT 
* 
 C.ROUT2  BSS    0           CALL -C.MSG- TO OUTPUT MESSAGE AND PERHAPS 
*                            ABORT
*                             X1=MESSAGE NUMBER 
*                             X2=0 IF NO MESSAGE INSERT, ELSE "0
*                             X6=0 IF NO JOB ABORT, ELSE "0 
*                             B6=-C.LOK- OR -C.UNLOK- 
          SA3    B6          ISOLATE SOURCE LINE NUMBER (BITS 29-18 OF
          AX3    30           -RJ C.LOK/C.UNLOK-) AND PUT IN LOWER HALF 
          MX0    48           OF -RJ C.MSG- AT -C.LOK2- 
          SA3    X3-1 
          AX3    18 
          BX7    -X0*X3 
          SA3    C.ROUT2A 
          BX3    X0*X3
          IX7    X3+X7
          SA7    A3 
          MX3    0           LINE NUMBER IN LOWER HALF OF -RJ C.MSG-
          RJ     =XC.SVRTN   SAVE  B6 
 C.ROUT2A RJ     =XC.MSG     MESSAGE TO DAYFILE AND PERHAPS ABORT 
 -        VFD    30/0        FILLED IN ABOVE
          RJ     =XC.GETRT   RESTORE B6 
          JP     B6 
 CDCS2    ENDIF 
          END 
