*DECK,NRODDA                                                               NRODDA 
*CALL COMUSETXT 
     PROC NRO$DA ; BEGIN                                                 NRODDA 
                                                                         NRODDA 
                                                                         NRODDA 
     XREF BEGIN                                                          NRODDA 
          FUNC HASH$DA ;                                                 NRODDA 
          FUNC QUMP$AA ;                                                 NRODDA 
          FUNC LWAD$AA ;                                                 NRODDA 
          PROC DLT$MP ;                                                  NRODDA 
          PROC REPL$MP ;                                                 NRODDA 
          PROC PUT$MP ;                                                  NRODDA 
          PROC DELL$AA ;                                                 NRODDA 
          PROC FIND$DA ;                                                 NRODDA 
          PROC KPTR$DA ;                                                 NRODDA 
          PROC ADRC$AA ;                                                 NRODDA 
          PROC CURR$AA ;                                                 NRODDA 
          PROC ALTR$AA ;                                                 NRODDA 
          PROC LOCB$AA ;                                                 NRODDA 
          PROC CCAL$AA;  #FOR CONDITIONAL CALL TO RARE FUNC#             GAG0811
          PROC FIXX$AA ;                                                 NRODDA 
          PROC RCKN$AA ;                                                 NRODDA 
          PROC UNFX$AA ;                                                 NRODDA 
          PROC BNCH$AA ;                                                 NRODDA 
          PROC SEBL$AA ;                                                 NRODDA 
          PROC LOCR$AA ;                                                 NRODDA 
          PROC RPGT$AA ;                                                 AFB1114
          FUNC MXPR$AA ;                                                 NRODDA 
          PROC MSGZ$AA ;                                                 NRODDA 
          LABEL EXIT$AA ;                                                NRODDA 
          PROC VOKM$AA ;                                                 NRODDA 
          PROC CMRC$AA ;                                                 NRODDA 
          PROC SLOG$AA ;                                                016800
          PROC NUBL$AA ;                                                 NRODDA 
          PROC CONS$AA ;                                                 NRODDA 
          PROC EXRP$AA ;                                                 AFB0801
          PROC DUPK$AA ;
          END                                                            NRODDA 
  
CONTROL WEAK REPL$MP, PUT$MP, DLT$MP ;
                                                                         NRODDA 
     XDEF BEGIN                                                          NRODDA 
          PROC METB$DA ;                                                 NRODDA 
          PROC XMET$DA ;                                                 NRODDA 
          FUNC ZING$DA ;                                                 NRODDA 
          PROC PUT$DA ;                                                  NRODDA 
          PROC DLT$DA ;                                                  NRODDA 
          END                                                            NRODDA 
                                                                         NRODDA 
     ITEM I , J , ALPHA , GAMMA , ETA ; #SCRATCH#                        AFB0801
CONTROL EJECT ;                                                          AFB0912
 #                                                                       AFB0912
* *   ZING$DA - RETURN THE HOME BLOCK NUMBER FOR A GIVEN    PAGE 1       AFB0912
* *         RECORD IN A TERMINAL BLOCK                                   AFB0912
* *   A.F.R.BROWN                                                        AFB0912
* 1DC ZING$DA                                                            AFB0912
*                                                                        AFB0912
* DC  FUNCTION                                                           AFB0912
*                                                                        AFB0912
*     TO RETURN IN X6, AS A SYMPL FUNCTION, THE HOME BLOCK PRU           AFB0912
*     NUMBER CORRESPONDING TO A GIVEN RECORD IN THE CURRENT BLOCK,       AFB0912
*     WHICH WILL BE A TERMINAL BLOCK, BECAUSE OTHERWISE THERE WOULD      AFB0912
*     BE NO QUESTION ABOUT WHAT THE HOME BLOCK NUMBER WAS.               AFB0912
*     OR TO RETURN A VALUE OF -1 IF THE RECORD WAS DEAD AND              AFB0912
*     IRRELEVANT.                                                        AFB0912
*                                                                        AFB0912
* DC  ENTRY CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     THERE IS ONE PARAMETER PASSED IN THE NORMAL SYMPL WAY.             AFB0912
*     THIS IS I, THE NUMBER OF THE SPECIFIED RECORD WITHIN THE           AFB0912
*     CURRENT BLOCK.                                                     AFB0912
*                                                                        AFB0912
*     P<BLOK$AA> POINTS TO THE CURRENT BLOCK.                            AFB0912
*                                                                        AFB0912
*     P<FSTT$AA> POINTS TO THE FSTT OF THE CURRENT FILE.                 AFB0912
*                                                                        AFB0912
*     TEMPOS AND TEMPLOFF LOCATE THE PRIMARY KEY WITHIN A                AFB0912
*       RECORD OF THE FILE. IN FACT THEY EQUAL FSKEYPOS AND              AFB0912
*       FSKEYLOC RESPECTIVELY. TEMPLOFF IS NEEDED BY LOCR$AA,            AFB0912
*       WHICH WILL SET TEMPLOC. TEMPOS AND TEMPLOFF WERE SET             AFB0912
*       BY SUBROUTINE LKEY$AA.                                           AFB0912
*     BLOCLWA IS THE LWA+1 OF THE CURRENT BLOCK. THIS WAS ALSO SET       AFB0912
*       BY LKEY$AA. RPFIELD IS A DEF THAT EXPANDS INTO SOMETHING         AFB0912
*       CONTAINING BLOCLWA.                                              AFB0912
*                                                                        AFB0912
* DC  EXIT CONDITIONS                                                    AFB0912
*                                                                        AFB0912
*     IF RECORD I OF THE CURRENT BLOCK WAS DEAD (WE DO NOT ALLOW FOR     AFB0912
*     THE CASE THAT I IS GREATER THAN THE RECORD COUNT OF THE BLOCK.     AFB0912
*     THIS MUST BE EXCLUDED AHEAD OF TIME) THEN THE RETURNED             AFB0912
*     FUNCTION IS -1.                                                    AFB0912
*                                                                        AFB0912
*     OTHERWISE, THE RETURNED FUNCTION IS THE HOME BLOCK PRU NUMBER      AFB0912
*     CORRESPONDING TO THE PRIMARY KEY OF THAT RECORD, AND RECFWA,       AFB0912
*     RECLWA AND RECLNG LOCATE THAT RECORD IN CORE. TEMPLOC IS THE       AFB0912
*     STARTING ADDRESS OF ITS PRIMARY KEY, AND TEMPOS THE STARTING       AFB0912
*     CHARACTER POSITION. THIS IS JUST AS TRUE IF THE PRIMARY KEYS       AFB0912
*     ARE ((UNEMBEDDED)) IN THIS FILE. IN THE CONTEXT WHERE ZING$DA      AFB0912
*     IS CALLED, WE ARE INTERESTED IN THE RECORD AS AN OBJECT IN         AFB0912
*     ONE BLOCK THAT MIGHT BE MOVED TO ANOTHER BLOCK, NOT AS SOME-       AFB0912
*     THING TO BE RETURNED FORMALLY TO THE USER.                         AFB0912
*                                                                        AFB0912
* DC  ERROR CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     NONE                                                               AFB0912
*                                                                        AFB0912
* DC  CALLED ROUTINES                                                    AFB0912
*                                                                        AFB0912
*     LOCR$AA - TO LOCATE RECORD I WITHIN THE BLOCK, AND SET             AFB0912
*       RECFWA, RECLWA, RECLNG, AND TEMPLOC.                             AFB0912
*     HASH$DA - TO CONVERT THE KEY TO A HOME BLOCK PRU NUMBER.           AFB0912
*                                                                        AFB0912
* DC  NON-LOCAL VARIABLES                                                AFB0912
*                                                                        AFB0912
*     TEMPLOC AND TEMPOS, ALREADY DISCUSSED.                             AFB0912
*                                                                        AFB0912
 #                                                                       AFB0912
                                                                         NRODDA 
     FUNC ZING$DA ( I ) ; BEGIN ITEM I ;                                 NRODDA 
          ZING$DA = -1 ;                                                 NRODDA 
          IF RPFIELD(0,4,I) EQ DEAD THEN RETURN ; #DEAD RECORD#          NRODDA 
          LOCR$AA ( I ) ;                                                NRODDA 
          ZING$DA = HASH$DA ( TEMPLOC , TEMPOS , KLENG ) ;               NRODDA 
          END                                                            NRODDA 
                                                                         NRODDA 
CONTROL EJECT ;                                                          AFB0912
 #                                                                       AFB0912
