*DECK C$DMRDR 
          IDENT  C$DMRDR
          SST 
          COMMENT  ISSUE CDCS -READ RELATION- CALLS 
          B1=1
*CALL,IOMICROS
          ENTRY  C.DMRN      RELATION READ, SEQUENTIAL
          ENTRY  C.DMRR      RELATION READ, RANDOM - -ROOT AREA- HAS NO 
*                             INDEX FILE
          ENTRY  C.DMRS      RELATION READ, RANDOM - -ROOT AREA- HAS
*                             ALTERNATE KEYS
*                ISSUE THE CDCS -READ RELATION- CALLS 
*                CALL SEQUENCE
*                  SA0  RELATION ORDINAL
*                  SB3  KEY ORDINAL, -C.DMRS- (ALTERNATE KEY INDEX FILE)
*                       ENTRY ONLY
*                  MX4  2  IF -AT END-
*               OR MX4  1  IF -INVALID KEY- 
*             ELSE MX4  0 
*                  SB6  RETURN ADDRESS
*                  EQ   C.DMRN OR C.DMRR OR C.DMRS
 C.DMRN   BSS    0
 CDCS     IFNE   OP.DCS,OP.NO 
          SB2    B0          FLAG INDICATING SEQUENTIAL READ
          SB3    B0          PRIME KEY ORDINAL (FOR -ROOT- AREA)
          EQ     C.DMRL1
 CDCS     ENDIF 
 C.DMRR   BSS    0
 CDCS     IFNE   OP.DCS,OP.NO 
          SB3    B0          PRIME KEY ORDINAL (FOR -ROOT- AREA)
 CDCS     ENDIF 
 C.DMRS   BSS    0
 CDCS     IFNE   OP.DCS,OP.NO 
          SB2    B1          FLAG INDICATING RANDOM READ
 C.DMRL1  SX7    A0          RELATION ORDINAL 
          SA7    =XF.R.ORD
          SX7    A7 
          SA7    =XC.DMPAR+1  ADDRESS OF RELATION ORDINAL INTO PARAM LST
*                            SCAN THE RELATIONS/AREAS TABLE FOR THE 
*                            MATCHING RELATION ENTRIES
 CDCS2    IFEQ   OP.DCS,OP.DCS2 
          SA1    =XC.RUSAG
          BX7    X1          ADDRESS OF RELATION USAGE LIST 
          SA7    =XC.DMPAR+2+B2    3RD PARAM IF SEQ, 4TH IF RANDOM
 CDCS2    ENDIF 
          RJ     =XC.DMRAG   FIND RELATION/AREAS GROUP
          NE     B7,B0,C.DMRL4  JUMP IF RELATION/AREAS GROUP FOUND
          SX1    #DMREL1     MESSAGE NUMBER 
          MX2    0           NO MESSAGE INSERT
          SX3    B6-B1       ADDRESS CONTAINING LINE NUMBER 
          MX6    1           ABORT BY -CBMSG- 
          RJ     =XC.MSG     MESSAGE TO DAYFILE AND ABORT 
 C.DMRL4  SA3    A2+B7       SET ERROR AND DATA EXITS INTO FIT OF EACH
          STORE  X3,EX=C.DMREX  AREA OF RELATION
          STORE  X3,DX=C.DMRAE
          STORE  X3,IRS=B0   ALSO ZERO ERROR FIELD
          SB7    B7-B1
          NE     B7,B0,C.DMRL4  JUMP IF ANOTHER AREA
          SX7    A2+B1
          SA7    =XC.DMPAR   ADDRESS OF RELATION/AREAS TABLE INTO 
*                             PARAM LIST (-C.DMPAR-)
          SA0    X3          ADDRESS OF FIT OF -ROOT AREA-
          RJ     =XC.SVRTN   SAVE A0, B6, X4
          EQ     B2,B0,C.DMRL5  JUMP IF RELATION READ, SEQUENTIAL 
*                            RELATION READ, RANDOM
          RJ     =XC.SETKY   SET -ROOT AREA- KEY OF REFERENCE (KA/KP/KL)
          SX7    =XC.KRORD   CELL IS SET IN -CBSETKY- 
          SA7    =XC.DMPAR+2  ADDRESS OF -ROOT AREA- RECORD/KEY ORDINALS
          SA1    =XC.DMPAR   CDCS 
 CDCS2    IFEQ   OP.DCS,OP.DCS1 
          RJ     =XDM$RELR    RELATION READ, RANDOM CALL
 CDCS2    ELSE
          RJ     =XDB$REL    CDCS 2 RELATION READ, RANDOM 
 CDCS2    ENDIF 
          EQ     C.DMRL6
*                            RELATION READ, SEQUENTIAL
 C.DMRL5  SA1    =XC.DMPAR   CDCS 
 CDCS2    IFEQ   OP.DCS,OP.DCS1 
          RJ     =XDM$RELS    RELATION READ, SEQUENTIAL 
 CDCS2    ELSE
          RJ     =XDB$RELS   CDCS 2 RELATION READ, SEQUENTIAL 
 CDCS2    ENDIF 
*                            NORMAL RETURN FROM CDCS CALL 
 C.DMRL6  SB1    1           RESET B1 
          RJ     =XC.GETRT   RESTORE B6 (RETURN ADDRESS)
          SB3    B0          NO -AT END- OR -INVALID KEY- 
          JP     B6          BACK TO (COMPILED PROGRAM) 
          EJECT 
