*DECK DMLRLK                                                            002470
  PROC DMLRLK  (FITLIST,RELORD,KEYORD,RECORDORD,                        002480
               RELCODE,KL,KT,RKW,RKP,KEYNAME,REALMORD,ERRRTRN); 
  BEGIN                                                                 002500
 #
* *   DMLRLK - READ RELATION RANDOM INTERFACE ROUTINE 
*     R. E. FOX                                      10/14/77 
* 
* DC  PURPOSE 
* 
*     ISSUE A READ RELATION RANDOM REQUEST TO CDCS AND
*     CHECK FOR AN ERROR CONDITION UPON RETURNING FROM CDCS.
*     ON ERROR, CAUSES A BRANCH TO AN ALTERNATE RETURN IN THE 
*     APPLICATION PROGRAM IF SPECIFIED, ELSE, RETURNS NORMALLY. 
*     RETURN THE FIT STATUS FIELD TO THE APPLICATION PROGRAM
* 
* DC  ENTRY CONDITIONS
* 
* DC  PARAMETERS
* 
*     FITLIST  --  FITLIST FOR RELATION TO BE READ
* 
*     RELORD  --  RELATION ORDINAL
* 
*     KEYORD  --  ORDINAL OF KEY SPECIFIED IN READ STATEMENT
* 
*     RECORDORD --  RECORD ORDINAL OF ROOT FILE 
* 
*     RELCODE --  RELATIONAL OPERATOR CODE
*                 1 FOR EQ, 3 FOR GE, 6 FOR GT
* 
*     KL    --  KEY LENGTH
* 
*     KT    --  KEY TYPE
* 
*     RKW   --  RKW FIELD IN FIT
* 
*     RKP   --  RKP FIELD IN FIT
* 
*     KEYNAME  --  KEY NAMED IN READ STATEMENT
* 
*     REALMORD  --  ORDINAL OF ROOT REALM 
* 
*     ERRRTRN  --  (OPTIONAL) ALTERNATE RETURN ON ERROR (FTN 5 ONLY)
*                  WARNING:  DO NOT REFERENCE - MAY NOT BE PRESENT
* 
* DC  ASSUMPTIONS 
* 
*     COMMON BLOCK DB0000 HAS BEEN GENERATED AND INITIALIZED
*     FIT SAVE AREAS ARE INITIALIZED
* 
* 
* DC  EXIT CONDITIONS 
* 
*     CONTROL IS RETURED AFTER THE READ CALL, WITH
*     THE STATUS FIELDS TRANSFERRED FROM THE FITLIST TO THE USER STATUS 
*     VARIABLES.  THE RETURN POINT CAN BE ALTERED GIVEN AN *ON ERROR* 
*     LABEL AND THE DETECTION OF AN ERROR (FTN 5 ONLY). 
* 
* DC  CALLING ROUTINES
* 
*     DMLRLK IS CALLED FROM THE APPLICATION PROGRAM 
*     AS A RESULT OF A DML READ RELATION RANDOM STATEMENT.
* 
* DC  CALLED ROUTINES 
* 
*     DB$REL  --     CDCS READ RELATION RANDOM INTERFACE ROUTINE
*     DB$RSR  -- CDCS START RELATION INTERFACE ROUTINE
*     DB$RELS  --  CDCS READ RELATION SEQUENTIAL INTERFACE ROUTINE
*     DMLRTRN  --  RETURN ROUTINE--SETS REGISTER TO RETURN PARAMETER
* 
* DC  NON-LOCAL VARIABLES 
* 
*     VARIABLES IN DB0000 WHICH ARE MODIFIED ARE: 
*     DBSTAT, DBSXXXX, DBREALM
*     FIT FIELDS ARE RESTORED FROM THE FIT SAVE AREA. 
* 
* DC  DESCRIPTION 
* 
*     A CALL TO DMLRLK IS GENERATED BY THE PREPASS AS 
*     A RESULT OF A DML READ RELATION RANDOM STATEMENT. DMLRLK
*     ISSUES THE READ RELATION RANDOM REQUEST 
*     TO CDCS, RETURNS THE FIT STATUS FIELDS TO THE APPLICATION 
*     PROGRAM, AND RETURNS CONTROL TO THE APPLICATION PROGRAM.
*     IF THE RELATIONAL OPERATOR SPECIFIED IN THE READ STATEMENT WAS    000460
*     OTHER THAN EQUAL, CDCS IS CALLED TO PERFORM A START RELATION      000470
*     AND A SEQUENTIAL READ RATHER THAN A READ RANDOM.                  000480
*     WITH FORTRAN 5, AN ALTERNATE RETURN CAN BE SPECIFIED.  IF AN
*     ERROR IS DETECTED, CONTROL IS PASSED TO THE SPECIFIED LABEL 
*     IN THE APPLICATION PROGRAM. 
* 
 #
      CONTROL EJECT;                                                    002510
      CONTROL DISJOINT;                                                 002520
      CONTROL INERT;                                                    002530
                                                                        002540
                                 #----------------DEFS-----------------#
  
      DEF CTRLBRK   #O"632"#;    # CONTROL BREAK ON A FILE             #
      DEF NULLOCC   #O"627"#;    # NULL OCCURENCE ON A FILE            #
      DEF DFNOREAD  #O"777"#;    # NO READ WAS DONE ON THIS FILE       #002570
      DEF BLANK     #" "#;                                              002580
      DEF FITSIZE  #35#;          # SIZE OF FIT IN WORDS               #000270
                                                                        002590
                                                                        002600