* *   BOSKY - DELETE A DA RECORD AND ADJUST THE BLOCK     PAGE 1         AFB0912
* *   A.F.R.BROWN                                                        AFB0912
* 1DC BOSKY                                                              AFB0912
*                                                                        AFB0912
* DC  FUNCTION                                                           AFB0912
*                                                                        AFB0912
*     TO DELETE THE CURRENT RECORD FROM A BLOCK IN A DA FILE,            AFB0912
*     AND (1) IF IT IS AN OVERFLOW BLOCK THAT BECOMES EMPTY, MOVE IT     AFB0912
*     TO THE EMPTY CHAIN (2) IF A TERMINAL BLOCK, NOT BECOME             AFB0912
*     EMPTY, BUT FROM WHICH THE ONLY RECORD BELONGING TO A               AFB0912
*     CERTAIN HOME BLOCK HAS BEEN DELETED, UNCHAIN THE TERMINAL          AFB0912
*     BLOCK FROM THE HOME OR MEMBER BLOCK PRECEDING IT.                  AFB0912
*                                                                        AFB0912
* DC  ENTRY CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     SAME AS FOR SUBROUTINE DELL$AA. BASICALLY, THE CURRENT             AFB0912
*     RECORD MUST HAVE JUST BEEN LOCATED BY LOCR$AA, AND IT MUST         AFB0912
*     BE A LIVE RECORD.                                                  AFB0912
*                                                                        AFB0912
*     IN ADDITION, IF THIS IS NOT A HOME BLOCK, ALPHA MUST               AFB0912
*     BE THE PRU NUMBER OF THE BLOCK THAT PRECEDES IT IN ITS             AFB0912
*     OVERFLOW CHAIN, AND GAMMA MUST BE THE PRU NUMBER OF                AFB0912
*     THE HOME BLOCK IN THE SAME CHAIN.                                  AFB0912
*                                                                        AFB0912
* DC  EXIT CONDITIONS                                                    AFB0912
*                                                                        AFB0912
*     THE RECORD HAS BEEN DELETED FROM THE BLOCK, AND THE                AFB0912
*     RECORD COUNT IN THE FSTT (RECCNT) HAS BEEN REDUCED BY 1.           AFB0912
*                                                                        AFB0912
*     IF THE BLOCK IS A HOME BLOCK, THIS IS ALL THAT IS DONE,            AFB0912
*     BECAUSE HOME BLOCKS HAVE AN IMMUTABLE PLACE IN THE FILE.           AFB0912
*                                                                        AFB0912
*     IF THE BLOCK IS NOT A HOME BLOCK, THEN IN ADDITION --              AFB0912
*     (1) THE COUNT OF OVERFLOW RECORDS IN THE FSTT, FSORCNT,            AFB0912
*     HAS BEEN REDUCED BY 1.                                             AFB0912
*     (2) IF THE BLOCK HAS BEEN EMPTIED, IT IS MOVED TO THE              AFB0912
*     EMPTY CHAIN. THIS MEANS COPYING ITS FORWARD POINTER                AFB0912
*     BACK INTO ITS PREDECESSOR IN THE OVERFLOW CHAIN, AS                AFB0912
*     WELL AS CHAINING THE NOW-EMPTY BLOCK INTO THE EMPTY                AFB0912
*     CHAIN. IF THE NOW-EMPTY BLOCK WAS A TERMINAL BLOCK, IT             AFB0912
*     CAN ONLY HAVE BELONGED TO ONE OVERFLOW CHAIN, BECAUSE              AFB0912
*     IT HAD ONLY ONE RECORD, AND BECAUSE OF STEP (3) --                 AFB0912
*     (3) IF THE BLOCK HAS NOT BEEN EMPTIED, BUT IS A TERMINAL           AFB0912
*     BLOCK, WE CALL METB$DA TO ADJUST THE MOST-EMPTY TABLE              AFB0912
*     ACCORDINGLY, AND THEN CHECK WHETHER THERE ARE ANY                  AFB0912
*     REMAINING RECORDS IN THE BLOCK THAT BELONG TO THE SAME             AFB0912
*     HOME BLOCK AS THE RECORD JUST DELETED. IF NOT, BREAK               AFB0912
*     THE LINK LEADING FROM THAT HOME BLOCK TO THIS TERMINAL             AFB0912
*     BLOCK, OR FROM SOME INTERVENING MEMBER BLOCK TO THIS               AFB0912
*     TERMINAL BLOCK, BY ZEROING THE FORWARD POINTER OF THE              AFB0912
*     BLOCK THAT PRECEDES THIS BLOCK IN THE CHAIN (THERE                 AFB0912
*     MUST REMAIN AT LEAST ONE OTHER BLOCK IN THE FILE THAT              AFB0912
*     STILL POINTS TO THIS TERMINAL BLOCK.)                              AFB0912
*     (4) IF THE BLOCK IS EMPTIED, FSOBCNT, THE COUNT OF OVERFLOW        AFB0912
*     BLOCKS, AND FSBLKCNT, THE COUNT OF BLOCKS IN USE, ARE BOTH         AFB0912
*     REDUCED BY 1, WHILE FSMTBCNT, THE COUNT OF BLOCKS ON THE           AFB0912
*     EMPTY CHAIN, IS INCREASED BY 1. THESE ARE ALL FIELDS IN            AFB0912
*     THE FSTT.                                                          AFB0912
*                                                                        AFB0912
* DC  ERROR CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     EXRP$AA IS CALLED IF THERE IS AN UNCORRECTABLE I/O ERROR ON A      AFB0912
*     BLOCK READ.                                                        AFB0912
*                                                                        AFB0912
* DC  CALLED ROUTINES                                                    AFB0912
*                                                                        AFB0912
*     DELL$AA - TO DELETE THE CURRENT RECORD FROM THE                    AFB0912
*       CURRENT BLOCK.                                                   AFB0912
*     XMET$DA - TO REMOVE THE CURRENT BLOCK FROM THE MOST-EMPTY          AFB0912
*       TABLE IF IT WAS A TERMINAL BLOCK AND HAS BEEN EMPTIED.           AFB0912
*     METB$DA - TO UPDATE THE MOST-EMPTY TABLE AS NECESSARY, WHEN        AFB0912
*       THE CURRENT BLOCK IS A TERMINAL BLOCK BUT HAS NOT BEEN           AFB0912
*       EMPTIED.                                                         AFB0912
*     ZING$DA - TO FIND OUT WHAT HOME BLOCK A GIVEN RECORD IN A          AFB0912
*       TERMINAL BLOCK BELONGS TO.                                       AFB0912
*     LOCB$AA - TO LOCATE THE BLOCK THAT PRECEDES THE CURRENT            AFB0912
*       BLOCK IN AN OVERFLOW CHAIN, KNOWING ITS PRU NUMBER.              AFB0912
*     ALTR$AA - TO DO THE FORMALITIES CONCERNING ALTERING A              AFB0912
*       BLOCK IMAGE FOR THE FIRST TIME, BEFORE ALTERING THE              AFB0912
*       FORWARD POINTER IN THAT PREDECESSOR BLOCK.                       AFB0912
*     SLOG$AA - TO DO SOME SPECIAL LOGGING ACTIVITY IF FLAG             017000
*       SFLG IS SET IN THE FIT, IN ORDER TO SHOW THAT AN                017100
*       UPDATE INVOLVING MORE THAN ONE BLOCK IS BEGINNING.              017200
*                                                                        AFB0912
* DC  NON-LOCAL VARIABLES                                                AFB0912
*                                                                        AFB0912
*     I - USED FOR SCRATCH                                               AFB0912
*     ALPHA, GAMMA - SET AS PART OF ENTRY CONDITIONS.                    AFB0912
*                                                                        AFB0912
 #                                                                       AFB0912
                                                                         AFB0912
     PROC BOSKY ; BEGIN ITEM XX ;                                        NRODDA 
          DELL$AA ;                                                      NRODDA 
          RECCNT = RECCNT - 1 ;                                          NRODDA 
          IF BLOCKID[0] GQ FSFDBPRU[0]                                   NRODDA 
            THEN BEGIN # NOT A HOME BLOCK #                              NRODDA 
              FSORCNT[0] = FSORCNT[0] - 1 ;                              NRODDA 
              XX = FWD ;                                                 NRODDA 
              IF RC EQ 0                                                 NRODDA 
                THEN BEGIN                                               NRODDA 
                  EC = MAXMT ;                                           NRODDA 
                  FWD = FSMTBPRU[0] ;                                    NRODDA 
                  FSMTBPRU[0] = BLOCKID[0] ;                             NRODDA 
                  FSMTBCNT[0] = FSMTBCNT[0] + 1 ;                        NRODDA 
                  FSBLKCNT[0] = FSBLKCNT[0] - 1 ;                        NRODDA 
                  FSOBCNT[0] = FSOBCNT[0] - 1 ;                          NRODDA 
                  IF XX EQ 0 THEN XMET$DA ; #WAS TERMINAL BLOCK#         NRODDA 
                END                                                      NRODDA 
                ELSE BEGIN                                               NRODDA 
                  IF XX NQ 0 THEN RETURN ; #NONEMPTY MEMBER#             NRODDA 
                  METB$DA ; #NONEMPTY TERMINAL#                          NRODDA 
                  FOR I = 1 STEP 1 UNTIL RC                              NRODDA 
                    DO BEGIN  #GET AND HASH KEY#                         NRODDA 
                      IF ZING$DA ( I ) EQ GAMMA THEN RETURN ;            NRODDA 
                    END                                                  NRODDA 
                END                                                      NRODDA 
              SLOG$AA ;                                                 017400
                  #BECAUSE WE HAVE ALTERED AN OVERFLOW BLOCK, AND ARE   017500
                   ABOUT TO ALTER THE FORWARD POINTER IN THE BLOCK THAT 017600
                   PRECEDES IT CHAINWISE. WE KNOW THAT THE BLOCK FROM   017700
                   WHICH DELETION HAS TAKEN PLACE HAS NOT YET BEEN      017800
                   WRITTEN OUT, SO THAT IT IS NOT TOO LATE TO CALL      017900
                   SLOG$AA, BECAUSE NO OTHER BLOCK HAS BEEN ACCESSED    018000
                   SO FAR.#                                             018100
              LOCB$AA ( ALPHA , 1 ) ; #PREDECESSOR#                      NRODDA 
              IF P<BLOK$AA> LS 0                                         AFB0801
                THEN BEGIN                                               AFB0801
                  EXRP$AA ;                                              AFB0801
                END                                                      AFB0801
              ALTR$AA ;                                                  NRODDA 
              FWD = XX ;                                                 NRODDA 
              BLCIP[0] = 0 ;                                             NRODDA 
              IF XX EQ 0 AND ALPHA NQ GAMMA THEN METB$DA ;               NRODDA 
                  #MEMBER BECOMES TERMINAL#                              NRODDA 
            END                                                          NRODDA 
          END                                                            NRODDA 
CONTROL EJECT ;                                                          AFB0912
 #                                                                       AFB0912
