*DECK DB$UQIN 
USETEXT JLDEFTX 
USETEXT CDCSCTX 
  PROC DB$UQIN(QRFLFN,LOGERR);
  BEGIN 
 #
* *   DB$UQIN                                    PAGE  1
* *   DBU QRF INITIALIZER 
* *   A W LO
* 
* DC  PURPOSE 
* 
*     INITIALIZE QRF AND QRF TABLE
* 
* DC  ENTRY CONDITIONS
* 
*     SOURCE OF PARAMETERS
* 
*     QUICK RECOVERY FILE NAME     PARAMETER FROM CALLING SEQUENCES 
*     SAL INDEX                    POINT TO CORRECT SCHEMA
* 
* DC  EXIT CONDITIONS 
* 
*     THE QRF AND QRF TABLES ARE INITIALIZED AND RECOVERY POINTS ON 
*     JOURNAL LOG FILE AND ON QRF ARE GENERATED.
* 
*     IF ANY ERROR IS DETECTED, LOGERR IS SET TO
*         3  CIO ERROR
*         4   ERROR INVOLVING QRF BEING NOT A PF
*         5   ERROR INVOLVING QRF BEING NOT EMPTY 
*         6   SCHEMA ID ON QRF DOESNT MATCH CURRENT SCHEMA ID.
* 
* DC  CALLING ROUTINE 
* 
*     DB$RUPD    RECOVERY RESTORE UPDATE ROUTINE
* 
*  DC CALLED ROUTINES 
* 
*     DB$IOBS    BACKSPACE QRF
*     DB$IORD    READ FILE USING FET
*     DB$IORW    REWIND GIVEN FET 
*     DB$MSG     ERROR HANDLER
*     DB$RCLL    CDCS RECALL PROCESSOR
*     DB$STAT    RETURN STATUS OF FILE
* 
* DC  NON-LOCAL VARIABLES 
* 
*     CDCS COMMON            CDCSCOMMN
*     JOURNAL LOG COMMON     JLRECDCLS
*     RECOVERY RESTORE COMMON RVRSCOMMN 
*     DB$FLRQ - FLUSH REQUIRED FLAG 
* 
* DC  DESCRIPTION 
*     - CHECK IF QRF IS A PERMANENT FILE. IF IT IS NOT THEN ABORT USER. 
* 
*     - CREATE QRF TABLE
* 
*     - REWIND QRF
* 
*     - CHECK IF QRF IS EMPTY. IF NOT, THEN ABORT USER
* 
*     - INITIALIZE QRF TABLE
* 
*     - BACKSPACE QRF OVER EOR
* 
*     - GENERATE RECOVERY POINTS ON JOURNAL LOGS AND ON QRF.
* 
 #
      CONTROL NOLIST; 
*CALL RVRSCOMMN 
      CONTROL LIST; 
      XDEF ITEM DB$FLRQ B = FALSE; #FLAG REQUESTING QRF FLUSH          #
                             #QRF HEADER PRU# 
      ARRAY QH S(65); 
        BEGIN 
*CALL QRHEDDCLS 
        END 
      CONTROL EJECT;
# PARAMETERS PASSED FROM CALLING SEQUENCE                              #
  
      ITEM QRFLFN C(7);      # LFN OF QRF                              #
      ITEM LOGERR ; 
  
#  LOCAL VARIABLES                                                     #
  
  
      BASED ARRAY QRFJL;
        BEGIN 
        ITEM JLHDREC C(0,0,240);
        END 
  
