*DECK DB$RQST 
USETEXT CUGDFTX 
 PROC DB$RQST (FC,WC,FIT);
 BEGIN
 #
* *   DB$RQST                                    PAGE  1
* *   INTERFACE BETWEEN OBJECT-TIME ROUTINE AND "CALLSS"
* *   W P CEAGLIO                                DATE  11/21/75 
* * 
* DC  PURPOSE 
*     FORMAT THE COMMON PARTS OF THE REQUEST PACKET.  IF THE USER HAS 
*     A DBST, INITIALIZE THE ENTRIES.  ISSUE THE "CALLSS" 
*     REQUEST, AND CHECK THE STATUS OF THE REQUEST
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
* 
*          FC        FUNCTION CODE OF REQUEST 
*          WC        (WORD COUNT - 1) OF THE REQUEST
*          FIT       FIT (FOR CERTAIN REQUESTS--OTHERWISE ZERO) 
* 
*     ASSUMPTIONS 
* 
*     IF A DBST EXISTS FOR THE RUN-UNIT, THE ARRAY *DB$DBS* CONTAINS THE
*     LOCATION AND WORD LENGTH OF THE DBST. 
* 
* DC  EXIT CONDITIONS 
* 
*     THE "CALLSS" REQUEST PACKET IS COMPLETED AND THE REQUEST ISSUED 
* 
* DC  CALLING ROUTINES
* 
*     ALL CDCS OBJECT-TIME ROUTINES 
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$ABRT;           # ABORT USER JOB                    #
      XREF PROC DB$CALL;           # CALL A SPECIFIED PROCEDURE        #
      XREF PROC DB$DLAY;           # DELAY BEFORE REPEATING CDCS CALL  #
      XREF PROC DB$MSG;            # ISSUE DAYFILE MESSAGE             #
      XREF PROC DB$SSCL;           # ISSUE SUBSYSTEM CALL              #
      XREF PROC DB$WEF;            # WRITE MESSAGE TO ERROR FILE       #
      XREF PROC DC$MBIT;           # MOVE BIT STRING                   #
# 
* DC  DESCRIPTION 
* 
*     THE REQUEST PACKET HEADER AND 2ND WORD ARE FILLED IN BY STORING 
*     CDCS RELEASE ID, FUNCTION CODE, WORD COUNT, AND THE LOCATION OF 
*     THE ERROR BUFFER.  THE REAL-TIME BITS ARE ALSO SET.  IF THE FIT 
*     WAS SPECIFIED, PARAMETERS FROM THE FIT ARE MOVED TO THE PACKET. 
*     IF THERE IS A KEY INVOLVED, IT IS ALSO MOVED INTO THE PACKET. 
*     IF A DBST HAS BEEN ESTABLISHED FOR THE USER, THE DBST ENTRIES ARE 
*     INITIALIZED.  THEN THE SUBSYSTEM CALL IS MADE BY CALLING DB$SSCL. 
*     UPON RETURN FROM CDCS, THE STATUS OF THE REQUEST IS EXAMINED. 
*     IF AN ABNORMAL SUBSYSTEM ERROR OCCURRED (NOT PRESENT OR UNKNOWN), 
*     THE UCP IS ABORTED IF A BATCH JOB OR NO STATUS BLOCK EXISTS-- 
*     OTHERWISE, CONTROL IS RETURNED TO THE CALLER WITH AN ERROR STATUS.
*     IF AN END-OF-DATA CONDITION OCCURRED, THEN EXECUTE THE USER"S 
*     EOD ROUTINE, IF SPECIFIED, AND RETURN CONTROL TO THE CALLER.
*     RETURN ADDRESS OF THE ERROR TEXT IF SPACE ALLOWED IN STATUS BLOCK.
*     IF A RELATION OPERATION WAS REQUESTED, THEN RETURN TO THE CALLING 
*     OBJECT-TIME ROUTINE TO HANDLE ERRORS AND/OR RELATION CONDITIONS.
*     IF PROCESSING A NONFATAL I/O REQUEST, THEN CALL DB$WEF TO 
*     WRITE TO THE CRM ERROR FILE IF BATCH REQUEST (TASK NUMBER = 0). 
*     IF A FATAL ERROR OCCURRED, THEN DAYFILE THE ERROR MESSAGE (BATCH
*     ONLY), AND IF A FATAL CRM ERROR, STORE THE ERROR CODE IN THE FIT. 
*     IF AN ERROR OCCURRED ON A CRM REQUEST, AND AN ERROR ROUTINE IS
*     SPECIFIED IN THE FIT, THEN CALL THE ERROR ROUTINE.
*     IF A FATAL ERROR OCCURRED AND THE USER IS NOT TAF OR INTERACTIVE
*     QU, THEN ISSUE THE ERROR MESSAGE TO THE DAYFILE. IF IMMEDIATE 
*     RETURN IS NOT SET THEN ISSUE AN ABORT MESSAGE TO THE DAYFILE AND
*     ABORT THE USER. OTHERWISE RESET THE IMMEDIATE RETURN FLAG AND 
*     RETURN TO THE CALLER. 
* 
 #
      CONTROL NOLIST;         #CDGDFDCLS# 
