*DECK DMLRL                                                             003590
      PROC DMLRL (FITLIST,RELORD,ERRFLAG,ENDFLAG,ERRRTRN,ENDRTRN);
  BEGIN                                                                 003610
 #
* *   DMLRL - READ RELATION SEQUENTIAL INTERFACE ROUTINE
*     R. E. FOX                                      10/14/77 
* 
* DC  PURPOSE 
* 
*     ISSUE A READ RELATION SEQUENTIAL REQUEST TO CDCS AND
*     CHECK FOR AN ERROR OR EOR CONDITION UPON RETURNING FROM CDCS. 
*     IF ENCOUNTERED, 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  -- ORDINAL OF THE RELATION TO BE READ 
* 
*     ERRFLAG  --  ERR PARAMETER FLAG (FTN 5 ONLY)
* 
*     ENDFLAG  --  EOR PARAMETER FLAG (FTN 5 ONLY)
* 
*     ENDRTN  --  (OPTIONAL) ALTERNATE RETURN ON EOF (FTN 5 ONLY) 
*                 WARNING:  DO NOT REFERENCE - MAY NOT BE PRESENT 
* 
*     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
*     DMLINV CHECKS DBT0001 WHICH CONTAINS A VALUE SPECIFYING THE 
*     FORTRAN VERSION. THIS VALUE IS PASSED ON TO DMLRL IN *FTNVER*.
* 
* 
* DC  EXIT CONDITIONS 
* 
*     UPON RETURN FROM CDCS, THE ROOT FIT IS CHECKED FOR END OF 
*     FILE STATUS.  IF TRUE, THE CRM END OF FILE STATUS CODE IS STORED
*     IN THE APPLICATION PROGRAM STATUS FIELDS.  THE STATUS FOR 
*     EACH FILE IN THE RELATION IS TRANSFERRED FROM THE FITLIST TO
*     THE STATUS FIELD FOR EACH FIT.  THE LAST NON-ZERO STATUS
*     FOR A FILE ON WHICH A READ WAS ATTEMPTED IS STORED IN DBSTAT AND
*     THE CORRESPONDING REALM NAME IN DBREALM.
*     THE RETURN POINT CAN BE ALTERED GIVEN AN *ON ERROR* OR *ON END* 
*     LABEL AND THE DETECTION OF SUCH A CONDITION (FTN 5 ONLY). 
* 
* DC  CALLING ROUTINES
* 
*     DMLRL IS CALLED FROM THE APPLICATION PROGRAM
*     AS A RESULT OF A DML READ RELATION SEQUENTIAL STATEMENT.
* 
* DC  CALLED ROUTINES 
* 
*     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 DMLRL IS GENERATED BY THE PREPASS AS
*     A RESULT OF A DML READ RELATION SEQUENTIAL STATEMENT. 
*     DMLRL ISSUES THE READ RELATION SEQUENTIAL REQUEST 
*     TO CDCS, RETURNS THE FIT STATUS FIELDS TO THE APPLICATION 
*     PROGRAM, AND RETURNS CONTROL TO THE APPLICATION PROGRAM.
*     WITH FORTRAN 5, AN ALTERNATE RETURN CAN BE SPECIFIED.  IF AN
*     ERROR OR EOF IS DETECTED, CONTROL IS PASSED TO THE SPECIFIED
*     LABEL IN THE APPLICATION PROGRAM. 
* 
 #
      CONTROL EJECT;                                                    003620
      CONTROL DISJOINT;                                                 003630
      CONTROL INERT;                                                    003640
                                                                        003650
                                        #-------------DEFS-------------#
  
      DEF CTRLBRK     #O"632"#;         # CONTROL BREAK ON A FILE      #
      DEF F4          #8#;              # VALUE FOR FORTRAN 4          #
      DEF F5          #9#;              # VALUE FOR FORTRAN 5          #
      DEF NULLOCC     #O"627"#;         # NULL OCCURRENCE ON A FILE    #
      DEF DFNOREAD  #O"777"#;    # NO READ WAS DONE ON THIS FILE       #003670
      DEF BLANK      #" "#;                                             003680
      DEF EOFCODE  #O"100"#;                                            001070
      DEF FITSIZE     #35#;             # SIZE OF FIT IN WORDS         #003700
                                                                        003710
# THE FOLLOWING ARE PARAMETERS FROM THE "READ" CALLING SEQUENCE        #003720
                                                                        003730
      ARRAY FITLIST;             # FIT LIST FOR THIS RELATION          #003740
        BEGIN                                                           003750
          ITEM FITLES  U(0,0,9); # ERROR STATUS RETURNED BY CDCS       #003760
          ITEM FITADR  U(0,42,18); # FIT ADDRESS                       #003770
        END                                                             003780
                                                                        003790
      ITEM RELORD;                        # RELATION ORDINAL           #003800
  
      ITEM ERRRTRN;                       # ERROR RETURN PARAMETER     #
                                          # WARNING: DO NOT REFERENCE  #
  
      ITEM ENDRTRN;                       # ERROR RETURN PARAMETER     #
                                          # WARNING: DO NOT REFERENCE  #
                                                                        003810
                                                                        000760
      BASED ARRAY FIT;                                                  000770