# EXTERNAL REFERENCES                     # 
      XREF PROC FLUSHM;      #CRM FLUSH FILE# 
      XREF PROC DB$IOBS;
      XREF PROC DB$IORD;
      XREF PROC DB$IORW;
      XREF PROC DB$IOWR;
      XREF PROC DB$JLRP;
      XREF PROC DB$MSG; 
      XREF ARRAY DB$RA0;; 
      XREF PROC DB$RCLL;
      XREF FUNC DB$STAT;
      XREF ARRAY DB$IOFT ;
        BEGIN 
        ITEM QFFETLFN C(0,0,7);        #QRF FET LFN                    #
        ITEM QFFETES    U(0,46,4);     #NOS ABNORMAL TERMINATION FIELD #
        ITEM QFFETFIR    (1,42,18);    #QRF FET FIRST POINTER          #
        ITEM QFFETIN    (2,42,18);     #QRF FET IN POINTER             #
        ITEM QFFETOUT    (3,42,18);    #QRF FET OUT POINTER            #
        ITEM QFFETLIM    (4,42,18);    #QRF FET LIMIT POINER           #
        END 
  
      ITEM QFSIZE ;                    #SIZE OF QRF                    #
      ITEM QFFREE ;                    #FREE WORDS IN QRF              #
      ITEM QFGBID ;                    #GOOD BLOCK ID                  #
      ITEM NOTPF C(29) = "QRF IS NOT A PERMANENT FILE :"; 
      ITEM NOTEMP C(28) = "QRF IS NOT EMPTY INITIALLY :"; 
      ITEM WRONGSCID C(71) = "SCHEMA ID MISMATCH ON QRF FOR SCHEMA";
      ITEM CIOERR C(16) = "CIO ERROR ON QRF:";
      CONTROL EJECT;
      LOGERR = 0; 
# CHECK THAT QRF IS A PF. IF IT IS NOT A PF, DOWN SCHEMA AND ABORT USER#
  
      IF DB$STAT(QRFLFN) NQ 2 THEN
        BEGIN 
        DB$MSG(NOTPF);
        LOGERR = 4; 
        RETURN ;
        END 
  
# OTHERWISE, CREATE QRF TABLE                                          #
  
      QFFETLFN[0] = QRFLFN; 
      DB$IORW(LOC(DB$IOFT));       # REWIND                            #
      DB$RCLL(LOC(DB$IOFT));
  
# READ HEADER RECORD FROM QRF AND CHECK IF IT IS EMPTY                 #
# IF QRF NOT EMPTY THEN ABORT USER                                     #
# (EMPTY IS WHEN FIRST RECORD IS ONE PRU LONG)                         #
# VERIFY QRF IS FOR THE CURRENT SCHEMA.                                #
  
      DB$IORD(LOC(DB$IOFT),LOC(QH),DFPRUSIZ+1); 
      DB$RCLL(LOC(DB$IOFT));
      IF QFFETES NQ 0 
      THEN
        BEGIN 
        DB$MSG(CIOERR);            # CIO ERROR RETURNED                #
        LOGERR = 3; 
        RETURN; 
        END 
      IF QHSCID[0] NQ SASCHID[SALX] THEN
        BEGIN 
        C<40,30>WRONGSCID = SASCNAME[SALX]; 
        C<70,1>WRONGSCID = ":"; 
        DB$MSG(WRONGSCID);
        LOGERR = 6; 
        RETURN; 
        END 
      IF QFFETIN[0] - QFFETOUT[0] NQ DFPRUSIZ THEN
        BEGIN 
        DB$MSG(NOTEMP); 
        LOGERR = 5 ;
        RETURN  ; 
        END 
  
      QFSIZE = QHSIZE[0]; 
      QFFREE = QHSIZE[0]; 
      QFGBID = QHGBID[0]; 
  
# STORE RECOVERY RESTORE INFORMATION IN HEADER RECORD OF QRF           #
  
      IF RECOVRUN THEN QHGEN[0] = 1 ; 
        ELSE QHGEN[0] = 2 ; 
      P<QRFJL> = LOC( LOGREC);
      QHINFO[0] = C<0,DFHDRSZ>JLHDREC[0] ;
      RPNUM = QHRPNUM[0]; 
      P<AFIT> = 0;
      DB$UQRP;
      RETURN; 
      CONTROL EJECT;
      XDEF PROC DB$UQRP;
  PROC DB$UQRP; 
  BEGIN 
 #