* *   DLT$DA - DO A DELETE OPERATION ON A DA FILE     PAGE 1             AFB0912
* *   A.F.R.BROWN                                                        AFB0912
* 1DC DLT$DA                                                             AFB0912
*                                                                        AFB0912
* DC  FUNCTION                                                           AFB0912
*                                                                        AFB0912
*     TO CARRY OUT A DELETE OPERATION ON A DA FILE, DELETING             AFB0912
*     A RECORD IDENTIFIED BY PRIMARY KEY.                                AFB0912
*                                                                        AFB0912
* DC  ENTRY CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     P<FIT$AA> AND P<FIAT$AA> POINT TO THE FIT AND FIAT.                AFB0912
*     STMD$AA(0) HAS BEEN CALLED JUST BEFORE DLT$DA. IN                  AFB0912
*       PARTICULAR THIS MEANS THAT P<FSTT$AA> POINTS TO THE FSTT         AFB0912
*       OF THE DA FILE, NOT THAT OF THE MIP FILE IF ANY.                 AFB0912
*     KA AND KP IN THE FIT LOCATE THE START OF THE KEY PROPOSED          AFB0912
*       BY THE CALLER, WHICH IS A PRIMARY KEY VALUE.                     AFB0912
*                                                                        AFB0912
* DC  EXIT CONDITIONS                                                    AFB0912
*                                                                        AFB0912
*     IF NO ERROR, THE RECORD HAS BEEN DELETED FROM THE DA FILE WITH     AFB0912
*     ALL THE EXIT CONDITIONS LISTED FOR SUBROUTINE BOSKY. IN            AFB0912
*     ADDITION, IF THE FILE HAS A PARTNER MIP FILE, THIS HAS BEEN        AFB0912
*     ADJUSTED ACCORDINGLY. FSDELCNT IN THE FSTT HAS BEEN INCREASED      AFB0912
*     BY 1.                                                              AFB0912
*                                                                        AFB0912
*     IF THE DELETED RECORD WAS IN A BLOCK OF UNIFORM RECORDS, AND       AFB1109
*     WAS NOT THE LAST RECORD IN THE BLOCK, AND IF THE SECOND WORD IN    AFB1109
*     THE PTREE POINTED TO THAT RECORD, OR TO A LATER ONE IN THE SAME    AFB1109
*     BLOCK,THE RECORD NUMBER IN THAT PTREE WORD IS REDUCED BY ONE.      AFB1109
*     THIS IS BECAUSE ALL RECORDS AFTER THE DELETED ONE, WITHIN THE SAME AFB1109
*     BLOCK, HAVE THEIR RECORD NUMBERS REDUCED BY ONE WHEN THE DELETED   AFB1109
*     RECORD IS SQUEEZED OUT.                                            AFB1109
*     THE SAME HAS TO BE DONE TO ANY OTHER FITS THAT MAY BE POINTING TO  AFB1109
*     THE SAME FILE, AND SUBROUTINE VOID DOES IT.                        AFB1109
*                                                                        AFB0912
* DC  ERROR CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     EC445 - THE GIVEN KEY IS NOT MATCHED IN THE FILE.                  AFB0912
*                                                                        AFB0912
* DC  CALLED ROUTINES                                                    AFB0912
*                                                                        AFB0912
*     PURE - TO CHECK FOR PERMISSION, AND TO SET THE FAALTPOS BIT        AFB0912
*       IN ALL FITS NOW OPEN FOR THIS FILE. IN A DA FILE, THIS FLAG      AFB0912
*       IS NOT USED IN CONNECTION WITH ORDINARY GETNEXTING. BUT IT       AFB0912
*       IS USED FOR GETNEXTING BY ALTERNATE KEY. WHEN SET, IT MEANS      AFB0912
*       POSITION MUST FIRST BE RESTORED BY KEY VALUE, RATHER THAN        AFB0912
*       RELYING ON POSITIONS RECORDED IN PTREES.                         AFB0912
*     KPTR$DA - TO MAKE KEYFWA AND KEYOFF LOCATE THE KEY.                AFB0912
*     FIND$DA - TO LOCATE THE RECORD WITH THAT KEY, SET PTREEWRD[0]      AFB0912
*       TO POINT TO IT, AND TO SAVE TWO BLOCK NUMBERS IN                 AFB0912
*       PTREEWRD[2] THAT WE AFTERWARDS COPY INTO ALPHA AND GAMMA.        AFB0912
*     MSGZ$AA - TO ISSUE A NON-FATAL ERROR.                              AFB0912
*     QUMP$AA - TO DECIDE IF THE FILE HAS A MIP PARTNER.                 AFB0912
*     DLT$MP - IF YES, TO MODIFY THE MIP FILE AS NECESSARY.              AFB0912
*     BOSKY - TO DELETE THE CURRENT RECORD FROM THE DA FILE.             AFB0912
*     VOID - IF THE DELETE TAKES THE FORM OF SQUEEZING A RECORD OUT OF   AFB1109
*       THE BLOCK, TO SCAN ALL FITS POINTING TO THIS FILE, AND IF THEY   AFB1109
*       RECORD A POSITION THAT WOULD CAUSE THE NEXT GETNEXT TO GET ONE   AFB1109
*       OF THE RECORDS THAT WAS MOVED DOWN A SLOT BY THE DELETE, TO      AFB1109
*       REDUCE BY ONE THE RECORD NUMBER IN THE GETNEXT-POSITION WORD.    AFB1109
*     SLOG$AA - TO DO SOME SPECIAL LOGGING ACTIVITY IF FLAG             018300
*       SFLG IS SET IN THE FIT, IN ORDER TO SHOW THAT AN                018400
*       UPDATE INVOLVING MORE THAN ONE BLOCK IS BEGINNING.              018500
*                                                                        AFB0912
* DC  NON-LOCAL VARIABLES                                                AFB0912
*                                                                        AFB0912
*     ALPHA - INTO THIS WE COPY A FIELD OF THE THIRD WORD OF THE         AFB0912
*       PTREE, IN WHICH FIND$DA HAS STORED THE PRU NUMBER OF THE         AFB0912
*       BLOCK THAT PRECEDES THE CURRENT BLOCK IN ITS OVERFLOW CHAIN,     AFB0912
*       OR 0 IF THE CURRENT BLOCK IS A HOME BLOCK.                       AFB0912
*     GAMMA - INTO THIS WE COPY A SIMILAR FIELD, WHERE FIND$DA HAS       AFB0912
*       STORED THE NUMBER OF THE HOME BLOCK TO WHICH THE CURRENT         AFB0912
*       RECORD BELONGS. THIS MIGHT BE THE SAME AS THE CURRENT BLOCK      AFB0912
*       NUMBER, OR THE SAME AS ALPHA, OR NEITHER.                        AFB0912
*     QMF - THIS IS SET BY FIND$DA TO 1 IF A MATCHING RECORD IS          AFB0912
*       FOUND, OR TO 0 IF NOT.                                           AFB0912
*                                                                        AFB0912
 #                                                                       AFB0912
                                                                         NRODDA 
     PROC DLT$DA ; BEGIN                                                 NRODDA 
          PURE ;                                                         NRODDA 
          KPTR$DA ;                                                      NRODDA 
          FIND$DA ;                                                      NRODDA 
          ALPHA = B<0,24>PTREEWRD[2] ;                                   NRODDA 
           #SET BY FIND$DA, NUMBER OF PREDECESSOR BLOCK#                 NRODDA 
          GAMMA = B<24,24>PTREEWRD[2] ;                                  NRODDA 
           #SET BY FIND$DA, NUMBER OF HOME BLOCK#                        NRODDA 
          IF QMF EQ 0                                                    NRODDA 
            THEN BEGIN                                                   NRODDA 
              MSGZ$AA ( EC445 ) ;                                        NRODDA 
              RETURN ;                                                   AFB1114
            END                                                          NRODDA 
            ELSE BEGIN                                                   NRODDA 
              IF QUMP$AA ( 1 ) NQ 0 THEN DLT$MP ;                        NRODDA 
              IF UR NQ 0 AND RNO LS RC THEN VOID ( 0 , -1 ) ;            AFB1109
              IF BLOCKID[0] GQ FSFDBPRU[0]                              018700
               AND EC+2*RECLNG+1 EQ MAXMT                               018800
                THEN BEGIN #AN OVERFLOW BLOCK GOES EMPTY,2 BLOX CHANGE# 018900
                  SLOG$AA ;                                             019000
                END                                                     019100
              BOSKY ;                                                    NRODDA 
              FSDELCNT[0] = FSDELCNT[0] + 1 ;                            NRODDA 
            END                                                          NRODDA 
          END                                                            NRODDA 
CONTROL EJECT ;                                                          AFB0912
 #                                                                       AFB0912
* *   METB$DA - PUT A BLOCK IN THE MOST-EMPTY TABLE      PAGE 1          AFB0912
* *   A.F.R.BROWN                                                        AFB0912
* 1DC METB$DA                                                            AFB0912
*                                                                        AFB0912
* DC  FUNCTION                                                           AFB0912
*                                                                        AFB0912
*     TO COMPARE A BLOCK THAT IS NOW IN CORE WITH THE LIST OF            AFB0912
*     EMPTIEST-KNOWN BLOCKS, CALLED THE ((MOST-EMPTY TABLE)),            AFB0912
*     AND INSERT THE NEW BLOCK IF THERE IS A FREE SPACE OR A             AFB0912
*     LESS EMPTY BLOCK WORTHY TO BE KICKED OUT OF THE TABLE.             AFB0912
*     OR TO UPDATE THE ENTRY, IF THE BLOCK IS ALREADY IN                 AFB0912
*     THE TABLE.                                                         AFB0912
*                                                                        AFB0912
* DC  ENTRY CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     P<BLOK$AA> POINTS TO THE IMAGE OF THE BLOCK IN QUESTION.           AFB0912
*     THE MOST-EMPTY TABLE IS AN AREA IN THE FSTT OF THE CURRENT         AFB0912
*       FILE, TO WHICH P<FSTT$AA> POINTS. IT BEGINS AT                   AFB0912
*       FSEMPLIST[0].                                                    AFB0912
*                                                                        AFB0912
* DC  EXIT CONDITIONS                                                    AFB0912
*                                                                        AFB0912
*     IF THERE WAS AN ENTRY IN THE TABLE HAVING AN EMPTY COUNT           AFB0912
*     LOWER THAN THE EC OF THIS BLOCK, THAT ENTRY HAS BEEN               AFB0912
*     REPLACED BY ONE GIVING THE EC AND THE PRU NUMBER OF THIS           AFB0912
*     BLOCK. IT COULD HAVE BEEN AN EMPTY WORD IN THE TABLE, OR           AFB0912
*     ELSE AN ENTRY FOR A LESS EMPTY BLOCK. IF THERE WAS A               AFB0912
*     CHOICE OF ENTRIES TO REPLACE, THE ONE WITH THE LOWEST              AFB0912
*     EMPTY COUNT WAS REPLACED.                                          AFB0912
*                                                                        AFB0912
*     IF THIS BLOCK WAS ALREADY IN THE TABLE, HOWEVER, ITS ENTRY         AFB0912
*     HAS MERELY BEEN UPDATED WITH THE NEW EC, OR CLEARED OUT            AFB0912
*     ENTIRELY IF EC = 0 .                                               AFB0912
*                                                                        AFB0912
* DC  ERROR CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     NONE                                                               AFB0912
*                                                                        AFB0912
* DC  CALLED ROUTINES                                                    AFB0912
*                                                                        AFB0912
*     NONE                                                               AFB0912
*                                                                        AFB0912
* DC  NON-LOCAL VARIABLES                                                AFB0912
*                                                                        AFB0912
*     NONE                                                               AFB0912
*                                                                        AFB0912
 #                                                                       AFB0912
                                                                         NRODDA 
     PROC METB$DA ; BEGIN ITEM IX , JX , KX , LX , MX ;                  NRODDA 
          JX = -1 ;                                                      NRODDA 
          KX = 2**16 ;                                                   NRODDA 
          FOR IX = 0 STEP 1 UNTIL DFMETLG-1                              NRODDA 
            DO BEGIN                                                     NRODDA 
              LX = FSMTPRU[IX] ;                                         NRODDA 
              IF LX EQ BLOCKID[0]                                        NRODDA 
                THEN BEGIN                                               NRODDA 
                  FSMTUSW[IX] = EC ;                                     NRODDA 
                  RETURN ;                                               NRODDA 
                END                                                      NRODDA 
              MX = FSMTUSW[IX] ;                                         NRODDA 
              IF MX LS EC AND MX LS KX                                   NRODDA 
                THEN BEGIN                                               NRODDA 
                  KX = MX ;                                              NRODDA 
                  JX = IX ;                                              NRODDA 
                END                                                      NRODDA 
            END                                                          NRODDA 
          IF JX GQ 0                                                     NRODDA 
            THEN BEGIN                                                   NRODDA 
              FSMTPRU[JX] = BLOCKID[0] ;                                 NRODDA 
              FSMTUSW[JX] = EC ;                                         NRODDA 
            END                                                          NRODDA 
          END                                                            NRODDA 
CONTROL EJECT ;                                                          AFB0912
 #                                                                       AFB0912
* *   PURE - PREPARE FOR A DA FILE UPDATE                   PAGE 1       AFB0912
* *   A.F.R.BROWN                                                        AFB0912
* 1DC PURE                                                               AFB0912
*                                                                        AFB0912
* DC  FUNCTION                                                           AFB0912
*                                                                        AFB0912
*     TO DO THE PRELIMINARIES NEEDED FOR A PUT, REPLACE OR DELETE.       AFB0912
*     THESE ARE A LITTLE MISCELLANEOUS, AND ARE LISTED BELOW UNDER       AFB0912
*     EXIT CONDITIONS.                                                   AFB0912
*                                                                        AFB0912
* DC  ENTRY CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     P<FIT$AA> AND P<FIAT$AA> POINT TO THE CURRENT FIT AND ITS FIAT.    AFB0912
*     P<FSTT$AA> POINTS TO THE FSTT OF THE DATA FILE.                    AFB0912
*     RRL IN THE FIT, IF THIS IS A PUT OR REPLACE, IS THE LENGTH OF      AFB0912
*       THE NEW RECORD IN CHARACTERS.                                    AFB0912
*                                                                        AFB0912
* DC  EXIT CONDITIONS                                                    AFB0912
*                                                                        AFB0912
*     RRL HAS BEEN COPIED INTO RL IN THE FIT.                            AFB0912
*     IT HAS BEEN ASCERTAINED THAT WE HAVE THE NECESSARY PERMISSIONS     AFB0912
*       FOR THE UPDATE.                                                  AFB0912
*     FAALTPOS[0] HAS BEEN SET TO 1 IN EVERY FIAT CONNECTED WITH THE     AFB0912
*       FILE. IF ANY OF THOSE FIATS BELONGS TO A FIT IN WHICH A SERIES   AFB0912
*       OF GETNEXTS BY ALTERNATE KEY IS GOING ON, FAALTPOS=1 WILL        AFB0912
*       SIGNAL THAT POSITION HAS BEEN DISTURBED, AND MUST BE RESTORED    AFB0912
*       ACCORDING TO THE SAVED KEY VALUES.                               AFB0912
*                                                                        AFB0912
* DC  ERROR CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     NONE                                                               AFB0912
*                                                                        AFB0912
* DC  CALLED ROUTINES                                                    AFB0912
*                                                                        AFB0912
*     VOKM$AA - TO CHECK PERMISSION TO UPDATE.                           AFB0912
*     VOID - TO SET FAALTPOS[0]=1 IN ALL THE FIATS CONNECTED WITH        AFB0912
*       AN FSTT.                                                         AFB1109
*                                                                        AFB0912
* DC  NON-LOCAL VARIABLES                                                AFB0912
*                                                                        AFB0912
*     NONE                                                               AFB0912
*                                                                        AFB0912
 #                                                                       AFB0912
                                                                         NRODDA 