*CALL FITDCLS                                                           000780
# THE FOLLOWING DESCRIBES THE COMMON BLOCK CREATED IN THE FORTRAN      #003820
#     PROGRAM                                                          #003830
                                                                        003840
      COMMON DB0000;                                                    003850
*CALL DB0DCLS                                                           003860
  
                                        #------------XREFS-------------#
  
      XREF
        BEGIN 
        ITEM FTNVER;                    # FORTRAN VERSION              #
        PROC DB$RELS;                   # READ RELATION INTERFACE RTN  #
        PROC DMLRTRN;                   # SET RETURN REGISTER ROUTINE  #
        END 
  
                                        #----------LOCAL ITEMS---------#
  
      ITEM ERRFLAG B;                   # ERROR RTRN PARAMETER FLAG    #
      ITEM ENDFLAG B;                   # EOF RTRN PARAMETER FLAG      #
      ITEM I;                           # SCRATCH ITEM                 #
      ITEM RTNPARM I;                   # RETURN PARAMETER - DMLRTN    #
  
      CONTROL EJECT;                                                    003930
                                                                        003940
# CLEAR ERROR STATUS FIELD                                             #003950
                                                                        003960
      DBREALM = BLANK;                                                  003970
      DBSTAT = 0;                                                       003980
      RTNPARM = 0;
                                                                        003990
                                                                        000800
# INITIALIZE RELEVANT FIELDS IN EACH FIT IN FITLIST                    #000810
                                                                        000820
      FOR I = 0 STEP 1 WHILE FITADR[I] NQ 0 DO                          000830
        BEGIN                                                           000840
          P<FIT> = FITADR[I];                                           000850
          P<DBTXXXX> = FITADR[I] + FITSIZE;                             000860
          FITRL = DBMRL;                                                000870
          FITMRL = DBMRL;                                               000880
          FITWSA = DBWSA;                                               000890
        END                                                             000900
# PERFORM READ CALL - PASS FITLIST, RELATION ORDINAL AND RELATION      #
# USAGE LIST                                                           #
  
      DB$RELS (FITLIST,RELORD,DBRELST); 
                                                                        000920
# CHECK FOR EOI ON ROOT FIT. IF FOUND,SET STATUS AND RETURN            #000930
                                                                        000940
      P<FIT> = FITADR[0];                                               000950
      IF FITEOI[0]                                                      000960
      THEN                                                              000970
        BEGIN                                                           000980
          P<DBTXXXX> = FITADR[0] + FITSIZE;                             000990
          DBSTAT = EOFCODE;                                             001000
          P<REALMBLOCK> = FITADR[0] - 4;                                001010
          DBSXXXX = EOFCODE;                                            001020
          DBREALM = DBRXXXX;                                            001030
          GOTO ENDCHK;                  # CHECK FOR END ALTERNATE RTRN #000730
        END                                                             001050
                                                                        004030
# FOR EACH FIT IN THE FITLIST, TRANSFER ES FIELD IN FITLIST TO         #004040
# CORRESPONDING DBSTXX FIELD IN COMMON BLOCK. THE LAST NON-ZERO STATUS #004050
# FOUND FOR A REALM ON WHICH A READ WAS ATTEMPTED IS STORED IN DBSTAT. #004060
# THE CORRESPONDING REALM NAME IS STORED IN DBREALM.                   #004070
                                                                        004080
      FOR I = 0 STEP 1 WHILE FITADR[I] NQ 0 DO                          004090
        BEGIN                                                           004100
          P<REALMBLOCK> = FITADR[I] - 4; # POINT TO COMMON FIELDS      #004110
          DBSXXXX = FITLES[I];    # STORE STATUS CODE                  #000430
          IF FITLES[I] NQ 0 THEN                                        004130
            BEGIN                                                       004140
              IF FITLES[I] EQ DFNOREAD THEN                             004150
                TEST I;                                                 004160
              DBSTAT = FITLES[I];                                       004170
              DBREALM = DBRXXXX;                                        000450
            END                                                         004190
        END                                                             004200
  
# CHECK FOR ERR OR EOF STATUS ON CDCS CALL                             #
ENDCHK:                                                                 000750
  
      IF FTNVER EQ F5                   # ALT RETURN VALID ONLY FOR FT5#
      THEN
        BEGIN 
        IF ERRFLAG                      #        ERR PARAMETER         #
        THEN
        BEGIN 
          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#
        END 
  
                                        #          END PARAMETER       #
        IF ENDFLAG                      # IF EOF RTRN SPECIFIED        #
        THEN
          BEGIN 
          IF DBSTAT EQ EOFCODE          # IF EOF ENCOUNTERED ON ROOT   #
          THEN
            BEGIN 
            IF ERRFLAG                  # IF END AND ERR PARM SPECIFIED#
            THEN
              RTNPARM = 2;              # SET RETURN TO SIXTH PARM     #
            ELSE
              RTNPARM = 1;              # ELSE, SET RETURN TO FIFTH    #
            END 
          END 
        END 
  
# SET THE RETURN REGISTER                                              #
  
      DMLRTRN(RTNPARM); 
  
# RETURN TO THE APPLICATION PROGRAM                                    #
  
      RETURN;                                                           004220
      END                                                               004230
TERM                                                                    004240