* *   DB$UQRP -- QRF RECOVERY POINT PROCESSOR    PAGE  1
* *   A W LO                                     11/ 2/76 
* 
* DC  PURPOSE 
* 
*     FLUSH THE QRF AND SET IT TO THE RECOVERY POINT CONDITION
* 
* DC  CALLING ROUTINE 
*     DB$UQIN    DBU QRF INITIALIZER
*     DB$RUPD    DBU DATABASE UPDATE ROUTINE
* 
* DC  CALLED ROUTINES 
* 
*     DB$IORW    REWIND GIVEN FET 
*     DB$IOWR    WRITE RECORD GIVEN FET 
*     DB$JLRP    JOURNAL LOG A RECOVERY POINT.
*     DB$RCLL    CDCS RECALL PROCESSOR
* 
* DC  NON-LOCAL VARIABLES 
* 
*     CDCS COMMON              CDCSCOMMN
*     JOURNAL LOG COMMON       JLRECDCLS
*     QRF HEADER RECORD        QRHEDDCLS
*     DB$FLRQ - FLUSH REQUIRED FLAG 
* 
* DC  DESCRIPTION 
*     - CHECK IF QRF EXIST. IF NOT, RETURN TO CALLING SEQUENCE. 
* 
*     - OTHERWISE, REWIND QRF AND REWRITE QRF HEADER RECORD.
* 
*     - CLEAR FLUSH REQUIRED FLAG 
 #
      CONTROL EJECT;
  
#  LOCAL VARIABLES                                                     #
  
      ARRAY LISTFIT  [2] ;             # FIT LIST TO PASS TO CRM       #
        BEGIN 
        ITEM LISTWORD;
        ITEM LISTLFN C(0,0,7);
        ITEM LISTADDR (0,42,18);
        END 
      ITEM PROCNAME C(10);   #SCRATCH#
      ITEM RPTEXT C(30) = "QRF RECOVERY POINT"; 
  
  
#  IF AREA IS OPEN THEN SET UPUP LIST OF AREA FIT ADDRESS AND AREA NAME#
  
      IF LOC(AFIT) NQ 0 AND AFITOC[0] EQ 1 THEN 
        BEGIN 
        LISTADDR[0]     = LOC(AFIT);
        LISTLFN[0]     = C<0,7>AFITLFN[0] ; 
        LISTWORD[1]     = 0;
  
# CALL CRM TO DO THE FLUSHING                                          #
  
        FLUSHM(LISTFIT,DB$RA0); 
        END 
      RPNUM = RPNUM + 1;
  
# GENERATE RECOVERY POINTS ON JOURNAL LOG FILE AND ON THE QRF          #
  
      IF RECOVRUN THEN
        PROCNAME = "DBRCN"; 
      ELSE
        PROCNAME = "DBRST"; 
      DB$JLRP(" ",PROCNAME,RPTEXT); 
  
      QFFREE = QFSIZE;
  
# OTHERWISE, REWIND QRF, RECALL CDCS UNTIL IO COMPLETE                 #
  
      DB$IORW(LOC(DB$IOFT));
      DB$RCLL(LOC(DB$IOFT));
  
# REWRITE QRF HEADER RECORD                                            #
  
      QFGBID = QFGBID + 1 ; 
      QHGBID[0] = QFGBID; 
      QHSIZE[0] = QFSIZE; 
      QHRPNUM[0] = RPNUM; 
      DB$IOWR(LOC(DB$IOFT), LOC(QH), DFPRUSIZ); 
      DB$RCLL(LOC(DB$IOFT));
      IF QFFETES NQ 0 
      THEN
        BEGIN 
        DB$MSG(CIOERR);            # CIO ERROR RETURNED                #
        LOGERR = 3; 
        END 
  