# THE FOLLOWING ARE PARAMETERS FROM THE "READ" CALLING SEQUENCE        #002610
                                                                        002620
      ARRAY FITLIST;             # FIT LIST FOR THIS RELATION          #002630
        BEGIN                                                           002640
          ITEM FITLES  U(0,0,9); # ERROR STATUS RETURNED BY CDCS       #002650
          ITEM FITADR  U(0,42,18); # FIT ADDRESS                       #002660
        END                                                             002670
                                                                        002680
      ITEM RELORD;               # RELATION ORDINAL                    #002690
      ITEM KEYORD;               # KEY ORDINAL                         #002700
      ITEM RECORDORD;            # RECORD ORDINAL                      #002710
      ITEM RELCODE;              # RELATIONAL OPERATOR CODE            #002720
                                 # 1 FOR EQ, 3 FOR GE, 6 FOR GT        #002730
      ITEM KL;                   # KEY LENGTH FIELD IN FIT             #002740
      ITEM KT;                   # KEY TYPE FIELD IN FIT               #002750
      ITEM RKW;                  # RKW FIELD IN FIT                    #002760
      ITEM RKP;                  # RKP FIELD IN FIT                    #002770
      ITEM KEYNAME;              # KEY NAMED IN READ STATEMENT         #001240
      ITEM REALMORD;             # ORDINAL OF ROOT REALM               #000580
      ITEM ERRRTRN;              # ERROR RETURN PARAMETER              #
                                 # WARNING: DO NOT REFERENCE           #
                                                                        002780
# THE FOLLOWING DESCRIBES THE COMMON BLOCK CREATED IN THE FORTRAN      #002790
#     PROGRAM                                                          #002800
                                                                        002810
      COMMON DB0000;                                                    002820
*CALL DB0DCLS                                                           002830
      BASED ARRAY FIT;                                                  002840
*CALL FITDCLS                                                           002850
                                                                        002860
# PARAMETER TO PASS TO CDCS                                            #002870
                                                                        002880
      ARRAY PARM3[0] S(1);                                              000170
        BEGIN                                                           002900
          ITEM P3WORD U(0,0,60); # ENTIRE PARAMETER                    #
          ITEM RORD U(0,36,12);  # RECORD ORDINAL                      #
          ITEM KORD U(0,48,12);  # KEY ORDINAL                         #
        END                                                             002930
                                                                        002940
      XREF                                                              002960
        BEGIN                                                           002970
          PROC DB$REL;                   # READ RELATION INTERFACE RTN #002980
          PROC DB$RSR;           # START RELATION INTERFACE            #
          PROC DB$RELS;          # READ RELATION SEQUENTIAL RTN        #000540
          PROC DMLRTRN;          # SET RETURN REGISTER ROUTINE         #
        END                                                             002990
  
                                        #----------LOCAL ITEMS---------#
  
      ITEM I;                           # SCRATCH ITEM                 #
      ITEM RTNPARM;                     # RETURN PARAMETER - DMLRTRN   #
  
      CONTROL EJECT;                                                    003000
                                                                        003010
# CLEAR ERROR STATUS FIELD                                             #003020
                                                                        003030
      DBREALM = BLANK;                                                  003040
      DBSTAT = 0;                                                       003050
      P<DBTXXXX> = FITADR[0] + FITSIZE;                                 000250
                                                                        003060
# SET UP PARAMETER 3 FOR CDCS                                          #003070
                                                                        003080
      P3WORD[0] = 0;             # ZERO FILL                           #
      RORD[0] = RECORDORD;                                              003090
      KORD[0] = KEYORD;                                                 003100
                                                                        003110