PROC PURE ;                                                              NRODDA 
      BEGIN                                                              NRODDA 
      FTRL[0] = FTRRL[0] ;                                               NRODDA 
      VOKM$AA ;                                                          NRODDA 
      VOID ( 0 , 0 ) ;                                                   AFB1109
      IF FSMIPFSTT[0] NQ 0                                               NRODDA 
      THEN                                                               NRODDA 
          BEGIN                                                          NRODDA 
          VOID ( FSMIPFSTT[0]-P<FSTT$AA> , 0 ) ;                         AFB1109
          END                                                            NRODDA 
      END                                                                NRODDA 
CONTROL EJECT ;                                                          AFB0912
 #                                                                       AFB0912
* *   PUT$DA - DO A PUT OR REPLACE ON A DA FILE         PAGE 1           AFB0912
* *   A.F.R.BROWN                                                        AFB0912
* 1DC PUT$DA                                                             AFB0912
*                                                                        AFB0912
* DC  FUNCTION                                                           AFB0912
*                                                                        AFB0912
*     TO DO A COMPLETE PUT OR REPLACE ON A DA FILE. THE TWO              AFB0912
*     FUNCTIONS ARE GROUPED BECAUSE A REPLACE MAY TURN OUT TO            AFB0912
*     BE A DELETE OF THE OLD RECORD, FOLLOWED BY A PUT OF THE            AFB0912
*     NEW RECORD IN A COMPLETELY DIFFERENT BLOCK. MOST OF THE            AFB0912
*     CODE THAT LOOKS FOR SPACE IS COMMON TO BOTH FUNCTIONS.             AFB0912
*     IN I-S, BY CONTRAST, THE ROUTINES PUT$IS AND REPL$IS ARE           AFB0912
*     COMPARATIVELY SHORT, SO THAT THE VARIATIONS BETWEEN THEM           AFB0912
*     MAKE IT NOT QUITE WORTH WHILE TO COMBINE THEM.                     AFB0912
*                                                                        AFB0912
* DC  ENTRY CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     P<FIT$AA> AND P<FIAT$AA> POINT TO THE CURRENT FIT AND              AFB0912
*       FIAT.                                                            AFB0912
*     P<FSTT$AA> AND P<FINF$AA> POINT TO THE DATA FILE, NOT              AFB0912
*       THE MIP FILE IF ANY.                                             AFB0912
*     COP IN THE FIT CONTAINS THE CODE THAT TELLS WHETHER THIS           AFB0912
*       IS A PUT OR A REPLACE.                                           AFB0912
*     THE ENTRY CONDITIONS FOR SUBROUTINE CMRC$AA ALL APPLY. THIS        AFB0912
*       IS CALLED QUITE EARLY IN PUT$DA.                                 AFB0912
*     FSNXTPRU[0] CONTAINS 3 (PRU NUMBER OF THE FIRST HOME BLOCK)        AFB0912
*       IF THE FILE HAS NEVER BEEN PUT INTO, AND THE HOME BLOCKS         AFB0912
*       DO NOT EXIST YET. OTHERWISE, THE HOME BLOCKS MUST ALL            AFB0912
*       EXIST AS WELL-FORMED DATA BLOCKS, EVEN IF EMPTY.                 AFB0912
*     KA AND KP IN THE FIT GIVE THE STARTING ADDRESS AND CHARACTER       AFB0912
*       OFFSET OF THE PRIMARY KEY, IF IT IS NON-EMBEDDED.                AFB0912
*                                                                        AFB0912
* DC  EXIT CONDITIONS                                                    AFB0912
*                                                                        AFB0912
*     THE HOME BLOCKS HAVE ALL BEEN WRITTEN OUT, IF THEY DID NOT         AFB0912
*       EXIST BEFORE.                                                    AFB0912
*     THE PUT OR REPLACE HAS BEEN DONE.                                  AFB0912
*     FSPUTCNT OR FSREPCNT HAS BEEN INCREASED BY 1.                      AFB0912
*     RECCNT, THE TOTAL RECORD COUNT IN THE FSTT, HAS BEEN               AFB0912
*       INCREASED BY 1 IF A PUT.                                         AFB0912
*     FSORCNT, THE COUNT OF RECORDS IN OVERFLOW BLOCKS, HAS BEEN         AFB0912
*       ADJUSTED (E.G. A REPLACE MAY INCREASE OR DECREASE THIS           AFB0912
*       BY 1, OR LEAVE IT UNCHANGED.)                                    AFB0912
*     THE MOST-EMPTY TABLE HAS BEEN UPDATED IF NECESSARY.                AFB0912
*     THE CHANGES TO THE MIP FILE, IF ANY, HAVE ALL BEEN MADE.           AFB0912
*                                                                        AFB0912
* DC  ERROR CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     EC253 - THE OPERATION IS A PUT, BUT FILE RECORD COUNT ALREADY 
*       EQUALS THE LIMIT IN FLM.
*     EC446 - THE OPERATION IS A PUT,BUT THERE IS ALREADY A RECORD       AFB0912
*       WITH THE SAME PRIMARY KEY.                                       AFB0912
*     EC445 - THE OPERATION IS A REPLACE, BUT THERE IS NO RECORD         AFB0912
*       WITH THE SAME PRIMARY KEY.                                       AFB0912
*                                                                        AFB0912
* DC  CALLED ROUTINES                                                    AFB0912
*                                                                        AFB0912
*     MXPR$AA - A FUNCTION THAT RETURNS THE PRU NUMBER AT THE            AFB0912
*       END OF THE FILE.                                                 AFB0912
*     NUBL$AA - TO GET A NEW BLOCK - FROM THE EMPTY CHAIN IF ANY,        AFB0912
*       OTHERWISE AS AN EXTENSION AT EOI.                                AFB0912
*     UNFX$AA - TO RETURN A BLOCK TO THE KICK-OUT CHAIN. NUBL$AA         AFB0912
*       ALWAYS ((FIXES)) THE NEW BLOCK BY REMOVING IT FROM THE KICKOUT   AFB0912
*       CHAIN AND SAVING ITS ADDRESSES IN THE FIXHOLD ARRAY. HERE, FOR   AFB0912
*       ONCE, WE DO NOT WANT THAT FIXATION, SO WE CALL UNFX$AA           AFB0912
*       IMMEDIATELY TO UNDO IT.                                          AFB0912
*     PURE - TO CHECK FOR PERMISSIONS, AND TO SET FAALTPOS IN THE        AFB0912
*       FIAT FOR EVERY FIT THAT IS AT PRESENT ACCESSING THIS FILE.       AFB0912
*     CMRC$AA - TO COMPRESS THE NEW RECORD, IF THIS IS NEEDED, AND       AFB0912
*       TO SET NEWFWA TO THE FWA AND NEWLNG TO THE LENGTH IN             AFB0912
*       CHARACTERS OF THE COMPRESSED VERSION, IF ANY, OTHERWISE OF       AFB0912
*       THE ORIGINAL NEW RECORD.                                         AFB0912
*     UPFINDA - TO SET KEYFWA, KEYOFF, QREL AND MAJKEY FOR BNCH$AA       AFB0912
*       AND HASH$DA TO USE LATER ON.                                     AFB0912
*     HASH$DA - TO DERIVE A HOME BLOCK PRU NUMBER FROM THE KEY.          AFB0912
*     SEBL$AA - TO FIND EACH BLOCK IN TURN IN THE CHAIN BEGINNING AT     AFB0912
*       THE HOME BLOCK.                                                  AFB0912
*     LWAD$AA - USED, IF UNIFORM BLOCK, TO SET RECLNG = RECORD           AFB0912
*       LENGTH, NEEDED BY RCKN$AA .                                      AFB0912
*     BNCH$AA - TO SCAN A BLOCK OF RECORDS, ORDERED BY KEY, FOR A        AFB0912
*       KEY MATCHING THAT OF THE NEW RECORD.                             AFB0912
*     MSGZ$AA - TO ISSUE A NON-FATAL ERROR.                              AFB0912
*     DUPK$AA - TO ISSUE ERROR MESSAGES FOR DUP KEYS. 
*     LOCR$AA - IN CASE OF A REPLACE, TO FIND THE LENGTH IN WORDS OF     AFB0912
*       THE MATCHING RECORD, JUST BECAUSE RCKN$AA NEEDS RECLNG.          AFB0912
*       IN CASE OF A PUT, TO SET RECFWA OF THE RECORD NEXT BEFORE WHICH  AFB0912
*       THE INSERTION WILL BE MADE, FOR ADRC$AA.                         AFB0912
*     RCKN$AA - TO DECIDE WHETHER THE NEW RECORD WILL FIT INTO A         AFB0912
*       GIVEN BLOCK.                                                     AFB0912
*     FIXX$AA - TO HOLD IN CORE A BLOCK THAT IS KNOWN TO HAVE ROOM       AFB0912
*       FOR THE NEW RECORD. FOR INSTANCE, ON A PUT, THERE MAY BE         AFB0912
*       ROOM IN THE HOME BLOCK, BUT WE STILL HAVE TO SEARCH AN           AFB0912
*       OVERFLOW BLOCK TO GUARD AGAINST DUPLICATION. WHILE GETTING       AFB0912
*       THE OVERFLOW BLOCK, WE WANT THE HOME BLOCK TO STAY IN CORE       AFB0912
*       SO IT WONT HAVE TO BE READ AGAIN.                                AFB0912
*     UNFX$AA IS ALSO CALLED TO UNDO THIS SORT OF FIXING, IN A           AFB0912
*       COUPLE OF PLACES.                                                AFB0912
*     ZIPMIP - TO CALL THE ROUTINES FOR THE MIP WORK IF NECESSARY,       AFB0912
*       SAVING AND RESTORING AS NEEDED.                                  AFB0912
*     CURR$AA - TO LOCATE THE MATCHING RECORD ONCE ITS BLOCK AND         AFB0912
*       RECORD NUMBER ARE KNOWN, PREPARATORY TO DELETING OR              AFB0912
*       REPLACING IT, AS PART OF A REPLACE OPERATION.                    AFB0912
*     BOSKY - TO DELETE THE MATCHING RECORD, AS PART OF A REPLACE        AFB0912
*       OPERATION, AND TO MAKE SOME NECESSARY ADJUSTMENTS IF IT          AFB0912
*       IS IN AN OVERFLOW BLOCK.                                         AFB0912
*     VOID - IF THIS OPERATION IS A PUT OR A REPLACE BY A RECORD OF      AFB1109
*       DIFFERENT SIZE, TO STORE 1 IN THE SECOND WORD OF EVERY PTREE     AFB1109
*       THAT SHOWS A GETNEXT-BY-PRIMARY-KEY POSITION OTHER THAN THE      AFB1109
*       REWOUND POSITION, SHOWING THAT POSITION IS NO LONGER VALID.      AFB1109
*       AN ATTEMPT TO GETNEXT THROUGH ANY OF THOSE FITS WILL PRODUCE     AFB1109
*       A NON-FATAL ERROR.                                               AFB1109
*     ADNU$AD - THIS IS LOGICALLY PART OF PUT$DA, BUT IS MADE A          AFB0912
*       SEPARATE SUBROUTINE SO THAT IT CAN BE A SEPARATE CAPSULE.        AFB0912
*       IT IS CALLED WHEN WE CANNOT FIND ROOM FOR THE NEW                AFB0912
*       RECORD IN THE EXISTING HOME BLOCK AND ANY OVERFLOW BLOCK(S)      AFB0912
*       THAT MAY CHAIN OFF IT. ADNU$DA FINDS ROOM IN AN EXISTING         AFB0912
*       TERMINAL BLOCK NOT ALREADY BELONGING TO THE CHAIN, OR            AFB0912
*       GETS A NEW BLOCK FROM NUBL$AA.                                   AFB0912
*     CONS$AA - TO SQUEEZE OUT ANY DEAD RECORDS FROM A BLOCK,            AFB0912
*       BEFORE ADDING A RECORD OR REPLACING WITH A BIGGER RECORD.        AFB0912
*     ADRC$AA - TO ADD OR REPLACE A RECORD IN A BLOCK (VARIABLE FUNCT    AFB0912
*       IS 0 FOR REPLACE, 1 FOR ADD).                                    AFB0912
*     SLOG$AA - TO DO SOME SPECIAL LOGGING ACTIVITY IF FLAG             019300
*       SFLG IS SET IN THE FIT, IN ORDER TO SHOW THAT AN                019400
*       UPDATE INVOLVING MORE THAN ONE BLOCK IS BEGINNING.              019500
*                                                                        AFB0912
* DC  NON-LOCAL VARIABLES                                                AFB0912
*                                                                        AFB0912
*     I AND J - SHORT-TERM SCRATCH -- NOTE THAT THEY ARE LOCAL TO        AFB0912
*       NRO$DA AND SO UNAFFECTED BY THE CALLS TO NUBL$AA AND UNFX$AA.    AFB0912
*     GAMMA - SET WITH A CALL TO HASH$DA, TO THE HOME BLOCK NUMBER,      AFB0912
*       AND PRESERVED THEREAFTER.                                        AFB0912
*     ALPHA - INITIALIZED AS 0, THEN MAINTAINED AS THE PRU NUMBER        AFB0912
*       OF THE BLOCK BEFORE THE CURRENT ONE IN THE OVERFLOW CHAIN.       AFB0912
*     ETA - NOT INITIALIZED, BUT MAINTAINED AS THE PREVIOUS VALUE        AFB0912
*       OF ALPHA. WHEN THE CHAIN IS EXHAUSTED, WE HAVE C=0               AFB0912
*       AS CURRENT BLOCK NUMBER -- WE HAVE JUMPED OFF THE END --         AFB0912
*       ALPHA AS TERMINAL BLOCK NUMBER (OR HOME BLOCK IF NO              AFB0912
*       OVERFLOW) AND ETA AS THE NUMBER OF THE NEXT-TO-LAST BLOCK        AFB0912
*       IN THE CHAIN, PROVIDED ALPHA IS NOT THE HOME BLOCK.              AFB0912
*     ALPHA AND ETA ARE NEEDED ONLY TO BE PASSED TO ADNU$DA IF           AFB0912
*       IT IS CALLED.                                                    AFB0912
*     MATRESL IS THE RESULT SET BY BNCH$AA - 0 IF NO MATCHING            AFB0912
*       RECORD, OTHERWISE THE NUMBER OF THE MATCHING RECORD.             AFB0912
*     KEYFWA, KEYOFF, AND MAJKEY ARE THE FWA AND STARTING                AFB0912
*       CHARACTER OFFSET, AND THE LENGTH IN CHARACTERS, OF THE           AFB0912
*       KEY OF THE NEW RECORD. THEY ARE SET BY UPFINDA, AND              AFB0912
*       USED BY BNCH$AA.                                                 AFB0912
*     RECLNG IS THE LENGTH OF AN EXISTING RECORD IN WORDS.               AFB0912
*       SET BY LOCR$AA, USED BY RCKN$AA.                                 AFB0912
*     RECFWA IS THE FWA OF AN EXISTING RECORD, OR PERHAPS THE            AFB0912
*       LWA+1 OF THE LAST RECORD IN A BLOCK. SET BY LOCR$AA,             AFB0912
*       USED BY ADRC$AA.                                                 AFB0912
*     NEWLNG - LENGTH OF NEW RECORD IN CHARACTERS, SET BY                AFB0912
*       CMRC$AA.                                                         AFB0912
*     SPLTFLG - SET TO 0 BY RCKN$AA IF THE NEW RECORD WILL FIT           AFB0912
*       INTO THE CURRENT BLOCK, OR NON-ZERO IF NOT.                      AFB0912
*     FUNCT - SET TO 1 OR 0 BEFORE CALLING ADRC$AA -- 0 TO               AFB0912
*       REPLACE THE CURRENT RECORD, 1 TO INSERT BEFORE IT                AFB0912
*       OR PERHAPS AFTER THE LAST RECORD.                                AFB0912
*     FIXHOLD - THIS IS AN ARRAY OF FOUR WORDS THAT CAN HOLD             AFB0912
*       ADDRESSES OF BLOCKS WITHDRAWN FROM THE KICKOUT CHAIN             AFB0912
*       BY FIXX$AA. WHEN A BLOCK IS PUT BACK IN THE KICKOUT              AFB0912
*       CHAIN BY UNFX$AA, THE FIXHOLD ENTRY IS CLEARED.                  AFB0912
*     NEWBNUM - THE PRU NUMBER OF A NEW BLOCK FOUND BY                   AFB0912
*       ADNU$DA.                                                         AFB0912
*     BARREN IS SET TO 0 BEFORE CALLING ADRC$AA, TO TELL IT              AFB0912
*       TO SET THE SUB-FILE FLAG IN THE RECORD POINTER TO 0.             AFB0912
*                                                                        AFB0912
* DC  NARRATIVE                                                          AFB0912
*                                                                        AFB0912
*     FIRST CHECK THE FILE LIMIT, IF THE OPERATION IS A PUT.
*     NEXT, IF THE FILE CONSISTS OF NOTHING BUT THE 
*     FSTT CREATED BY OPEN-NEW, GENERATE ALL THE HOME BLOCKS,            AFB0912
*     AND SET FSLSTPRU (PRU NUMBER AT LOGICAL EOI) AND                   AFB0912
*     FSFDBPRU (PRU NUMBER AT END OF LAST HOME BLOCK). THIS              AFB0912
*     IS DONE IN THE PUT CODE, BECAUSE A PUT MUST BE THE FIRST           AFB0912
*     OPERATION AFTER OPEN NEW.                                          AFB0912
 #                                                                       AFB0912
                                                                         NRODDA 
     PROC PUT$DA ; BEGIN ITEM C , X , Y , Z ;                            NRODDA 
          IF FTCOP[0] EQ OP"PUT" AND FTFLM[0] LQ FSRECCNT[0]
            THEN BEGIN
              MSGZ$AA ( EC253 ) ; 
              RETURN ;
            END 
          IF MXPR$AA LQ PRU3                                             NRODDA 
            THEN BEGIN #INITIALIZE HOME BLOCKS#                          NRODDA 
              I = FSHBCNT[0] ;                                           NRODDA 
              FOR J = 1 STEP 1 UNTIL I                                   NRODDA 
                DO BEGIN                                                 NRODDA 
                  NUBL$AA ( 0 ) ;                                        NRODDA 
                  UNFX$AA ( 0 ) ;                                        NRODDA 
                END                                                      NRODDA 
              FSLSTPRU[0] = NEWBNUM + FSBLKSIZ[0] ;                      NRODDA 
              FSFDBPRU[0] = FSLSTPRU[0] ;                                NRODDA 
            END                                                          NRODDA 
 #                                                                       AFB0912