*CALL CDGDFDCLS 
  
      CONTROL LIST; 
  
# THE FOLLOWING PARAMETERS ARE FROM THE CALLING SEQUENCE               #
  
      ITEM FC;                          # FUNCTION CODE OF REQUEST     #
      ITEM WC;                          # (WORD COUNT - 1) OF REQUEST  #
      ARRAY FIT [0:DFFITSIZE] S(1); 
*CALL FITDCLS 
  
# END OF PARAMETERS                                                    #
  
  
      DEF DFSSERR #O"605"#;        # SUBSYSTEM ERROR--ABSENT OR UNKNOWN#
      ITEM J;                           # SCRATCH ITEM                 #
      ITEM PRIORERR I;                  # NUMBER OF PRIOR MESSAGE      #
      ITEM SCPMSG C(40)="CDCS NOT ACTIVE AT SYSTEM CONTROL POINT";
      ITEM ABTMSG C(40) = "     FATAL CDCS ERROR--RUN-UNIT ABORTED:"; 
  
      BASED ARRAY PAKEY;                # FOR MOVING KEY INTO RACKET   #
        ITEM KEY C(0,0,240);
  
      ARRAY ERRBUF S(12);               # ERROR MESSAGE BUFFER         #
        BEGIN 
          ITEM ERRMSG C(0,0,120); 
        END 
  
      BASED ARRAY DBSTUCP;             # FOR INITIALIZING DBST         #
        BEGIN 
        ITEM DBSTUWD U(00,00,60);      # FULL WRD UNSIGNED INTEGER ITEM#
        ITEM DBSTCWD C(00,00,10);      # FULL WORD CHARACTER ITEM      #
        END 
*CALL DBSTDCLS
  
# EXTERNAL DECLARATIONS                                                #
  
  
# THIS ARRAY IS REFERENCED BY ALL OBJECT-TIME ROUTINES                 #
  
      XDEF
        BEGIN 
*CALL RQPARDCLS 
        END 
  
  
# THIS ARRAY STORES THE UCP DBST LOCATION AND WORD LENGTH.             #
  
      XREF ARRAY DB$DBS;
        BEGIN 
        ITEM DBSTLW  U(00,36,06);  # DBST LENGTH IN WORDS              #
        ITEM DBSTADR U(00,42,18);  # DBST ADDRESS AT THE UCP           #
        END 
  
      XREF ITEM DB$DLAC I;         # DELAY COUNT IN DB$DLAY            #
  
# THIS ARRAY IS DEFINED IN DB$DLAY.                                    #
# IT CONTAINS THE MESSAGE " WAITING FOR CDCS SCHEMA".                  #
  
      XREF ARRAY DB$DLAM; 
        BEGIN 
        ITEM MSGEND  U(01,48,12);  # FIELD FOR TRUNCATING MESSAGE      #
        ITEM MSGRST  C(01,48,02);  # FIELD FOR RESTORING SCHEMA MESSAGE#
        END 
  