*                ERROR EXIT FROM CDCS RELATION READ CALL
*                ENTERED FROM CDCS WITH A0=FIT ADDRESS OF AREA (WITHIN) 
*                 RELATION) WHERE ERROR OCCURRED
 C.DMREX  DATA   0
          SB1    1           RESET B1 
          RJ     =XC.GETRT    ACROSS -C.GETRT-
          SA5    =XF.R.ORD   GET RELATION ORD.
          SA0    X5 
          RJ     =XC.DMRAG   SEARCH FOR FIT TABLE FOR RELATION
          SB2    B1 
 DMRSRCH  SA3    A2+B2       FETCH A FIT POINTER
          FETCH  X3,IRS,X5   GET ERROR FIELD
          NZ     X5,DMRFIND  JUMP, IF FILE HAS ERROR
          SB2    B2+B1
          LE     B2,B7,DMRSRCH   CHECK NEXT FIT 
          SA2    A2+B1       GET FIT POINTER FOR ROOT FILE
          SA0    X2 
          RJ     C.SVRTN
          EQ     C.DMREX     RETURN TO CDCS - NO FILE IN ERROR
 DMRFIND  SA0    X3 
          SX6    X5-663B     CHECK FOR DEADLOCK 
          NZ     X6,DMRNDL   JUMP, IF NO DEADLOCK DETECTED
          FETCH  A0,USDL,X5  GET USE DECLARATIVE NUMBER 
          NZ     X5,DMRUPD   JUMP, IF USE PROCEDURE DEFINED 
          SX1    #DMLOK1     MESSAGE NUMBER 
          SA2    B6-B1       GET RETURN ADDRESS - 1 
          SX6    X2          GET LINE NUMBER OF CALL
          SA2    DMRERR      PICK UP -C.USE- CALL 
          BX6    X2+X6       STUFF LINE NUMBER INTO LOWER 30 BITS 
          SA6    A2 
          RJ     =XC.SVRTN   CLEAR STACK
          SX2    B1          MESSAGE INSERT 
          SX6    B1          ABORT JOB
 DMRERR   RJ     =XC.MSG     MESSAGE TO DAYFILE AND ABORT 
 -        VFD    30/0        SPACE FOR LINE NUMBER (FILLED IN ABOVE)
          RJ     *+400000B
 DMRUPD   STORE  A0,USEX=X5  FIELD FOR -C.USE-
          RJ     =XC.SVRTN   SAVE A0, B6 AGAIN
          RJ     =XC.USE
          EQ     C.DMREX
 DMRNDL   BSS    0
          FETCH  A0,FO,X5    SET UP INSTRUCTION AT -C.DMRX1- TO -RJ-
          SB3    X5           TO NORMAL ERROR ROUTINE OF AREA IN
          SA5    B3+DMRJPS    QUESTION
          BX6    X5 
          SA6    C.DMRX1
          RJ     =XC.SVRTN   CLEAR INSTRUCTION STACK, AND SAVE A0 OF
*                             AREA IN ERROR 
 C.DMRX1  DATA   0           -RJ- TO NORMAL ERROR ROUTINE OF AREA IN
*                             QUESTION
          EQ     C.DMREX     RETURN TO CDCS 
          SPACE  3
 DMRJPS   BSS    0
*                TABLE OF JUMPS TO NORMAL AREA ERROR ROUTINES, IN THE 
*                ORDER OF POSSIBLE VALUE OF THE FIT -FO- FIELD
 CDCS2    IFEQ   OP.DCS,OP.DCS1 
          RJ     =XC.SQEX    SEQUENTIAL 
 CDCS2    ELSE
          EQ     *+400000B
 CDCS2    ENDIF 
          EQ     *+400000B
          EQ     *+400000B
          RJ     =XC.ISEX    INDEXED SEQUENTIAL 
          EQ     *+400000B
          RJ     =XC.DAEX    DIRECT ACCESS
          RJ     =XC.AKEX    ACTUAL KEY 
          EJECT 
*                -AT END- EXIT FROM CDCS RELATION READ CALL 
 CDCS2    IFEQ   OP.DCS,OP.DCS1 
*                ENTERED FROM CDCS WITH A0=FIT ADDRESS OF -AT END- AREA 
*                 (WITHIN RELATION) - SHOULD BE -ROOT AREA- 
 CDCS2    ENDIF 
 C.DMRAE  DATA   0
          SB1    1           RESET B1 
 CDCS2    IFNE   OP.DCS,OP.DCS1 
          RJ     =XC.GETRT   RESTORE A0 TO POINT TO ROOT FIT
          RJ     =XC.SVRTN
          EQ     =XC.ATEND   CDCS HAS RETURNED HERE WITH -AT END- 
*                            CONDITION ON THE ROOT FILE ONLY
 CDCS2    ELSE
          SB2    A0 
          RJ     =XC.GETRT   GET A0=FIT ADDRESS OF ROOT AREA
          SX0    A0-B2
          SA0    B2 
          RJ     =XC.SVRTN
          ZR     X0,=XC.ATEND  JUMP IF -AT END- IS ON ROOT AREA 
          SX1    #DMREL2     -AT END- NOT ON ROOT AREA
          RJ     =XC.FIOER   MESSAGE TO DAYFILE, AND ABORT JOB
 CDCS2    ENDIF 
 CDCS     ENDIF 
          END 