*     CALL PURE TO DO A COUPLE OF PRELIMINARIES.                         AFB0912
*     SET Y = -1 IF THIS IS A PUT, OR 0 IF A REPLACE. IF AND             AFB0912
*     WHEN WE FIND THE RECORD TO REPLACE, Y WILL BE SET TO               AFB0912
*     THE PRU NUMBER OF THAT BLOCK, AND Z TO THE RECORD NUMBER.          AFB0912
*     Y = -1 MEANS WE DONT WANT A MATCHING RECORD, BUT MUST              AFB0912
*     SEARCH FOR IT TO AVOID DUPLICATION. Y = 0, AT THE END OF           AFB0912
*     OUR SEARCH, MEANS FAILURE TO FIND RECORD TO BE REPLACED.           AFB0912
*     CALL CMRC$AA TO COMPRESS THE NEW RECORD IF NECESSARY AND           AFB0912
*     SET POINTERS TO IT. CALL UPFINDA TO SET POINTERS TO THE            AFB0912
*     KEY OF THE NEW RECORD.                                             AFB0912
*     SET GAMMA TO THE HOME BLOCK NUMBER.                                AFB0912
*     SET C = GAMMA AS CURRENT BLOCK NUMBER.                             AFB0912
*     SET CURPTR = 0, AS WE SHALL BE USING THE FIRST WORD OF             AFB0912
*     THE PTREE FOR BOOKKEEPING.                                         AFB0912
*                                                                        AFB0912
*     SET X = 0. IF AND WHEN WE FIND A BLOCK WITH ROOM FOR THE           AFB0912
*     NEW RECORD, X WILL BE SET TO ITS PRU NUMBER, AND IT WILL           AFB0912
*     BE FROZEN WITH FIXX$AA, FOR LATER USE. IF WE COME TO THE           AFB0912
*     END OF THE CHAIN WITH X = 0, IT MEANS THERE WAS NO BLOCK           AFB0912
*     WITH ROOM.                                                         AFB0912
 #                                                                       AFB0912
          PURE ;                                                         NRODDA 
          Y = -1 ;                                                       NRODDA 
          IF FTCOP[0] EQ OP"RPL" THEN Y = 0 ;                            NRODDA 
          CMRC$AA ;                                                      NRODDA 
          UPFINDA ;                                                      NRODDA 
          GAMMA = HASH$DA ( KEYFWA , KEYOFF , MAJKEY ) ;                 NRODDA 
          C = GAMMA ;                                                    NRODDA 
          X = 0 ; #WILL BE PRU WHERE TO PUT#                             NRODDA 
          ALPHA = 0 ;                                                    NRODDA 
          CURPTR = 0 ;                                                   NRODDA 
                                                                         NRODDA 
 #                                                                       AFB0912