# THIS ITEM CONTAINS THE TASK NUMBER FOR THE REQUEST(0 FOR BATCH JOB)  #
  
  
       XREF ITEM DB$TSKN;     # REQUEST TASK NUMBER (ZERO FOR BATCH)   #
  
# THIS ITEM REFERS TO THE IMMEDIATE RETURN FLAG IN DB$GLDF.            #
  
      XREF ITEM DB$IMRT B;
  
  
  
  
#     B E G I N   D B $ R Q S T   E X E C U T A B L E   C O D E .      #
  
  
      PRIORERR = 0;                # NO PRIOR ERROR NUMBER             #
  
 REPEAT:  
      RQHEADER [0] = 0;                 # INITIALIZE HEADER WORD       #
      RQHDRSS [0] = DFRQVERSN;     # SET INTERNAL REQUEST PACKET ID    #
      RQHDRCTA [0] = TRUE;         # SET RT FOR FOR SUBSYSTEM ERRORS   #
      RQPKHDR [0] = 0;                  # INITIALIZE PARAMETER HEADER  #
      RQPKEBUF [0] = LOC(ERRBUF);       # FWA OF ERROR MESSAGE BUFFER  #
      RQPKHDFC [0] = FC;                # FILL IN FUNCTION CODE        #
      RQHDRWC [0] = WC;                 # FILL IN WORD COUNT OF REQUEST#
      RQPKHDR2 [0] = 0;            # INITIALIZE LAST WORD OF REQ HEADER#
      RQPKTASK [0] = DB$TSKN;      # SET REQUEST TASK NUMBER           #
  
#     IF FIT SPECIFIED, EXTRACT PARAMETERS AND FORMAT IN REQUEST BUFFER#
  
      IF LOC(FIT) NQ 0  THEN
        BEGIN 
        RQPFITPM [0] = FITPM [0]; 
        RQPFITOF [0] = FITOF [0]; 
        RQPFITPD [0] = FITPD [0]; 
        RQPFITRO [0] = FITREL [0];
        RQPFITRL [0] = FITRL [0]; 
        RQPFITMRL [0] = FITMRL [0]; 
        RQPFITWS [0] = FITWSA [0];
        RQPFITKA [0] = FITKA [0]; 
        RQPFITKL [0] = FITKL [0]; 
        RQPFITKP [0] = FITKP [0]; 
        RQPFITKT [0] = FITKT [0]; 
        RQPFITRKW [0] = FITRKW [0]; 
        RQPFITRKP [0] = FITRKP [0]; 
        RQPFITMKL [0] = FITMKL [0]; 
        FITMKL[0] = 0;                  # CLEAR MAJOR KEY LENGTH IN FIT#
        FITIRS [0] = 0;                 # CLEAR FIT ERROR STATUS CODE  #
        FITFP[0] = 0; 
  
#     IF THERE IS A KEY SPECIFIED IN THE REQUEST, EXTRACT IT AND STORE #
#     IT LEFT-JUSTIFIED IN THE REQUEST PACKET.  IF IT IS ALREADY LEFT- #
#     JUSTIFIED, THEN IT IS SIMPLY MOVED WORD BY WORD.  OTHERWISE, THE #
#     "MOVE BIT STRING" ROUTINE, DB$MBIT, IS CALLED TO PERFORM THE MOVE#
  
        IF RQPFITKA [0] NQ 0  THEN
          BEGIN 
          J = RQPFITKL [0]; 
          IF RQPFITKP [0] EQ 0  THEN
            BEGIN 
            P<PAKEY> = RQPFITKA [0];
            C<0,J>RQPPAKEY [0] = C<0,J>KEY [0]; 
            END 
          ELSE
          DC$MBIT(RQPFITKA[0],RQPFITKP[0]*6,LOC(RQPPAKEY[0]),0, 
                   RQPFITKL[0]*6);
  
          RQHDRWC [0] = WC + (J+9)/10;
          END 
  
        END 
  