# BACKSPACE QRF OVER EOR SO THAT WHEN QRF LOGGING IS DONE, THE FIRST
  RECORD WILL BE LONGER THAN ONR PRU                                   #
  
      DB$IOBS(LOC(DB$IOFT));
      DB$RCLL(LOC(DB$IOFT));
      DB$FLRQ = FALSE;
      RETURN; 
      END 
     CONTROL EJECT; 
  XDEF PROC DB$URFP;
      PROC DB$URFP(QRP);
  BEGIN 
 #
* *   DB$URFP -- WRITES BLOCKS TO QRF            PAGE  1
* *              AND INITIATES FLUSH IF QRF IS FULL 
* *   A W LO                                     11/ 2/76 
* 
* DC  PURPOSE 
* 
*     WRITES BLOCKS TO QRF AND CALLS FLUSHING ROUTINE IF QRF IS FULL
* 
* DC  CALLING ROUTINE 
* 
*     CRM 
* 
* DC  CALLED ROUTINES 
* 
*     FLSH       CRM FLUSH ROUTINE
*     DB$IOWR    WRITE RECORD GIVEN FET 
*     DB$RCLL    CDCS RECALL PROCESSOR
*     DB$UQRP    QRF RECOVERY POINT PROCESSOR 
* 
* DC  NON-LOCAL VARIABLES 
* 
*     RECOVERY RESTORE COMMON  RVRSCOMMN
*     QRF INPUT REQUEST        QRREQDCLS
*     DB$FLRQ - FLUSH REQUIRED FLAG 
* 
* DC  DESCRIPTION 
* 
*     - SAVE CONTENTS OF LAST CRM WORD IN BLOCK AND STORE CODEWORD
*     - AT BLOCK + QRF BLOCK LENGTH 
* 
*     - WRITE A CRM BLOCK TO QRF
* 
*     - CHECK IF QRF IS FULL, IF IT IS NOT, RETURN. 
* 
*     - IF QRF IS FULL, SET DB$FLRQ TO REQUEST A FLUSH. 
* 
 #
  
# LOCAL VARIABLES                                                      #
  
*CALL QRCTLDCLS 
  
     ARRAY QRP; 
        BEGIN 
*CALL QRREQDCLS 
        END 
  
      ITEM SAVEWORD;
      ITEM SAVEWORD1; 
      CONTROL EJECT;
  
# SAVE CONTENTS OF LAST WORD IN CRM BLOCK                              #
  
      P<QCCTLWD> = QRFWA[0] + QRLEN[0] ;
      SAVEWORD = QCWORD0[0];
      SAVEWORD1 = QCWORD1[0]; 
  
# REPLACE LAST WORD IN CRM BLOCK BY CODEWORD                           #
  
      QCAID[0] = MDADIDNT[0]; 
      QCPRUN[0] = QRPRUN[0] ; 
      QCINDEXF[0] = QRINDEXF[0] ; 
      QCVENAME[0] = REQVERS;
      QCGBID[0] = QHGBID[0] ; 
  
# WRITE A CRM BLOCK                                                    #
  
      DB$IOWR(LOC(DB$IOFT), QRFWA[0], QRLEN[0] + 2);
      DB$RCLL(LOC(DB$IOFT));
      IF QFFETES NQ 0 
      THEN
        BEGIN 
        DB$MSG(CIOERR);            # CIO ERROR RETURNED                #
        LOGERR = 3; 
        END 
  
# RESTORE CONTENTS OF LAST WORD IN CRM BLOCK                           #
  
      QCWORD0[0] = SAVEWORD;
      QCWORD1[0] = SAVEWORD1; 
  
      QFFREE = QFFREE - QRLEN[0] - 2; 
  
# CHECK QRF TO SEE IF IT IS FULL                                       #
  
      IF QFFREE LQ 0 THEN 
        DB$FLRQ = TRUE;            #REQUEST FLUSH                      #
      END                 # DB$URFP#
      END                 #DB$UQIN #
      TERM