*     NOW SCAN THE CHAIN OF BLOCKS THAT BEGINS AT THE HOME BLOCK         AFB0912
*     UNTIL WE FIND A BLOCK WITH ROOM FOR THE NEW RECORD (X) AND,        AFB0912
*     IF THIS IS A REPLACE, THE BLOCK WITH THE OLD RECORD (Y).           AFB0912
*     IF THIS IS A PUT AND WE FIND A BLOCK WITH THE ((OLD)) RECORD,      AFB0912
*     TAKE AN ERROR EXIT -- BUT FIRST RELEASE BLOCK X IF THERE IS        AFB0912
*     ONE.                                                               AFB0912
*     IN PRINCIPLE WE CHOOSE X AS NEAR TO THE BEGINNING OF THE           AFB0912
*     CHAIN AS POSSIBLE. BUT IF THIS IS A REPLACE, THEN WHEN Y           AFB0912
*     (OLD RECORD) IS FOUND, WE SEE IF THE NEW RECORD COULD FIT          AFB0912
*     INTO THAT BLOCK, AND IF SO, RESET X, AND IF IT WAS NON-ZERO,       AFB0912
*     RELEASE THE BLOCK IT POINTS TO. OBVIOUSLY BETTER TO DO ALL         AFB0912
*     OF A REPLACE INSIDE THE SAME BLOCK IF POSSIBLE. ALWAYS             AFB0912
*     POSSIBLE IF THE NEW RECORD IS EQUAL OR SMALLER IN LENGTH.          AFB0912
*                                                                        AFB0912
*     IF WE GET TO THE END OF THE CHAIN WITHOUT FINDING X, A BLOCK       AFB0912
*     WITH ROOM, AND Y, THE BLOCK WITH THE OLD RECORD (BUT ONLY IF       AFB0912
*     THIS IS A REPLACE, THE LACK OF Y WILL CAUSE AN IMMEDIATE           AFB0912
*     NON-FATAL ERROR, BUT THE LACK OF X ONLY MAKES THINGS DIFFICULT.    AFB0912
*     WE NOW HAVE ALPHA = THE NUMBER OF THE LAST OR ONLY BLOCK IN THE    AFB0912
*     CHAIN, GAMMA = THE NUMBER OF THE HOME BLOCK, ETA = THE NUMBER      AFB0912
*     OF ALPHA-S PREDECESSOR IF ANY.                                     AFB0912
 #                                                                       AFB0912
          ASLONGAS C NQ 0 AND ( X EQ 0 OR Y LQ 0 )                       NRODDA 
            DO BEGIN                                                     NRODDA 
              PTCURBLK[0] = C ;                                          NRODDA 
              SEBL$AA ( 0 , 1 ) ;                                        NRODDA 
              IF UR NQ 0 THEN RECLNG = LWAD$AA ( 1 ) ;                   NRODDA 
                  # MAY BE NEEDED BY RCKN$AA #                           NRODDA 
              MATRESL = 0 ;                                              NRODDA 
              IF Y LQ 0 THEN BNCH$AA ;                                   NRODDA 
              IF MATRESL NQ 0                                            NRODDA 
                THEN BEGIN                                               NRODDA 
                  IF UR EQ 0                                             GAG1121
                  THEN                                                   GAG1121
                      BEGIN                                              GAG1121
                      RPGT$AA ( MATRESL ) ;                              GAG1121
                      IF UCCFIELD EQ DEAD THEN GOTO PUTDAB ;             GAG1121
                      END                                                GAG1121
                  IF Y LS 0                                              NRODDA 
                    THEN BEGIN                                           NRODDA 
                      IF X NQ 0 THEN UNFX$AA ( 0 ) ;                     NRODDA 
                      DUPK$AA ( EC446 ) ; 
                      RETURN ;                                           NRODDA 
                    END                                                  NRODDA 
                    ELSE BEGIN                                           NRODDA 
                      Z = MATRESL ;                                      NRODDA 
                      Y = C ;                                            NRODDA 
                      LOCR$AA ( Z ) ; #RCKN$AA NEEDS RECLNG#             NRODDA 
                      RCKN$AA ( 0 , 0 ) ;                                NRODDA 
                      IF SPLTFLG EQ 0                                    NRODDA 
                        THEN BEGIN                                       NRODDA 
                          IF X NQ 0 THEN UNFX$AA ( 0 ) ;                 NRODDA 
                          X = C ; #SIMPLE REPLACEMENT#                   NRODDA 
                           #NOW RECLNG STAYS SET#                        NRODDA 
                        END                                              NRODDA 
                    END                                                  NRODDA 
                END                                                      NRODDA 
                ELSE BEGIN                                               NRODDA 
     PUTDAB:                                                             AFB1114
                  IF X EQ 0                                              NRODDA 
                    THEN BEGIN                                           NRODDA 
                      RCKN$AA ( 1 , 0 ) ;                                NRODDA 
                      IF SPLTFLG EQ 0                                    NRODDA 
                        THEN BEGIN                                       NRODDA 
                          X = C ;                                        NRODDA 
                          FIXX$AA ( P<BLOK$AA> , 0 ) ;                   NRODDA 
                        END                                              NRODDA 
                    END                                                  NRODDA 
                END                                                      NRODDA 
              ETA = ALPHA ;                                              NRODDA 
              ALPHA = C ;                                                NRODDA 
              C = FWD ;                                                  NRODDA 
            END                                                          NRODDA 
                                                                         NRODDA 
 #                                                                       AFB0912
*     HAVING FINISHED THE SCAN ONE WAY OR ANOTHER, WE CAN IMMEDIATELY    AFB0912
*     RELEASE THE FROZEN BLOCK IF ANY. IT IS BLOCK X, WHICH HAS ROOM     AFB0912
*     FOR THE NEW RECORD, AND AS WE ARE NOT GOING TO READ ANY MORE       AFB0912
*     BLOCKS IN, WE DONT NEED TO HOLD IT ARTIFICIALLY IN MEMORY.         AFB0912
*     IF Y IS 0, FAIL TO MATCH ON REPLACE, AND NON-FATAL ERROR.          AFB0912
*     ELSE, IF Y IS NEGATIVE, THIS IS A PUT, AND WE CAN SET FUNCT TO     AFB0912
*     1 IMMEDIATELY, AND CALL ZIPMIP TO DO THE MIP WORK IF ANY.          AFB0912
*     IF Y IS POSITIVE, BLOCK Y RECORD Z IS THE RECORD TO BE             AFB0912
*     REPLACED. WE SHALL EITHER REPLACE IT SIMPLY, OR DELETE IT AND      AFB0912
*     PUT THE NEW ONE IN ANOTHER BLOCK. SO LOCATE THE RECORD, WHICH      AFB0912
*     IS NEEDED FOR MIP IF ANY AS WELL AS FOR THE REPLACEMENT, AND       AFB0912
*     CALL ZIPMIP FOR THE MIP WORK.                                      AFB0912
*     IF X = Y, A SIMPLE REPLACE, SO SET FUNCT = 0 TO INFORM ADRC$AA.    AFB0912
*     OTHERWISE CALL BOSKY TO DELETE THE OLD RECORD AND SET FUNCT=1      AFB0912
*     FOR LATER INSERTION OF THE NEW RECORD.                             AFB0912
 #                                                                       AFB0912
          IF FIXHOLD[0] NQ 0 THEN UNFX$AA ( 0 ) ;                        NRODDA 
          IF Y EQ 0                                                      NRODDA 
            THEN BEGIN                                                   NRODDA 
              MSGZ$AA ( EC445 ) ; #NO MATCH FOR REPLACE#                 NRODDA 
              RETURN ;                                                   NRODDA 
            END                                                          NRODDA 
          IF Y LS 0                                                      NRODDA 
            THEN BEGIN # PUT #                                           NRODDA 
              ZIPMIP ;                                                   NRODDA 
              IF RHO NQ 0 THEN RETURN;
              FUNCT = 1 ;                                                NRODDA 
            END                                                          NRODDA 
            ELSE BEGIN  #REPLACE #                                       NRODDA 
              PTCURBLK[0] = Y ;                                          NRODDA 
              PTCUREC[0] = Z ;                                           NRODDA 
              CURR$AA ;                                                  NRODDA 
              ZIPMIP ;                                                   NRODDA 
              IF RHO NQ 0 THEN RETURN;
              IF X EQ Y                                                  NRODDA 
                THEN FUNCT = 0 ;                                         NRODDA 
                ELSE BEGIN                                               NRODDA 
                  SLOG$AA ;                                             019700
                  BOSKY ;                                                NRODDA 
                  FUNCT = 1 ;                                            NRODDA 
                END                                                      NRODDA 
            END                                                          NRODDA 
 #                                                                       AFB0912
*     NOW WE HAVE TO DO A REPLACE (FUNCT=0) OR AN INSERTION (FUNCT=1).   AFB0912
*     AN ORIGINAL REPLACE MAY HAVE TURNED INTO AN INSERT. IF SO, THE     AFB0912
*     CORRESPONDING DELETE HAS ALREADY HAPPENED. IF THE CALLER INTENDED  AFB0912
*     A REPLACE BY A RECORD OF EQUAL SIZE, WE MUST NOW HAVE              AFB1109
*     FUNCT = 0.THEREFORE IF FUNCT = 1, POSITION FOR PRIMARY KEY         AFB0912
*     GETNEXT IS OFFICIALLY LOST. FUNCT MAY BE 0, BUT TO MAINTAIN THE    AFB0912
*     MAJESTY OF THE LAW WE DECLARE THE SAME IF THE NEW RECORD IS        AFB0912
*     LONGER OR SHORTER THAN THE OLD ONE. THE DECLARATION IS BY          AFB1109
*     SETTING THE SECOND WORD OF THE PTREE TO 1, UNLESS IT CONTAINS      AFB1109
*     0 (FOR REWOUND). THIS IS DONE BY SUBROUTINE VOID.                  AFB1109
 #                                                                       AFB0912
          IF FUNCT NQ 0 OR (NEWLNG+10*OUTKEY) NQ 10*RECLNG-UCCFIELD 
            THEN VOID ( 0 , 1 ) ;                                        AFB1109
                                                                         NRODDA 
 #                                                                       AFB0912
*     IF X IS 0 THERE WAS NO ROOM FOR THE NEW RECORD, SO WE CALL         AFB0912
*     ADNU$DA TO USE IMAGINATION OR FORCE. GAMMA IS HOME BLOCK,          AFB0912
*     ALPHA IS LAST BLOCK IN CHAIN, ETA IS PREDECESSOR OF ALPHA.         AFB0912
*     ADNU$DA PUTS THE NUMBER OF THE NEW BLOCK IN NEWBNUM, AND           AFB0912
*     WE SET X TO THIS.                                                  AFB0912
*     NOW IF FUNCT IS 0, WE HAVE A SIMPLE REPLACE, AND THE RECORD TO     AFB0912
*     BE REPLACED IS ALREADY IN CORE AND ADDRESSED BY THE FIRST          AFB0912
*     WORD OF THE PTREE. IF NOT, X IS THE BLOCK TO BE INSERTED IN,       AFB0912
*     WE SET UP THE FIRST WORD OF THE PTREE AND LOOK AT THE BLOCK        AFB0912
*     (ACTUALLY IT IS ALREADY IN CORE). IF IT IS NOT EMPTY, CALL         AFB0912
*     BNCH$AA TO SET SMALREC TO THE NUMBER OF THE RECORD AFTER           AFB0912
*     WHICH IT SHOULD BE INSERTED (WE KNOW THERE IS NO MATCH).           AFB0912
*     THEN CALL LOCR$AA TO SET RECFWA TO THE ADDRESS JUST BEFORE         AFB0912
*     WHICH THE NEW RECORD SHOULD BE INSERTED.                           AFB0912
 #                                                                       AFB0912
          IF X EQ 0                                                      NRODDA 
            THEN BEGIN                                                   NRODDA 
              SLOG$AA ;                                                 019900
              ADNUDDA ( ALPHA , GAMMA , ETA ) ;                          GAG0811
              X = NEWBNUM ;                                              NRODDA 
            END                                                          NRODDA 
          IF FUNCT NQ 0                                                  NRODDA 
            THEN BEGIN                                                   NRODDA 
              PTCURBLK[0] = X ;                                          NRODDA 
              SEBL$AA ( 0 , 1 ) ;                                        NRODDA 
              IF RC NQ 0                                                 NRODDA 
                THEN BEGIN                                               NRODDA 
                  IF ANYDEAD NQ 0 THEN CONS$AA ;                         AFB1114
                  BNCH$AA ;                                              NRODDA 
                  LOCR$AA ( SMALREC+1 ) ;                                NRODDA 
                    #WILL SET RECFWA OK,                                 NRODDA 
                     BUT RECLWA AND RECLNG MAY BE PHONY #                NRODDA 
                END                                                      NRODDA 
            END                                                          NRODDA 
 #                                                                       AFB0912
*     SET BARREN TO 0, SO THAT THE RECORD POINTER WILL NOT CONTAIN       AFB0912
*     A SUBFILE FLAG. CALL CONS$AA TO SQUEEZE OUT DEAD RECORDS IF        AFB0912
*     THERE ARE ANY, UNLESS THE NEW RECORD IS                            AFB1114
*     THE SAME SIZE, IN WHICH CASE                                       AFB1114
*     WE ESCHEW THE SQUEEZING TO PRESERVE GETNEXT POSITION IN THE        AFB0912
*     SECOND WORD OF THE PTREE, IF ANY, ALTHOUGH SQUEEZING RIGHT         AFB0912
*     AWAY WOULD PROBABLY BE THE MOST ECONOMICAL OF CP TIME IF A         AFB0912
*     LOT OF THIS GOES ON. THEN CALL ADRC$AA TO PUT THE NEW RECORD       AFB0912
*     IN AT CURRENT POSITION.                                            AFB0912
 #                                                                       AFB0912
          BARREN = 0 ;                                                   NRODDA 
          IF ANYDEAD NQ 0 AND RECLNG NQ ( WLG(NEWLNG)+OUTKEY )
            THEN BEGIN                                                   NRODDA 
              CONS$AA ;                                                  NRODDA 
            END                                                          NRODDA 
          ADRC$AA ;                                                      NRODDA 
 #                                                                       AFB0912
*     FINALLY, ADJUST VARIOUS COUNTS. ALSO, IF THE BLOCK INTO WHICH      AFB0912
*     WE PUT IS NOT A HOME BLOCK, SET THE UNIFORM RECORD FLAG TO 0.      AFB0912
*     ONLY NECESSARY IF THE BLOCK NOW HOLDS JUST ONE RECORD, BUT THEN    AFB0912
*     SUFFICIENT TO PREVENT UNIFORMITY FOR EVER AFTER. IF THE BLOCK IS   AFB0912
*     UNIFORM, IT BECOMES TOO DIFFICULT TO DECIDE WHETHER A GROUP OF     AFB0912
*     ONE OR MORE RECORDS CAN FIT INTO IT SOME TIME IN THE FUTURE, WHEN  AFB0912
*     WE ARE SHUFFLING A GROUP OUT OF A TERMINAL BLOCK. SO ONLY HOME     AFB0912
*     BLOCKS ARE ALLOWED TO BE UNIFORM.                                  AFB0912
*     IF THE BLOCK IS A TERMINAL BLOCK, CALL METB$DA TO UPDATE THE       AFB0912
*     MOST-EMPTY TABLE ACCORDING TO THIS CHANGE IN ITS EMPTINESS.        AFB0912
 #                                                                       AFB0912
          RECCNT = RECCNT + FUNCT ;                                      NRODDA 
          IF Y LS 0                                                      NRODDA 
            THEN FSPUTCNT[0] = FSPUTCNT[0] + 1 ;                         NRODDA 
            ELSE FSREPCNT[0] = FSREPCNT[0] + 1 ;                         NRODDA 
          IF X NQ GAMMA                                                  NRODDA 
            THEN BEGIN #NOT HOME BLOCK#                                  NRODDA 
              FSORCNT[0] = FSORCNT + FUNCT ;                             NRODDA 
              UR = 0 ;                                                   NRODDA 
              IF FWD EQ 0 THEN METB$DA ; #TERMINAL BLOCK#                NRODDA 
            END                                                          NRODDA 
          END                                                            NRODDA 
CONTROL EJECT ;                                                          AFB0912
 #                                                                       AFB0912
* *   UPFINDA - SET KEY POINTERS FOR PUT/REPLACE         PAGE 1          AFB0912
* *   A.F.R.BROWN                                                        AFB0912
* 1DC UPFINDA                                                            AFB0912
*                                                                        AFB0912
* DC  FUNCTION                                                           AFB0912
*                                                                        AFB0912
*     TO SET KEYFWA, KEYOFF, MAJKEY AND QREL AT THE BEGINNING OF         AFB0912
*     A PUT OR REPLACE.                                                  AFB0912
*                                                                        AFB0912
* DC  ENTRY CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     OUTKEY = 0 IF RECORDS IN THIS FILE HAVE EMBEDDED KEYS,             AFB0912
*       OTHERWISE NOT.                                                   AFB0912
*     WSA IN THE FIT IS THE FWA OF THE RECORD TO BE PUT OR               AFB0912
*       SUBSTITUTED IN THE FILE.                                         AFB0912
*     FSKEYLOC AND FSKEYPOS GIVE THE OFFSET OF THE PRIMARY KEY           AFB0912
*       WITHIN ANY RECORD, IF KEYS ARE EMBEDDED.                         AFB0912
*     KLENG IS A NAME FOR A FIELD OF THE FSTT GIVING THE LENGTH          AFB0912
*       OF THE PRIMARY KEY IN CHARACTERS.                                AFB0912
*     KA AND KP IN THE FIT POINT TO THE START OF THE KEY IF IT           AFB0912
*       IS NON-EMBEDDED.                                                 AFB0912
*                                                                        AFB0912
* DC  EXIT CONDITIONS                                                    AFB0912
*                                                                        AFB0912
*     KEYFWA AND KEYOFF HAVE BEEN SET TO THE FWA AND STARTING            AFB0912
*       CHARACTER POSITION OF THE KEY.                                   AFB0912
*     QREL HAS BEEN SET SO THAT BNCH$AA WILL LOOK FOR EQUALITY,          AFB0912
*       WHICH IS THE ONLY SIGNIFICANT KEY RELATION HERE.                 AFB0912
*     MAJKEY HAS BEEN SET TO THE PRIMARY KEY LENGTH IN CHARACTERS.       AFB0912
*                                                                        AFB0912
* DC  ERROR CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     NONE                                                               AFB0912
*                                                                        AFB0912
* DC  CALLED ROUTINES                                                    AFB0912
*                                                                        AFB0912
*     KPTR$DA - TO DO ALL THE WORK IF THE KEY IS NON-EMBEDDED.           AFB0912
*                                                                        AFB0912
* DC  NON-LOCAL VARIABLES                                                AFB0912
*                                                                        AFB0912
*     ONLY THOSE MENTIONED IN ENTRY AND EXIT CONDITIONS.                 AFB0912
*                                                                        AFB0912
 #                                                                       AFB0912
                                                                         NRODDA 
     PROC UPFINDA ; BEGIN                                                NRODDA 
          IF OUTKEY NQ 0                                                 NRODDA 
            THEN KPTR$DA ;                                               NRODDA 
            ELSE BEGIN                                                   NRODDA 
              KEYFWA = FTWSA[0] + FSKEYLOC[0] ;                          NRODDA 
              KEYOFF = FSKEYPOS[0] ;                                     NRODDA 
              QREL = REL"EQ" ;                                           NRODDA 
              MAJKEY = KLENG ;                                           NRODDA 
            END                                                          NRODDA 
          END                                                            NRODDA 
CONTROL EJECT ;                                                          AFB0912
 #                                                                       AFB0912
* *   VOID - MARK POSITION DISTURBED IN A SET OF FIATS      PAGE 1       AFB0912
* *   A.F.R.BROWN                                                        AFB0912
* 1DC VOID                                                               AFB0912
*                                                                        AFB0912
* DC  FUNCTION                                                           AFB0912
*                                                                        AFB0912
*     TO ADJUST THE FIAT OR PTREE CONNECTED WITH EVERY FIT THAT POINTS   AFB1109
*     TO THIS FILE, WHEN AN UPDATE OF THE FILE WOULD DISTURB OR DESTROY  AFB1109
*     GETNEXT-POSITION.                                                  AFB1109
*                                                                        AFB1109
* DC  ENTRY CONDITIONS                                                   AFB1109
*                                                                        AFB1109
*     P<FSTT$AA> POINTS TO THE FSTT OF THE CURRENT DA FILE.              AFB1109
*                                                                        AFB1109
*     THERE ARE TWO INCOMING PARAMETERS --                               AFB1109
*     (1) THE ADDRESS OF THE FSTT IN QUESTION, MINUS P<FSTT$AA>. THIS    AFB1109
*     IS MOST OFTEN 0, FOR THE DA FILE FSTT, BUT IN ONE CALL TO VOID     AFB1109
*     IT POINTS TO THE MIP FILE FSTT. IT IS POSSIBLE THAT THERE          AFB1109
*     COULD BE ONE OR MORE FITS THAT WERE ACCESSING THE FILE BY          AFB1109
*     INDEX-ONLY, AND WERE CHAINED OFF THE MIP FILE FSTT, AND ANY        AFB1109
*     POSITIONS THEY RECORD WOULD HAVE TO BE RE-ESTABLISHED AFTER        AFB1109
*     AN UPDATE OF THE FILE.                                             AFB1109
*                                                                        AFB1109
*     (2) THE SECOND PARAMETER IS 0 WHEN THE CALLER WANTS FASEEKEY1      AFB1109
*     TO BE SET 0 AND FAALTPOS TO BE SET 1, INDICATING THAT ANY          AFB1109
*     SEEK OR GETNEXT POSITION BY ALTERNATE KEY WOULD HAVE TO BE         AFB1109
*     REESTABLISHED BY KEY VALUE. (PRIMARY KEY SEEK AND GETNEXT IN       AFB1109
*     A DA FILE DO NOT WORK AS THEY WOULD IN AN IS FILE, AND THESE       AFB1109
*     TWO FIAT BITS ARE IRRELEVANT.) THIS IS DONE BEFORE EVERY UPDATE.   AFB1109
*         THE SECOND PARAMETER IS 1 WHEN THE CALLER WANTS PTREEWRD[1]    AFB1109
*     TO BE SET TO 1 UNLESS IT IS NOW 0, INDICATING THAT CURRENT         AFB1109
*     GETNEXT-POSITION, UNLESS REWOUND, HAS BEEN DESTROYED. THIS IS      AFB1109
*     DONE DURING ANY UPDATE EXCEPT A DELETE OR A REPLACE BY A RECORD    AFB1109
*     OF EQUAL LENGTH.                                                   AFB1109
*         THE SECOND PARAMETER IS -1 WHEN THE CALLER WANTS THE RECORD    AFB1109
*     NUMBER IN PTREEWRD[1] TO BE REDUCED BY 1, IF IT POINTS TO THE      AFB1109
*     RECORD THAT HAS JUST BEEN DELETED, OR A LATER RECORD IN THE SAME   AFB1109
*     BLOCK. THIS IS DONE WHEN A RECORD IN A UNIFORM BLOCK, BUT NOT THE  AFB1109
*     LAST RECORD, HAS BEEN DELETED.                                     AFB1109
*                                                                        AFB1109
* DC  ERROR CONDITIONS                                                   AFB1109
*                                                                        AFB1109
*     NONE                                                               AFB1109
*                                                                        AFB1109
* DC  CALLED ROUTINES                                                    AFB1109
*                                                                        AFB1109
*     NONE                                                               AFB1109
*                                                                        AFB1109
* DC  NON-LOCAL VARIABLES                                                AFB1109
*                                                                        AFB1109
*     NONE                                                               AFB1109
*                                                                        AFB1109
 #                                                                       AFB1109
                                                                         AFB1109
      PROC VOID ( P , Q ) ;                                              AFB1109
          BEGIN                                                          AFB1109
          ITEM P , Q , I , J ;                                           AFB1109
                                                                         AFB1109
          FOR I = FSFTCHN[P] WHILE I NQ 0                                AFB1109
          DO                                                             AFB1109
              BEGIN                                                      AFB1109
              I = I - P<FIT$AA> ;                                        AFB1109
              J = FTFIAT[I] - P<FIAT$AA> ;                               AFB1109
              IF Q NQ 0                                                  AFB1109
              THEN                                                       AFB1109
                  BEGIN                                                  AFB1109
                  J = FADPTRADR[J] - P<PTRE$AA> ;                        AFB1109
                  IF Q GR 0                                              AFB1109
                  THEN                                                   AFB1109
                      BEGIN                                              AFB1109
                      IF PTREEWRD[J+1] NQ 0                              AFB1109
                      THEN                                               AFB1109
                          BEGIN                                          AFB1109
                          PTREEWRD[J+1] = 1 ;                            AFB1109
                          END                                            AFB1109
                      END                                                AFB1109
                  ELSE                                                   AFB1109
                      BEGIN                                              AFB1109
                      IF PTCURBLK[J+1] EQ BLOCKID[0]                     AFB1109
                        AND PTCUREC[J+1] GQ PTCUREC[0]                   AFB1109
                      THEN                                               AFB1109
                          BEGIN                                          AFB1109
                          PTCUREC[J+1] = PTCUREC[J+1] - 1 ;              AFB1109
                          END                                            AFB1109
                      END                                                AFB1109
                  END                                                    AFB1109
              ELSE                                                       AFB1109
                  BEGIN                                                  AFB1109
                  FASEEKEY1[J] = 0 ;                                     AFB1109
                  FAALTPOS[J] = 1 ;                                      AFB1109
                  END                                                    AFB1109
              I = FTFTCH[I] ;                                            AFB1109
              END                                                        AFB1109
          END                                                            AFB1109
CONTROL EJECT ;                                                          AFB0912
 #                                                                       AFB0912
* *   XMET$DA - DELETE A BLOCK FROM THE MOST-EMPTY TABLE   PAGE 1        AFB0912
* *   A.F.R.BROWN                                                        AFB0912
* 1DC XMET$DA                                                            AFB0912
*                                                                        AFB0912
* DC  FUNCTION                                                           AFB0912
*                                                                        AFB0912
*     TO REMOVE A BLOCK FROM THE MOST-EMPTY TABLE OF THE CURRENT         AFB0912
*     DA FILE. THIS IS DONE WHEN A TERMINAL BLOCK TURNS INTO A           AFB0912
*     MEMBER BLOCK IN AN OVERFLOW CHAIN, BECAUSE ONLY TERMINAL           AFB0912
*     BLOCKS ARE SUPPOSED TO APPEAR IN THE MOST-EMPTY TABLE.             AFB0912
*                                                                        AFB0912
* DC  ENTRY CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     SAME AS FOR METB$DA                                                AFB0912
*                                                                        AFB0912
* DC  EXIT CONDITIONS                                                    AFB0912
*                                                                        AFB0912
*     IF THERE WAS AN ENTRY FOR THE CURRENT BLOCK IN THE MOST-           AFB0912
*     EMPTY TABLE, IT HAS BEEN REPLACED BY A ZERO WORD.                  AFB0912
*                                                                        AFB0912
* DC  ERROR CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     NONE                                                               AFB0912
*                                                                        AFB0912
* DC  CALLED ROUTINES                                                    AFB0912
*                                                                        AFB0912
*     NONE                                                               AFB0912
*                                                                        AFB0912
* DC  NON-LOCAL VARIABLES                                                AFB0912
*                                                                        AFB0912
*     NONE                                                               AFB0912
*                                                                        AFB0912
 #                                                                       AFB0912
                                                                         NRODDA 
     PROC XMET$DA ; BEGIN                                                NRODDA 
          J = BLOCKID[0] ;                                               NRODDA 
          FOR I = 0 STEP 1 UNTIL DFMETLG-1                               NRODDA 
            DO BEGIN                                                     NRODDA 
              IF FSMTPRU[I] EQ J                                         NRODDA 
                THEN BEGIN                                               NRODDA 
                  FSEMPLIST[I] = 0 ;                                     NRODDA 
                  RETURN ;                                               NRODDA 
                END                                                      NRODDA 
            END                                                          NRODDA 
          END                                                            NRODDA 
CONTROL EJECT ;                                                          AFB0912
 #                                                                       AFB0912
* *   ZIPMIP - CALL REPL$MP OR PUT$MP IF NECESSARY        PAGE 1         AFB0912
* *   A.F.R.BROWN                                                        AFB0912
* 1DC ZIPMIP                                                             AFB0912
*                                                                        AFB0912
* DC  FUNCTION                                                           AFB0912
*                                                                        AFB0912
*     TO CALL REPL$MP OR PUT$MP WHILE DOING A PUT OR REPLACE IN          AFB0912
*     A DA FILE, IF IT HAS AN ASSOCIATED MIP FILE. WE MAKE A             AFB0912
*     SUBROUTINE OUT OF THIS, AND CALL IT AT TWO POINTS IN THE           AFB0912
*     COMBINED DA PUT/REPL ROUTINE, INSTEAD OF JUST CALLING              AFB0912
*     PUT$MP AT ONE POINT AND REPL$MP AT THE OTHER,BECAUSE OF            AFB0912
*     THE ADDITIONAL CALLS, AND THE POINTER SAVING AND RESTORING,        AFB0912
*     WHICH CAN BE CODED ONCE IN ZIPMIP, INSTEAD OF ONCE WITH THE        AFB0912
*     PUT$MP CALL AND ONCE WITH THE REPL$MP CALL.                        AFB0912
*                                                                        AFB0912
* DC  ENTRY CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     SEE THE ENTRY CONDITIONS FOR SUBROUTINE DLT$MP, WHICH              AFB0912
*     INCLUDES ENTRY POINTS PUT$MP AND REPL$MP.                          AFB0912
*                                                                        AFB0912
*     HOWEVER, IF THERE IS NO MIP FILE, THE ENTRY CONDITIONS             AFB0912
*     DO NOT MATTER.                                                     AFB0912
*                                                                        AFB0912
* DC  EXIT CONDITIONS                                                    AFB0912
*                                                                        AFB0912
*     IF THERE IS NO MIP FILE, NOTHING HAS CHANGED.                      AFB0912
*                                                                        AFB0912
*     OTHERWISE, SEE THE EXIT CONDITIONS FOR SUBROUTINE DLT$MP.          AFB0912
*     IN ADDITION, IF WE EXIT NORMALLY FROM ZIPMIP, RHO IS 0,            AFB0912
*     INDICATING SUCCESS IN THE MIP OPERATION, AND KEYFWA,               AFB0912
*     KEYOFF, NEWFWA, AND NEWLNG HAVE BEEN RESTORED, AND                 AFB0912
*     NRECINS SET TO 1.                                                  AFB0912
*                                                                        AFB0912
*     RECFWA, RECLWA AND RECLNG ARE LEFT UNCHANGED, BECAUSE              AFB0912
*     THEY ARE NOT TOUCHED BEFORE CALLING DLT$MP, AND DLT$MP             AFB0912
*     RESTORES THEM AS ITS LAST ACT.                                     AFB0912
*                                                                        AFB0912
*     DLT$MP SETS AND USES KEYFWA, KEYOFF, NEWFWA, NEWLNG                AFB0912
*     AND NRECINS BECAUSE IT DOES VARIOUS UPDATES IN THE MIP             AFB0912
*     FILE, AND BECAUSE THEY HAVE ALREADY BEEN SET WHEN                  AFB0912
*     ZIPMIP IS CALLED, WE HAVE TO SAVE AND RESTORE THEM IN              AFB0912
*     ZIPMIP. THIS IS NOT SO IN THE CORRESPONDING I-S                    AFB0912
*     PROGRAMS (SUBROUTINES PUT$IS AND REPL$IS) BECAUSE THERE,           AFB0912
*     CMRC$AA NEED NOT BE CALLED UNTIL AFTER WE ARE THROUGH              AFB0912
*     WITH THE MIP OPERATIONS. BUT HERE CMRC$AA, WHICH SETS              AFB0912
*     THESE THINGS, HAD TO BE CALLED EARLY, BEFORE ZIPMIP.               AFB0912
*     WHY -- BECAUSE, IF THIS IS A REPLACE, WE WANT TO SCAN THE          AFB0912
*     CHAIN OF BLOCKS JUST ONCE BOTH TO FIND THE OLD RECORD AND          AFB0912
*     TO FIND SPACE FOR THE NEW RECORD. TO FIND SPACE, WE MUST           AFB0912
*     KNOW THE LENGTH OF THE COMPRESSED RECORD, AS FURNISHED BY          AFB0912
*     CMRC$AA. IN AN I-S FILE REPLACE, IN CONTRAST, WE JUST NEED         AFB0912
*     TO LOCATE THE OLD RECORD BEFORE DOING THE MIP WORK, AND            AFB0912
*     THE COMPRESSED LENGTH IS NOT NECESSARY FOR THAT.                   AFB0912
*     HOWEVER -- IF REPL$MP IS CALLED, THE OLD RECORD IS DECOMPRESSED 
*     INTO THE COMPRESSION BUFFER, OVERWRITING THE COMPRESSED NEW RECORD
*     THAT IS WAITING TO BE PUT INTO THE FILE. SO CMRC$AA HAS TO BE 
*     CALLED AGAIN TO RESTORE THE COMPRESSED NEW RECORD.
*                                                                        AFB0912
* DC  ERROR CONDITIONS                                                   AFB0912
*                                                                        AFB0912
*     EC503 - THE PUT OR REPLACE CANNOT BE DONE BECAUSE IT               AFB0912
*       WOULD PUT A FORBIDDEN DUPLICATE ALTERNATE KEY VALUE              AFB0912
*       INTO THE MIP FILE.                                               AFB0912
*                                                                        AFB0912
* DC  CALLED ROUTINES                                                    AFB0912
*                                                                        AFB0912
*     QUMP$AA - TO DECIDE WHETHER ANY MIP WORK IS TO BE DONE.            AFB0912
*     REPL$MP - TO DO THE MIP PART OF A REPLACE.                         AFB0912
*     PUT$MP - TO DO THE MIP PART OF A PUT.                              AFB0912
*     UPFINDA - TO RESTORE KEYFWA AND KEYOFF.                            AFB0912
*     CMRC$AA - TO RESTORE THE COMPRESSED NEW RECORD, IN THE COMPRESSION
*       BUFFER, WHEN IT HAS BEEN OVERWRITTEN WITH THE DECOMPRESSED
*       OLD RECORD. 
*                                                                        AFB0912
* DC  NON-LOCAL VARIABLES                                                AFB0912
*                                                                        AFB0912
*     ONLY THOSE MENTIONED UNDER ENTRY AND EXIT CONDITIONS.              AFB0912
*                                                                        AFB0912
 #                                                                       AFB0912
                                                                         NRODDA 
     PROC ZIPMIP ; BEGIN ITEM NF , NL ;                                  NRODDA 
          IF QUMP$AA ( 1 ) NQ 0                                          NRODDA 
            THEN BEGIN                                                   NRODDA 
              NF = NEWFWA ;                                              NRODDA 
              NL = NEWLNG ;                                              NRODDA 
              IF FTCOP[0] EQ OP"RPL"                                     NRODDA 
                THEN BEGIN
                  REPL$MP;
                  CMRC$AA;
                END 
                ELSE PUT$MP ;                                            NRODDA 
              IF RHO NQ 0                                                NRODDA 
                THEN BEGIN                                               NRODDA 
                  RETURN; 
                END                                                      NRODDA 
              UPFINDA ; #RESTORE KEYFWA AND KEYOFF#                      NRODDA 
              NRECINS = 1 ;                                              NRODDA 
              NEWFWA = NF ;                                              NRODDA 
              NEWLNG = NL ;                                              NRODDA 
            END                                                          NRODDA 
          END                                                            NRODDA 
                                                                         NRODDA 
      END   TERM                                                         NRODDA 