#     IF THE USER HAS ESTABLISHED A DBST, THEN INITIALIZE ALL ENTRIES  #
#     IN THE DBST BEFORE SCP PROCESSING OF THE REQUEST BEGINS.         #
  
      IF DBSTADR[0] NQ 0
      THEN
        BEGIN 
        P<DBSTUCP> = DBSTADR[0];
        FOR J = 0 STEP 1           # ZERO EACH WORD IN THE DBST        #
          UNTIL DBSTLW[0] - 1 
        DO
          BEGIN 
          DBSTUWD[J] = 0; 
          END 
        IF DBSTLW[0] GQ DFDBSTFUNC # IF DBST INCLUDES FUNCTION NAME    #
        THEN
          BEGIN 
          DBSTCWD[4] = " ";        # BLANK FILL THE FUNCTION NAME WORD #
          IF DBSTLW[0] GQ DFDBSTAREA  # IF DBST INCLUDES AREA NAME     #
          THEN
            BEGIN 
            DBSTCWD[8] = " ";      # BLANK FILL THE AREA NAME WORD     #
            DBSTCWD[9] = " "; 
            DBSTCWD[10] = " ";
            END 
          END 
  
        END                        # OF DBST INITIALIZATION            #
  
#     ISSUE THE "CALLSS" REQUEST                                       #
  
      DB$SSCL (DB$RQBF);
  
#     CHECK FOR ABNORMAL SUBSYSTEM ERROR--NOT ACTIVE AT SCP OR UNKNOWN #
#     TO SYSTEM.  IF SUCH AN ERROR OCCURS, A BATCH JOB IS ABORTED. FOR #
#     OTHER REQUESTS, CONTROL IS RETURNED TO THE CALLER.               #
  
      IF RQHDRSSA [0] 
        OR RQHDRSSU [0] 
      THEN
        BEGIN 
        IF RQPKTASK [0] EQ 0
          OR DBSTADR [0] EQ 0 
        THEN
          BEGIN 
          DB$MSG(SCPMSG); 
          DB$ABRT;
          END 
        ELSE
          BEGIN 
          IF DBSTADR [0] NQ 0 
          THEN
            BEGIN 
            P<DBST> = DBSTADR [0];
            DBERRCODE [0] = DFSSERR;
            END 
          END 
        RETURN; 
        END 
  
  
# IF AN END-OF-DATA CONDITION WAS RETURNED BY CDCS AND AN EOD ROUTINE  #
# IS SPECIFIED IN THE FIT, EXECUTE IT                                  #
  
      IF RQHDRERF[0] EQ DFERREOD THEN  #IF END-OF-DATA# 
        BEGIN 
        FITEOI[0] = TRUE; 
        IF FITDX [0] NQ 0  THEN 
          DB$CALL (FITDX[0]); 
        RETURN; 
        END 
  
  
#     RETURN ADDRESS OF ERROR TEXT BUFFER IN STATUS BLOCK IF SPACE IS  #
#     ALLOCATED FOR IT AND THE REQUEST WAS IN ERROR(FOR INTERACTIVE QU)#
  
      IF RQHDRERF [0] NQ 0
        AND DBSTADR [0] NQ 0
          AND DB$TSKN NQ 0
      THEN
        BEGIN 
        P<DBSTUCP> = DBSTADR [0]; 
        DBSTUWD [DFDBSTSIZE] = 0; 
        B<42,18>DBSTUWD [DFDBSTSIZE] = LOC(ERRBUF); 
        IF RQHDRERF [0] EQ DFERRFAT 
        THEN
          BEGIN 
          B<0,6>DBSTUWD [DFDBSTSIZE] = DFERRFAT;
          END 
        END 