# FILL IN FIT FIELDS FROM PARMS INTO ROOT FIT                          #003120
                                                                        003130
      P<FIT> = FITADR[0];        # POINT TO ROOT FIT                   #003140
      FITREL[0] = RELCODE;       # RELATIONAL OPERATOR CODE            #003150
      FITKL[0] = KL;                                                    003160
      FITKT[0] = KT;                                                    003170
      FITRKW[0] = RKW;                                                  003180
      FITRKP[0] = RKP;                                                  003190
      FITKA[0] = LOC(KEYNAME);                                          001260
      FITKP[0] = RKP; 
                                                                        003200
                                                                        001100
# FILL IN WSA, MRL, AND RL IN ALL FITS IN FITLIST                      #001110
                                                                        001120
      FOR I = 0 STEP 1 WHILE FITADR[I] NQ 0 DO                          001130
        BEGIN                                                           001140
          P<FIT> = FITADR[I];                                           001150
          P<DBTXXXX> = FITADR[I] + FITSIZE;                             001160
          FITRL = DBMRL;                                                001170
          FITMRL = DBMRL;                                               001180
          FITWSA = DBWSA;                                               001190
        END                                                             001200
                                                                        003280
#  IF THE RELATIONAL OPERATOR IS OTHER THAN 1, THIS CALL IS CONVERTED  #000330
#  INTO A START ON THE ROOT FIT AND A READ RELATION SEQUENTIAL         #000340
                                                                        000350
      P<REALMBLOCK> = FITADR[0] - 4;                                    000360
      IF RELCODE NQ 1                                                   000370
      THEN                                                              000380
        BEGIN                                                           000390
          P<FIT> = FITADR[0];                                           000400
                 DB$RSR (FITLIST, RELORD, PARM3); 
          IF FITES[0] NQ 0                                              000420
          THEN                                                          000430
            BEGIN                                                       000440
              DBSTAT = FITES[0];                                        000450
              DBREALM = DBRXXXX;                                        000460
              GOTO ERRCHK;
            END                                                         000480
                DB$RELS (FITLIST,RELORD,DBRELST); 
        END                                                             000510
                                                                        003290
# PERFORM READ CALL TO CDCS                                            #003300
                                                                        003310
      ELSE
      DB$REL (FITLIST,           # FITLIST                             #003320
              RELORD,            # RELATION ORDINAL                    #003330
              PARM3,             # RECORD KEY ORDINAL                  #
              DBRELST);          # RELATION USAGE LIST                 #
                                                                        003350
                                                                        003360
# FOR EACH FIT IN THE FITLIST, TRANSFER ES FIELD IN FITLIST TO         #003370
# CORRESPONDING DBSTXX FIELD IN COMMON BLOCK. THE LAST NON-ZERO STATUS #003380
# FOUND FOR A REALM ON WHICH A READ WAS ATTEMPTED IS STORED IN DBSTAT. #003390
# THE CORRESPONDING REALM NAME IS STORED IN DBREALM.                   #003400
                                                                        003410
ERRSTAT:                                                                000560
      FOR I = 0 STEP 1 WHILE FITADR[I] NQ 0 DO                          003420
        BEGIN                                                           003430
          P<REALMBLOCK> = FITADR[I] - 4; # POINT TO COMMON FIELDS      #003440
          DBSXXXX = FITLES[I];  # STORE STATUS CODE                    #
          IF FITLES[I] NQ 0 THEN                                        003460
            BEGIN                                                       003470
              IF FITLES[I] EQ DFNOREAD THEN                             003480
                TEST I;                                                 003490
              DBSTAT = FITLES[I];                                       003500
             DBREALM = DBRXXXX;                                         000500
            END                                                         003520
        END                                                             003530
                                                                        003540
# CHECK ERROR STATUS ON CDCS CALL                                      #
  
ERRCHK: 
      IF (DBSTAT NQ 0)                  # IF CDCS/CRM ERROR OCCURRED   #
        AND ((DBSTAT NQ CTRLBRK)        # AND IT IS NOT A CONTROL BREAK#
          AND (DBSTAT NQ NULLOCC))      # OR A NULL OCCURRENCE         #
      THEN
        RTNPARM = 1;                    # SET THE RETURN PARAMETER TO 1#
      ELSE                              #             ELSE             #
        RTNPARM = 0;                    # SET THE RETURN PARAMETER TO 0#
  
# SET THE RETURN REGISTER                                              #
  
      DMLRTRN(RTNPARM); 
  
# RETURN TO THE APPLICATION PROGRAM                                    #
      RETURN;                                                           003550
      END                                                               003560
TERM                                                                    003570