#     IF AN ERROR OCCURRED, THEN PROCESS ERROR CONDITIONS.             #
  
      IF RQHDRERF[0] NQ 0 
      THEN
        BEGIN 
  
#     IF NO EXTERNAL ERROR NUMBER AND THE ERROR IS NOT                 #
#     FATAL OR A RELATION READ OPERATION WAS JUST                      #
#     PROCESSED, RETURN TO CALLER. ERROR PROCESSING                    #
#     FOR RELATION READS IS HANDLED BY THE OBJECT-TIME ROUTINES.       #
  
        IF (RQPKERR[0] EQ 0 
          AND RQHDRERF[0] NQ DFERRFAT)
          OR FC EQ DFREL
          OR FC EQ DFRLS
        THEN
          BEGIN 
          RETURN; 
          END 
  
#     IF A FIT EXISTS, THEN STORE THE ERROR NUMBER IN THE FIT.         #
#     IF A BATCH USER, THEN WRITE TO THE ERROR FILE.                   #
#     IF THERE IS A USER SUPPLIED ERROR ROUTINE, THEN EXECUTE IT.      #
  
          IF LOC(FIT) NQ 0
          THEN
            BEGIN 
            FITES[0] = RQPKERR[0];
            IF RQPKTASK[0] EQ 0 
            THEN
              BEGIN 
              DB$WEF(FIT);
              END 
  
            IF FITEX[0] NQ 0
            THEN
              BEGIN 
              DB$CALL(FITEX[0]);
              END 
            END 
  
#     IF A FATAL ERROR OCCURRED AND THE USER IS NOT TAF OR INTERACTIVE #
#     QU, THEN ISSUE THE ERROR MESSAGE TO THE DAYFILE, BUT DO NOT      #
#     REPEAT THE SAME MESSAGE TWICE IN SUCCESSION.                     #
#     IF IMMEDIATE RETURN IS NOT SET                                   #
#       THEN IF THE ERROR IS REPORTING A TEMPORARY CDCS CONDITION,     #
#       DELAY AND THEN TRY THE CDCS CALL AGAIN.                        #
#       FOR OTHER ERRORS, ISSUE AN ABORT ERROR MESSAGE AND ABORT THE   #
#       USER JOB.                                                      #
#     IF IMMEDIATE RETURN IS SET, RESET THE IMMEDIATE RETURN FLAG.     #
  
          IF RQHDRERF[0] EQ DFERRFAT
            AND RQPKTASK[0] EQ 0
          THEN
            BEGIN 
            IF RQPKERR[0] NQ PRIORERR 
            THEN
              BEGIN 
              PRIORERR = RQPKERR[0];
              DB$DLAC = 0;         # SIGNAL FIRST CALL TO DB$DLAY      #
              DB$MSG(ERRBUF);      # ISSUE EACH MESSAGE ONLY ONCE      #
              END 
            IF NOT DB$IMRT
            THEN
              BEGIN 
              IF   RQPKERR[0] EQ O"644"  # CDCS UNAVAILABLE            #
                OR RQPKERR[0] EQ O"643"  # SCHEMA UNAVAILABLE          #
              THEN
                BEGIN 
                MSGEND[0] = 0;           # TRUNCATE MESSAGE TO -       #
                                         # " WAITING FOR CDCS  "       #
  
                                   # THE END OF A MESSAGE IS DEFINED   #
                                   # BY TWELVE BITS OF ZERO ON THE     #
                                   # RIGHT END OF THE WORD.            #
  
                IF RQPKERR[0] EQ O"643" 
                THEN               # RESTORE THE CHARACTERS " S"       #
                  BEGIN 
                  MSGRST[0] = " S"; 
                  END 
                DB$DLAY;           # DELAY                             #
                GOTO REPEAT;       # REPEAT THE CALL TO CDCS           #
  
                END 
              DB$MSG(ABTMSG); 
              DB$ABRT;
              END 
            DB$IMRT = FALSE;
            END 
        END 
  
 END
      TERM
