*DECK,ISDRARE 
*CALL COMUSETXT 
PROC IS$RARE; 
      BEGIN 
                                                                         ISRAR
     XREF BEGIN                                                          ISRAR
          PROC MUVW$AA ;                                                 ISRAR
          PROC MOVW$AA ;                                                 ISRAR
          PROC IMPR$AA; 
          FUNC LWAD$AA ;                                                 ISRAR
          PROC RPPT$AA ;                                                 ISRAR
          PROC RPGT$AA ;                                                 ISRAR
          PROC NUBL$AA ;                                                 ISRAR
          PROC UNFX$AA ;                                                 ISRAR
          PROC FIXX$AA ;                                                 ISRAR
          PROC SETR$AA ;                                                 ISRAR
          PROC STUP$IS ;                                                 ISRAR
          PROC DELL$AA ;                                                 ISRAR
          PROC STDN$IS ;                                                 ISRAR
          PROC STOV$AA ;                                                 ISRAR
          PROC SEBL$AA ;                                                 ISRAR
          PROC TROW$AA ;                                                 ISRAR
          PROC HAWK$AA ;                                                 ISRAR
          PROC KYSV$IS ;                                                 ISRAR
          PROC WRLB$AA ;                                                 ISRAR
          PROC ALTR$AA ;                                                 ISRAR
          PROC IOWR$AA ;                                                 ISRAR
          PROC LOCB$AA;                                                  AFB1215
          PROC MSGZ$AA;                                                  JJJ0721
          LABEL EXIT$AA;                                                 JJJ0721
          PROC EXRP$AA ;
          END                                                            ISRAR
                                                                         ISRAR
     XDEF BEGIN                                                          ISRAR
          PROC SPLT$IS ;                                                 ISRAR
          PROC VANB$IS ;                                                 ISRAR
          PROC AWAY$IS ;                                                 ISRAR
          PROC WNOW$IS ;                                                 ISRAR
          END                                                            ISRAR
                                                                         ISRAR
                                                                         ISRAR
                                                                         ISRARMO
          ITEM SPLTCNT;      #PARAMETER BETWEEN SPLT$IS AND WNOW$IS#     ISRARMO
          ITEM IX;           #USED AS INDUCTION VARIABLE#                ISRARMO
CONTROL EJECT;                                                           ID0913 
PROC AWAY$IS;                                                            ID0913 
          BEGIN                                                          ID0913 
                                                                         ID0913 
 #                                                                       ID0913 
* *   AWAY$IS - PUT A BLOCK ONTO THE EMPTY CHAIN         PAGE  1         JJJ0916
* *   A.F.R.BROWN                                                        ID0913 
* 1DC AWAY$IS                                                            ID0913 
*                                                                        ID0913 
* DC  FUNCTION                                                           ID0913 
*                                                                        ID0913 
*     TO TAKE THE CURRENT BLOCK AND ADD IT TO THE EMPTY CHAIN, AFTER     ID0913 
*     ALTERING IT SO THAT IT WILL APPEAR PROPERLY EMPTY IF IT IS LATER   ID0913 
*     REMOVED FROM THE EMPTY CHAIN FOR RE-USE. NOTE THAT THIS AFFECTS    ID0913 
*     ONLY THE CURRENT BLOCK, AND DOES NOT TAKE CARE OF POINTERS INTO    ID0913 
*     THE CURRENT BLOCK THAT WILL HAVE TO BE ALTERED, NOR OF MAKING      ID0913 
*     SOME OTHER BLOCK CURRENT IMMEDIATELY.                              ID0913 
*                                                                        ID0913 
* DC  ENTRY CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     THE CURRENT BLOCK MUST BE IN CORE, AND MUST CONTAIN NO USEFUL      ID0913 
*     INFORMATION.                                                       ID0913 
*                                                                        ID0913 
* DC  EXIT CONDITIONS                                                    ID0913 
*                                                                        ID0913 
*     THE CURRENT BLOCK HAS BEEN MOVED TO THE EMPTY CHAIN AS DESCRIBED   ID0913 
*     ABOVE. IT IS NECESSARY TO DO SOMETHING IMMEDIATELY TO MAKE SOME    ID0913 
*     LIVE BLOCK CURRENT ETC.                                            ID0913 
*                                                                        ID0913 
*     FSBLKCNT HAS BEEN UPDATED.                                         CIM0718
*                                                                        CIM0718
* DC  ERROR CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
* DC  CALLED ROUTINES                                                    ID0913 
*                                                                        ID0913 
*     ALTR$AA - TO DO THE PROPER FORMALITIES BEFORE ALTERING A BLOCK     ID0913 
*       IMAGE. WHEN, FOR INSTANCE, THE ONLY RECORD IN A BLOCK IS TO BE   ID0913 
*       DELETED, THE STRAIGHTFORWARD SERIES OF EVENTS WOULD BE TO CALL   ID0913 
*       ALTR$AA FOR THE FORMALITIES, THEN CALL DELL$AA TO SQUEEZE OUT    ID0913 
*       THE RECORD, THEN CALL AWAY$IS TO GET RID OF THE NOW-EMPTY        ID0913 
*       BLOCK. BUT AS THE DELL$AA CALL IS SUPERFLUOUS, WE OMIT IT AND    ID0913 
*       MOVE THE ALTR$AA CALL INTO AWAY$IS.                              ID0913 
*                                                                        ID0913 
* DC  NON-LOCAL VARIABLES                                                ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
 #                                                                       ID0913 
                                                                         ID0913 
                             #START OF AWAY$IS CODE#                     ID0913 
          ALTR$AA ;                                                      VBG1216
          RC = 0 ;                                                       ISRAR
          EC = MAXMT ;                                                   ISRAR
          FWD = FSMTBPRU[0] ;                                            ISRAR
          BLCIP[0] = 0 ;
          FSMTBPRU[0] = BLOCKID[0];                                      ISRARMO
          FSMTBCNT[0] = FSMTBCNT[0] + 1;                                 JJJ0908
          FSBLKCNT = FSBLKCNT - 1 ;                                      CIM0718
          END                                                            ISRAR
CONTROL EJECT;                                                           ISRARMO
PROC DEL2;                                                               ID0913 
          BEGIN                                                          ID0913 
                                                                         ID0913 
 #                                                                       ID0913 
* *   DEL2 - SQUEEZE OUT A LEVEL OF INDEXING IN AN I-S FILE  PAGE 1      JJJ0916
* *   A.F.R.BROWN                                                        ID0913 
* 1DC DEL2                                                               ID0913 
*                                                                        ID0913 
* DC  FUNCTION                                                           ID0913 
*                                                                        ID0913 
*     TO DELETE THE PRIMARY INDEX BLOCK FROM A FILE, WHEN THE NUMBER OF  ID0913 
*     RECORDS IT CONTAINS COULD BE REDUCED TO 1, AND TO REDUCE THE       ID0913 
*     NUMBER OF LEVELS OF INDEXING BY 1. IF, AS MAY HAPPEN IN A PECULIAR ID0913 
*     CASE, THE LAST REMAINING RECORD OF THE PRIMARY INDEX BLOCK POINTED ID0913 
*     TO AN INDEX BLOCK THAT ITSELF CONTAINS ONLY ONE RECORD, THIS       ID0913 
*     LATTER BECOMES THE PRIMARY INDEX BLOCK, AND THE CYCLE HAS TO BE    ID0913 
*     REPEATED IMMEDIATELY, WITHIN DEL2.                                 ID0913 
*                                                                        ID0913 
* DC  ENTRY CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     THE PRIMARY INDEX BLOCK MUST BE IN CORE AND CONTAIN EXACTLY TWO    ID0913 
*     RECORDS, OF WHICH ONE IS NOW CURRENT AND SHOULD, ACCORDING TO THE  ID0913 
*     ORDINARY LOGIC OF DELETION IN AN I-S FILE, BE DELETED.             ID0913 
*                                                                        ID0913 
* DC  EXIT CONDITIONS                                                    ID0913 
*                                                                        ID0913 
*     THE PRIMARY INDEX BLOCK HAS BEEN EMPTIED AND MOVED TO THE          ID0913 
*     EMPTY CHAIN                                                        ID0913 
*                                                                        ID0913 
*     THE NUMBER OF LEVELS OF INDEXING IN THE FILE HAS BEEN REDUCED      ID0913 
*     BY ONE.                                                            ID0913 
*                                                                        ID0913 
*     THE DAUGHTER BLOCK OF THE PRIMARY INDEX RECORD THAT SHOULD,        ID0913 
*     ACCORDING TO THE ORDINARY LOGIC OF DELETION, HAVE REMAINED         ID0913 
*     IS NOW THE PRIMARY INDEX BLOCK, OR IF IT IS A DATA BLOCK, IT       ID0913 
*     IS THE FIRST AND ONLY DATA BLOCK. BUT IF IT WAS AN INDEX BLOCK     ID0913 
*     CONTAINING JUST ONE RECORD, WE WENT THROUGH THE CYCLE AGAIN.       ID0913 
*                                                                        ID0913 
* DC  ERROR CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     NONE - IF SOMETHING GOES WRONG HERE THE FILE IS TERRIBLY           ID0913 
*       ILL-FORMED OR THERE IS A GROSS DEFECT IN OUR LOGIC.              ID0913 
*                                                                        ID0913 
* DC  CALLED ROUTINES                                                    ID0913 
*                                                                        ID0913 
*     AWAY$IS - TO REMOVE THE OLD PRIMARY INDEX BLOCK TO THE             ID0913 
*       EMPTY CHAIN.                                                     ID0913 
*     SEBL$IS - TO MAKE THE SURVIVING DAUGHTER BLOCK CURRENT AND         ID0913 
*       GET IT INTO CORE.                                                ID0913 
*     SETR$AA - TO MAKE THE FIRST RECORD OF THAT BLOCK CURRENT.          ID0913 
*                                                                        ID0913 
* DC  NON-LOCAL VARIABLES                                                ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
 #                                                                       ID0913 
                                                                         ID0913 
                             #START OF DEL2 CODE#                        ID0913 
                                                                         AFB1215
          SETR$AA (1);                                                   JJJ1217
        DEL2A:                                                           ISRAR
          PTCURBLK[0] = INDEXPRU ;                                       ISRAR
          NLEV = NLEV - 1 ;                                              ISRAR
          AWAY$IS ;                                                      ISRAR
          SEBL$AA ( 0 , 1 ) ;                                            ISRAR
          IF NLEV NQ 0 AND RC EQ 1                                       ISRAR
            THEN BEGIN                                                   ISRAR
              SETR$AA ( 1 ) ;                                            ISRAR
              GOTO DEL2A ;                                               ISRAR
            END                                                          ISRAR
          PRBK = BLOCKID[0] ;                                            AFB1215
          IF NLEV EQ 0 THEN FIRDAT = PRBK ;                              ISRAR
          END                                                            ISRAR
CONTROL EJECT;                                                           ISRARMO
PROC SPLT$IS ((N));                                                      ISRARMO
          BEGIN                                                          ISRARMO
                                                                         ID0913 
 #                                                                       ID0913 
* *   SPLT$IS - SPLIT THE CURRENT BLOCK INTO TWO BLOCKS  PAGE  1         JJJ0916
* *   A.F.R.BROWN                                                        ID0913 
* 1DC SPLT$IS                                                            ID0913 
*                                                                        ID0913 
* DC  FUNCTION                                                           ID0913 
*                                                                        ID0913 
*     TO SPLIT THE CURRENT BLOCK BY GETTING A NEW BLOCK, INSERTING       ID0913 
*     IT IN THE FILE CHAIN RIGHT AFTER THE CURRENT BLOCK, AND COPYING    ID0913 
*     THE LAST N RECORDS OF THE CURRENT BLOCK INTO IT, WHERE N CAN       ID0913 
*     RANGE FROM 0 TO ALL THE RECORDS IN THE STARTING BLOCK.             ID0913 
*                                                                        ID0913 
* DC  ENTRY CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     ONE PARAMETER IS PASSED, IN THE NORMAL SYMPL FORMAT. THIS IS       ID0913 
*     THE RECORD NUMBER, WITHIN THE CURRENT BLOCK, OF THE FIRST RECORD   ID0913 
*     IN THE GROUP TO BE MOVED. IT CAN VARY FROM 1, MEANING THAT ALL     ID0913 
*     RECORDS FROM FIRST TO LAST WILL BE MOVED OUT, TO RC+1              ID0913 
*     (RC BEING THE COUNT OF RECORDS IN THE BLOCK), MEANING THAT NO      ID0913 
*     RECORDS SHOULD BE MOVED, THOUGH AN EMPTY NEW BLOCK IS STILL TO BE  ID0913 
*     OBTAINED AND INSERTED IN THE FILE. THUS A PARAMETER OF X IN        ID0913 
*     GENERAL MEANS THAT RECORDS X THROUGH RC ARE TO GO, WHILE RECORDS   ID0913 
*     1 THROUGH X-1 ARE TO STAY IN THE ORIGINAL BLOCK.                   ID0913 
*                                                                        ID0913 
*     THE CURRENT BLOCK MUST BE IN CORE, BUT THERE IS NO REQUIREMENT     ID0913 
*     ABOUT ANY PARTICULAR RECORD BEING CURRENT.                         ID0913 
*                                                                        ID0913 
* DC  EXIT CONDITIONS                                                    ID0913 
*                                                                        ID0913 
*     THE CURRENT BLOCK IS STILL CURRENT AND IN CORE. IT HAS BEEN        ID0913 
*     ALTERED TO REFLECT THE CHANGES THAT HAVE TAKEN PLACE, BUT THE      ID0913 
*     CURRENT RECORD NUMBER IN THE PTREE HAS NOT BEEN CHANGED, EVEN      ID0913 
*     THOUGH IT MIGHT POINT TO A RECORD THAT HAS GONE TO THE NEW         ID0913 
*     BLOCK.                                                             ID0913 
*                                                                        CY211
*     FWDCNT ALIAS PTFWCT[0] HAS BEEN SET TO 0. THIS NEGATES ANY         CY211
*     EXISTING TENDENCY TOWARD READ-AHEAD.                               CY211
*                                                                        ID0913 
* DC  ERROR CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     NONE ARE DETECTED IN THIS ROUTINE.                                 ID0913 
*                                                                        ID0913 
* DC  CALLED ROUTINES                                                    ID0913 
*                                                                        ID0913 
*     WRLB$AA - TO WRITE OUT FOR THE FIRST TIME THE PHYSICALLY LAST      ID0913 
*       BLOCK IN THE FILE, WHEN IT IS THE ONE BEING SPLIT AND THE        ID0913 
*       NUMBER OF RECORDS TO BE MOVED IS 0. THIS POINT IN SPLT$IS IS     ID0913 
*       WHERE NEW BLOCKS WOULD BE ADDED TO THE FILE, IF A LONG SERIES    ID0913 
*       OF CONSECUTIVE RECORDS WERE BEING ADDED TO THE END. AS THAT IS   ID0913 
*       A COMMON STATE OF AFFAIRS WHEN A FILE IS CREATED, WE SPECIAL-    ID0913 
*       CASE IT HERE.                                                    ID0913 
*     NUBL$AA - TO GET THE NEW BLOCK.                                    ID0913 
*     TROW$AA - TO SWITCH P<BLOK$AA> AND BLOCLWA FROM ONE BLOCK IMAGE    ID0913 
*       TO THE OTHER.                                                    ID0913 
*     ALTR$AA - TO DO THE FORMALITIES BEFORE ALTERING AN EXISTING        ID0913 
*       BLOCK IMAGE.                                                     ID0913 
*     MOVW$AA - TO MOVE A GROUP OF RECORDS FROM THE OLD BLOCK IMAGE      ID0913 
*       TO THE NEW BLOCK IMAGE.                                          ID0913 
*     RPGT$AA - TO FETCH A RECORD POINTER FROM THE OLD BLOCK IMAGE.      ID0913 
*     RPPT$AA - TO PUT A RECORD POINTER IN THE NEW BLOCK IMAGE.          ID0913 
*                                                                        ID0913 
* DC  NON-LOCAL VARIABLES                                                ID0913 
*                                                                        ID0913 
*     NEWBFWA - THE FWA OF THE BLOCK IMAGE PROVIDED BY NUBL$AA.          ID0913 
*     NEWBNUM - THE PRU NUMBER OF THAT BLOCK.                            ID0913 
*                                                                        ID0913 
 #                                                                       ID0913 
CONTROL EJECT;                                                           ID0913 
          ITEM N;            #FORMAL PARAMETER#                          ISRARMO
          ITEM NEWBL;        #TRICK TO AVOID REPOINTING BLOK$AA#         ISRARMO
          ITEM FWDLINK;      #FORWARD LINK#                              ISRARMO
          ITEM LW1, LW2;     #LWA OF RECORDS BEING MANIPULATED#          ISRARMO
          ITEM TEC;          #TEMP EC #                                  ISRARMO
                                                                         ID0913 
                             #START OF SPLT$IS CODE#                     ID0913 
          FWDCNT = 0 ;                                                  018900
          SPLTCNT = RC + 1 - N ; #COUNT OF RECORDS TO BE MOVED#          ISRAR
          NUBL$AA ( 1 ) ;                                                ISRAR
          TROW$AA ( 0 ) ; #RETURN TO STARTING BLOCK#                     ISRAR
          FWDLINK = FWD ;                                               014200
          ALTR$AA ;                                                     014300
          IF CURPTR EQ 0                                                014400
            THEN BEGIN                                                  014500
              NEWBL = FSMTBPRU[0] ;                                     014600
              IF NEWBL EQ 0                                             014700
                THEN BLPARENT[0] = NEWBNUM + FSBLKSIZ[0] ;              014800
                ELSE BLPARENT[0] = NEWBL ;                              014900
            END                                                         015000
          NEWBL = NEWBFWA - P<BLOK$AA> ;                                 ISRAR
          BLPARENT[NEWBL] = BLPARENT[0] ;                                ISRAR
          BLINDXFLG[NEWBL] = INDEXFLAG ;                                 ISRAR
          IF FWDLINK EQ 0 THEN LASTBNO = NEWBNUM ;                       ISRAR
          IF N EQ 1                                                      ISRAR
            THEN BEGIN #SWITCH BLOX INSTEAD OF COPYING#                  ISRAR
              BLOCKID[NEWBL] = BLOCKID[0] ;                              ISRAR
              BLOCKID[0] = NEWBNUM ;                                     ISRAR
              PTBLKIN[CURPTR] = 1 ;                                      ISRAR
              PTCURBADR[CURPTR] = NEWBFWA ;                              ISRAR
              BLPTRADR[NEWBL] = LOC(PTCURBADR[CURPTR]) ;
              BLPTRADR[0] = 0 ; 
              BLOCFWD[NEWBL] = NEWBNUM ;                                 ISRAR
              FIXHOLD[0] == FIXHOLD[1] ;                                 ISRAR
              TROW$AA ( 0 ) ; #SETS P<BLOK$AA> AND BLOCLWA#              ISRAR
              NEWBFWA = FIXHOLD[1] ;                                     ISRAR
      #THE FOLLOWING TESTS ARE NEEDED TO HANDLE THE PRU SWAP AND
       THE POSSIBILITY OF EXTENDING FILE BY MORE THAN 1 BLOCK.  THE 
       CODE LOOKS COMPLICATE, UT THE LOGIC IS THAT WHENEVER WE
       HAVE ENTENDED THE FILE BY MORE THAN ONE BLOCK, FSUNWR1 AND 
       FSUNWR2 CONTAIN POINTERS TO THE UNWRITTEN BLOCKS.  USUALLY 
       FSUNWR1 POINTS TO THE FIRST BLOCK, AND FSUNWR2 TO THE SECOND,
       SO WHEN IT COMES TIME TO WRITE, THE SHOULD BE WRITTEN IN THAT
       ORDER.  THE PRU SWITCHING SCHEME TO HANDLE GETTING OF NEW
       BLOCKS THROWS THIS OFF.  IF THERE IS ANY DOUBT, DRAW A PICTURE 
       OF THE DIFFERENT POSSIBILITIES OF FSUNWR1 AND FSUNWR2, AND THE 
       BLOCKS INVOLVED IN THE SPLIT, AND FOLLOW THE LOGIC THROUGH#
             IF P<BLOK$AA> EQ FSUNWR1[0]
             THEN BEGIN 
                  FSUNWR1[0] = NEWBFWA;#SWITCH FSUNWR1 DUE TO PRU SWAP# 
                  GOTO SPLAT;  #SKIP ONE CHECK# 
                  END 
             ELSE BEGIN 
                  IF NEWBFWA EQ FSUNWR1[0] THEN FSUNWR1[0]=P<BLOK$AA>;
                  END 
             IF P<BLOK$AA> EQ FSUNWR2[0]
             THEN BEGIN 
                  FSUNWR2[0] = NEWBFWA; 
                  END 
             ELSE BEGIN 
SPLAT:  
                  IF NEWBFWA EQ FSUNWR2[0]
                  THEN BEGIN
                       FSUNWR2[0] = P<BLOK$AA>; 
                       END
                  END 
            END                                                          ISRAR
            ELSE BEGIN                                                   ISRAR
              LW1 = LWAD$AA (N-1);                                       ISRARMO
              LW2 = LWAD$AA (RC);                                        ISRARMO
              MOVW$AA (LW1+BLOCFWA,LW2-LW1,NEWBFWA+DBLKOVHED) ;          CY211
              IF UR NQ 0                                                 ISRARMO
              THEN                                                       ISRARMO
                BEGIN                                                    ISRARMO
                W[NEWBFWA+BLKLG+DBLKFRAME-1] = RPWORD (1) ;              CY211
                END                                                      ISRARMO
              ELSE                                                       ISRARMO
                BEGIN                                                    ISRARMO
                FOR IX = N STEP 1 UNTIL RC                               ISRARMO
                  DO                                                     ISRARMO
                  BEGIN                                                  ISRARMO
                  RPGT$AA (IX);                                          ISRARMO
                  TROW$AA (1);                                           ISRARMO
                  LWAFIELD = LWAFIELD - LW1;                             ISRARMO
                  RPPT$AA (IX-N+1);                                      ISRARMO
                  TROW$AA (0);                                           ISRARMO
                  END                                                    ISRARMO
                END                                                      ISRARMO
              IF SPLTCNT NQ 0 THEN BLKUR[NEWBL] = UR ;                   RPN1209
              BLRECNT[NEWBL] = SPLTCNT ;                                 ISRAR
              TEC = MAXMT - 2*(LW2-LW1) - 1;                             ISRARMO
              IF BLKUR[NEWBL] EQ 0 THEN TEC = TEC - SPLTCNT + 1 ;        AFB1213
              BLECNT[NEWBL] = TEC;                                       ISRARMO
              BLOCFWD[NEWBL] = FWDLINK ;                                 ISRAR
              FWD = NEWBNUM ;                                            ISRAR
              EC = EC + 2*(LW2-LW1) ;                                    ISRARMO
              IF UR EQ 0 THEN EC = EC + SPLTCNT ;                        ISRAR
              RC = N - 1 ;                                               ISRAR
            END                                                          ISRAR
          BLCIP[0] = 0 ;
          END                                                            ISRAR
CONTROL EJECT;                                                           ISRARMO
PROC VANB$IS;                                                            ISRARMO
          BEGIN                                                          ISRARMO
                                                                         ID0913 
 #                                                                       ID0913 
* *   VANB$IS - DELETE A DATA BLOCK FROM AN I-S OR FIFO      PAGE 1 
* *             FILE OR SUBFILE                                          JJJ0916
* *   A.F.R.BROWN                                                        ID0913 
* 1DC VANB$IS                                                            ID0913 
*                                                                        ID0913 
* DC  FUNCTION                                                           ID0913 
*                                                                        ID0913 
*     TO DELETE A DATA BLOCK FROM AN I-S FILE OR AN I-S SUBFILE IN A     ID0913 
*     MIP FILE, AND TO MAKE ALL THE NECESSARY CHANGES TO INDEX BLOCKS    ID0913 
*     THAT RESULT. THIS IS DONE WHEN WE DELETE A DATA RECORD THAT        ID0913 
*     HAPPENS TO BE THE ONLY LIVE RECORD IN ITS BLOCK.                   ID0913 
*                                                                        ID0913 
* DC  ENTRY CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     IF THE LAST RECORD OF THE FILE IS CURRENT, AND IS ABOUT TO BE      ID0913 
*     DELETED, THE QEI FLAG IN THE PTREE MUST ALREADY HAVE BEEN SET.     ID0913 
*     (AFTER A DELETE, THE NEXT RECORD IS CURRENT, OR IF THE LAST RECORD ID0913 
*     IS DELETED, WE CONSIDER THE POSITION TO BE EOI. VANB$IS USES       ID0913 
*     THE EOI FLAG AS AN INDICATION OF WHETHER A LAST OR NON-LAST BLOCK  ID0913 
*     IS BEING DELETED.)                                                 ID0913 
*                                                                        ID0913 
*     THE BLOCK CONTAINING THE CURRENT RECORD MUST BE IN CORE.           ID0913 
* 
*     IF THE CURRENT FILE IS FIFO RATHER THAN I-S, AND THE CURRENT
*     BLOCK IS NOT THE FIRST IN THE (SUB-)FILE, THE BLOCK NUMBER
*     OF THE LOGICALLY PRECEDING BLOCK IS IN PTCURBLK[1], WHERE IT
*     MUST HAVE BEEN LEFT BY SKPF$AA. 
*                                                                        ID0913 
* DC  EXIT CONDITIONS                                                    ID0913 
*                                                                        ID0913 
*     THE BLOCK HAS BEEN REMOVED, AND THE FILE RESTRUCTURED              ID0913 
*     ACCORDINGLY.                                                       ID0913 
*                                                                        ID0913 
*     IF IT WAS THE LAST DATA BLOCK, THE LAST RECORD OF THE PRECEDING    ID0913 
*     BLOCK IS NOW CURRENT, AND THE QEI FLAG OF THE PTREE IS STILL       ID0913 
*     SET. OTHERWISE, THE FIRST RECORD OF THE NEXT BLOCK IS CURRENT.     ID0913 
*                                                                        ID0913 
*                                                                        ID0913 
*     IF IT WAS THE ONLY BLOCK, THE FILE OR SUBFILE HAS BECOME EMPTY.    ID0913 
*     OTHERWISE, THE QFR AND QLR FLAGS ARE UNCHANGED.                    ID0913 
*                                                                        ID0913 
* DC  ERROR CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     WE CHECK FOR ONE CONDITION THAT REPRESENTS EITHER A GARBLED        ID0913 
*     FILE OR A BAD FLAW IN OUR LOGIC. IF IT IS A NON-LAST DATA          ID0913 
*     BLOCK TO BE DELETED IN THE FIRST PLACE, AND IF THE CONSEQUENCES    ID0913 
*     RIPPLE UP INTO THE INDEX BLOCKS SO THAT WE HAVE TO DELETE ONE OF   ID0913 
*     TWO RECORDS IN THE PRIMARY INDEX BLOCK, AND THE QFR FLAG IN THE    ID0913 
*     PTREE IS 0, INDICATING THAT THE DATA BLOCK WE DELETED WAS NOT      ID0913 
*     THE FIRST DATA BLOCK IN THE FILE, SOMETHING IS WRONG.              ID0913 
*                                                                        ID0913 
* DC  CALLED ROUTINES                                                    ID0913 
*                                                                        ID0913 
*     AWAY$IS - TO MOVE BLOCKS TO THE EMPTY CHAIN.                       ID0913 
*     STUP$IS - TO MOVE UP TO THE PARENT INDEX RECORD.                   ID0913 
*     DEL2 - TO SQUEEZE OUT THE PRIMARY INDEX BLOCK, IF IT IS TO         ID0913 
*       BE REDUCED TO ONE RECORD.                                        ID0913 
*     DELL$AA - TO SQUEEZE A RECORD OUT OF AN INDEX BLOCK.               ID0913 
*     MOVW$AA - TO SHIFT THE PTREE CONTENTS UP WHEN SQUEEZING OUT        ID0913 
*       AN INDEX LEVEL.                                                  ID0913 
*     MUVW$AA - A VARIANT OF MOVW$AA .                                   CY211
*     STDN$IS - TO COME BACK DOWN TO THE DATA RECORD LEVEL, SO AS TO     ID0913 
*       BE LOGICALLY POSITIONED ON A DATA RECORD BEFORE EXITING.         ID0913 
*     FIXX$AA - TO ENSURE THE STABILITY OF ONE BLOCK, WHILE WE           ID0913 
*       WORK ON ANOTHER BLOCK AS CURRENT. WHEN DELETING A DATA BLOCK     ID0913 
*       OTHER THAN THE LAST, WE EXCHANGE THE PRU NUMBERS OF IT AND       ID0913 
*       ITS SUCCESSOR BLOCK, TO AVOID HAVING TO LOCATE AND ADJUST THE    ID0913 
*       PREDECESSOR BLOCK. SO FOR A LITTLE WHILE WE HAVE TO BE SURE      ID0913 
*       OF HAVING BOTH THE DELETEABLE BLOCK AND ITS SUCCESSOR HELD       ID0913 
*       IN CORE.                                                         ID0913 
*     UNFX$AA - TO UNDO FIXX$AA.                                         ID0913 
*     LOCB$AA - TO FIND A BLOCK IN CORE, READING IT FROM DISK FIRST      CY211
*       IF NECESSARY.                                                    CY211
*     STOV$AA - TO STEP OVER TO THE SUCCESSOR BLOCK.                     ID0913 
*     ALTR$AA - TO DO THE REQUIRED FORMALITIES BEFORE ALTERING THE       ID0913 
*       IMAGE OF THE SUCCESSOR BLOCK.                                    ID0913 
*     KYSV$IS - TO GENERATE A NEW INDEX RECORD, CORRESPONDING TO THE     ID0913 
*       SUCCESSOR BLOCK, TO BE INSERTED LATER IN THE PARENT INDEX        ID0913 
*       BLOCK. USUALLY THIS IS CALLED BECAUSE THE FIRST KEY OF A BLOCK   ID0913 
*       HAS CHANGED THROUGH DELETION OR INSERTION, BUT HERE IT IS THE    ID0913 
*       PRU NUMBER OF THE SUCCESSOR BLOCK THAT IS BEING CHANGED WHILE    ID0913 
*       THE KEY STAYS THE SAME, ACCORDING TO THE PLOY MENTIONED ABOVE    ID0913 
*       UNDER ((FIXX$AA)).                                               ID0913 
*     IOWR$AA - TO WRITE OUT ANY BLOCK IMAGES THAT FSUNWR1
*       AND/OR FSUNWR2 MAY POINT TO, AND CLEAR THOSE POINTERS,
*       SO THAT IF ANY BLOCK IMAGES HAVE THEIR PRU NUMBERS
*       (BLOCKID) ALTERED AFTERWARDS, IT WILL NOT CAUSE 
*       CONFUSION BY INVALIDATING FSUNWR1 OR FSUNWR2. 
*                                                                        ID0913 
* DC  NON-LOCAL VARIABLES                                                ID0913 
*                                                                        ID0913 
*     NONE                                                               CY211
*                                                                        ID0913 
 #                                                                       ID0913 
CONTROL EJECT;                                                           ID0913 
          ITEM VB;           #TEMP BLOCK ADDR#                           ISRARMO
          ITEM BN1, BN2, BN3;  #TEMP STORES FOR BLOCK NUMBERS#           ISRARMO
                                                                         ID0913 
          ARRAY [0:MXFTNL] S(1) ; ITEM FD U(0,0,60) ;                    CY211
                                                                         ID0913 
                             #START OF VANB$IS CODE#                     ID0913 
          IF QEI NQ 0                                                    ISRAR
            THEN BEGIN #LAST BLOCK VANISHES#                             ISRAR
     VANG:                                                               ISRAR
              FD[CURPTR] = FWD ;                                         ISRAR
              AWAY$IS ;                                                  ISRAR
                #LEAVES P<BLOK$AA> THE SAME#                             ISRAR
              IF ORG EQ FO"FIFO"
                THEN BEGIN
                  LOCB$AA ( PTCURBLK[1] , 1 ) ; #SET BY SKPF$AA # 
                  IF P<BLOK$AA> LS 0 THEN EXRP$AA ; 
                  GOTO VANGA ;
                END 
              STUP$IS ;                                                  ISRAR
              IF RC EQ 1 THEN GOTO VANG ;                                ISRAR
              IF CURPTR EQ 0 AND RC EQ 2                                 ISRAR
                THEN BEGIN                                               ISRAR
                  VB = NLEV ;                                            ISRAR
                  DEL2 ;                                                 ISRAR
                  VB = VB - NLEV ;                                       ISRAR
                  MUVW$AA ( LOC(FD[VB]) , NLEV+1 , -VB ) ;               VBG1216
                  GOTO VANGA ;                                           ISRAR
                END                                                      ISRAR
              DELL$AA ;                                                  ISRAR
              PTCUREC[CURPTR] = RC ;                                     ISRAR
              ASLONGAS CURPTR NQ NLEV                                    ISRAR
                DO BEGIN                                                 ISRAR
                  STDN$IS ( 1 ) ;                                        ISRAR
     VANGA:                                                              ISRAR
                  PTCUREC[CURPTR] = RC ;                                 ISRAR
                  ALTR$AA ;                                              VBG1216
                  FWD = FD[CURPTR] ;                                     ISRAR
                  IF FWD EQ 0                                            AFB0603
                  THEN                                                   AFB0603
                      BEGIN                                              AFB0603
                      LASTBNO = BLOCKID;                                 AFB0603
                      BLCIP[0] = 0 ;
                      END                                                AFB0603
                END                                                      ISRAR
            END                                                          ISRAR
            ELSE BEGIN #NONLAST BLOCK VANISHES#                          ISRAR
              FOR BN3 = P<BLOK$AA> WHILE FSUNWR1[0] NQ 0
              DO
                  BEGIN 
                  P<BLOK$AA> = FSUNWR1[0] ; 
                  IOWR$AA ( 1 ) ; 
                  END 
              P<BLOK$AA> = BN3 ;
              IF FWD EQ LASTBNO 
                THEN BEGIN
                  LASTBNO = BLOCKID[0] ;
                END 
              BN3 = 0;                                                   ISRARMO
              ASLONGAS RC EQ 1 OR CURPTR EQ NLEV                         ISRARMO
                DO                                                       ISRARMO
                BEGIN                                                    ISRARMO
                BN1 = BLOCKID[0];                                        ISRARMO
                FIXX$AA (P<BLOK$AA> , 0) ;                               ISRARMO
                BN2 = FWD;                                               ISRARMO
                LOCB$AA (BN2 , 1);                                       JJJ0225
                IF P<BLOK$AA> LS 0                                       JJJ0721
                THEN                                                     JJJ0721
                  BEGIN                                                  JJJ0721
                  EXRP$AA ; 
                  END                                                    JJJ0721
                ALTR$AA;                                                 VBG1216
                IF BN3 NQ 0 THEN B<36,24>W[BLOCFWA+INDXLNG-1] = BN3 ;    AFB1215
                BLCIP[0] = 0 ;
                BN3 = BN1;                                               ISRARMO
                BLOCKID[0] = BN1;                                        ISRARMO
                  VB = P<BLOK$AA> ;                                      ISRAR
                  P<BLOK$AA> = FIXHOLD[0] ;                              ISRAR
                  ALTR$AA;  #GET READY FOR ALTR#
                  BLOCKID[0] = BN2;                                      ISRARMO
                  AWAY$IS ;                                              ISRAR
                  P<BLOK$AA> = VB ;                                      ISRAR
                  PTCURBLK[CURPTR] = BLOCKID[0] ; 
                  SEBL$AA ( CURPTR , 1 ) ;
                  UNFX$AA ( 0 ) ;                                        ISRAR
                  IF ORG EQ FO"FIFO" THEN RETURN ;
                  STUP$IS ;                                              ISRAR
                END                                                      ISRAR
              IF CURPTR EQ 0 AND RC EQ 2                                 ISRAR
                THEN BEGIN                                               ISRAR
                  IF QFR EQ 0 
                  THEN
                      BEGIN 
                      IMPOSSIBLE(HIERROR); #TURN OFF AAM# 
                      END 
                  DEL2 ;                                                 ISRAR
                END                                                      ISRAR
                ELSE BEGIN                                               ISRAR
                  DELL$AA ;                                              ISRAR
                  IF PTCUREC[CURPTR] LQ RC                               CIM1213
                    THEN BEGIN                                           ISRAR
                      ALTR$AA ;                                          VBG1216
                      INDEXPRU = BN3 ;                                   VBG1216
                      ASLONGAS RNO EQ 1 AND CURPTR NQ 0                  ISRAR
                        DO BEGIN                                         ISRAR
                          KYSV$IS ( 0 ) ;                                ISRAR
                          STUP$IS ;                                      ISRAR
                          ALTR$AA ;                                      VBG1216
                          MOVW$AA ( LOC(KEYHOLE[0]),INDXLNG,RECFWA ) ;   VBG1216
                        END                                              ISRAR
                    END                                                  ISRAR
                    ELSE BEGIN                                           ISRAR
                      STOV$AA ;                                          ISRAR
                      ALTR$AA;                                           JJJ1217
                      INDEXPRU = BN3;                                    JJJ1217
                    END                                                  ISRAR
                END                                                      ISRAR
            END                                                          ISRAR
          END                                                            ISRAR
CONTROL EJECT;                                                           JJJ0221
PROC WNOW$IS (N);                                                        JJJ0221
          BEGIN                                                          JJJ0221
 #                                                                       JJJ0221
* *   WNOW$IS - TO WRITE OUT IMMEDIATELY A NEW SPLIT-OFF BLOCK  PAGE  1  AM2A077
* *   A.F.R.BROWN                                                        JJJ0221
* 1DC WNOW$IS                                                            JJJ0221
*                                                                        JJJ0221
* DC  FUNCTION                                                           JJJ0221
*                                                                        JJJ0221
*     TO WRITE OUT IMMEDIATELY A NEW BLOCK, CREATED AS A RESULT OF A     JJJ0221
*     BLOCK SPLIT, IF IT CONTAINS ANY RECORDS COPIED OUT OF THE OLD      JJJ0221
*     BLOCK IMAGE. THIS IS A WASTE OF TIME IN GENERAL, BUT THE           JJJ0221
*     PRACTICE OF CALLING WNOW$IS, IN GENERAL, AFTER SPLT$IS IS A        JJJ0221
*     SAFEGUARD AGAINST THE FOLLOWING SEQUENCE OF EVENTS --              JJJ0221
*     A NEW RECORD IS TO BE ADDED TO THE FILE, AND AN OLD BLOCK HAS      JJJ0221
*     TO BE SPLIT TO MAKE ROOM. MANY OLD RECORDS ARE COPIED INTO THE     JJJ0221
*     NEW BLOCK, AND THEN THE NEW RECORD IS COPIED INTO THE OLD          JJJ0221
*     BLOCK, IN PRACTICE MAKING IRRECOVERABLE ALL THE RECORDS THAT       JJJ0221
*     WERE COPIED OUT INTO THE NEW BLOCK. NOW SUPPOSE THE SYSTEM         JJJ0221
*     CRASHES WHEN THE OLD BLOCK HAS BEEN REWRITTEN TO DISK, BUT THE     JJJ0221
*     NEW BLOCK HAS NOT. THE OLD RECORDS THAT WERE MOVED TO THE NEW      JJJ0221
*     BLOCK HAVE BEEN DESTROYED ON DISK. THE LOGIC OF BLOCK MANAGEMENT   JJJ0221
*     MAY CAUSE THE TWO BLOCKS TO BE WRITTEN OUT IN EITHER ORDER,        JJJ0221
*     SO WE NEED SOME SORT OF INTERLOCK BETWEEN THEM TO FORCE THE        JJJ0221
*     FAVORABLE ORDER, NEW BEFORE OLD. AS A SIMPLER SOLUTION THAN THE    JJJ0221
*     INTERLOCK, WE JUST FORCE THE WRITING OF THE NEW BLOCK RIGHT AWAY.  JJJ0221
*                                                                        JJJ0221
*     WNOW$IS ALSO CALLS  KYSV$IS TO GENERATE AND SAVE AN INDEX          JJJ0221
*     RECORD POINTING TO THE NEW BLOCK.                                  JJJ0221
*                                                                        JJJ0221
* DC  ENTRY CONDITIONS                                                   JJJ0221
*                                                                        JJJ0221
*     THERE IS ONE PARAMETER,PASSED IN THE ORDINARY SYMPL MANNER.        JJJ0221
*     THIS IS A 1 OR 2 , WHICH IS MERELY PASSED ALONG TO ROUTINE         JJJ0221
*     KYSV$IS, TELLING IT TO SAVE THE INDEX RECORD FOR THIS NEW BLOCK    JJJ0221
*     IN THE 2ND OR 3RD SLOT OF ARRAY KEYHOLD. 3RD IF THE NEW BLOCK IS   JJJ0221
*     THE FIRST CHIP OFF THE OLD BLOCK DURING A 3-WAY SPLIT, OTHERWISE   JJJ0221
*     2ND.                                                               JJJ0221
*                                                                        JJJ0221
*     NEWBFWA CONTAINS THE FWA OF THE NEW BLOCK PARCEL.                  JJJ0221
*                                                                        JJJ0221
*     SPLTCNT CONTAINS THE NUMBER OF RECORDS THAT WERE SPLIT OFF THE     JJJ0221
*     OLD BLOCK BY THE MOST RECENT CALL TO SPLT$IS. THIS IS INTERESTING  JJJ0221
*     BECAUSE IF IT IS 0, IT MEANS THE OLD BLOCK STILL HAS ALL ITS       JJJ0221
*     RECORDS, AND THERE IS NOTHING TO PROTECT BY FORCE-WRITING THIS     JJJ0221
*     NEW BLOCK.                                                         JJJ0221
*                                                                        JJJ0221
* DC  EXIT CONDITIONS                                                    JJJ0221
*                                                                        JJJ0221
*     P<BLOK$AA>, WHICH PROBABLY POINTS TO THE OLD BLOCK IMAGE, HAS      JJJ0221
*     BEEN PRESERVED.                                                    JJJ0221
*                                                                        JJJ0221
*     BLOCLWA HAS LIKEWISE BEEN PRESERVED.                               JJJ0221
*                                                                        JJJ0221
*     THE NEW BLOCK, IF ANY RECORDS WERE MOVED TO IT BY SPLT$IS, HAS     JJJ0221
*     BEEN WRITTEN OUT.                                                  JJJ0221
*                                                                        JJJ0221
*     AN INDEX RECORD TO THE NEW BLOCK HAS BEEN SAVED BY KYSV$IS. IF     JJJ0221
*     THE BLOCK HAS NO RECORDS YET, THIS INDEX RECORD WILL CONTAIN       JJJ0221
*     A GARBAGE KEY. BUT THIS DOES NOT REALLY HAPPEN. EVEN IF SPLTCNT IS JJJ0221
*     0, SHOWING THAT NO OLD RECORDS WENT INTO THE NEW BLOCK, WNOW$IS    JJJ0221
*     WAS NOT CALLED UNTIL AFTER A NEW RECORD HAD BEEN PUT INTO THE NEW  JJJ0221
*     BLOCK.                                                             JJJ0221
*                                                                        JJJ0221
*     THE NEW BLOCK, WHICH WAS FROZEN BY A FIXX$AA(1) CALL FROM SPLT$IS, JJJ0221
*     HAS BEEN UNFROZEN BY A CALL OF UNFX$AA(1). HOWEVER, IT IS STILL    JJJ0221
*     IN CORE, AND THE ROUTINE THAT CALLED WNOW$IS COULD GET AT THE      JJJ0221
*     NEW BLOCK IMAGE BY USING THE ADDRESS IN NEWBFWA, IF IT DID SO      JJJ0221
*     IMMEDIATELY.                                                       JJJ0221
*                                                                        JJJ0221
* DC  ERROR CONDITIONS                                                   JJJ0221
*                                                                        JJJ0221
*     NONE.                                                              JJJ0221
*                                                                        JJJ0221
* DC  CALLED ROUTINES                                                    JJJ0221
*                                                                        JJJ0221
*     HAWK$AA - TO SET P<BLOK$AA> AND BLOCLWA TO POINT TO THE NEW BLOCK. JJJ0221
*       THEN TO RESTORE THEM TO POINT TO THE BLOCK THEY POINTED TO ON    JJJ0221
*       ENTRY.                                                           JJJ0221
*                                                                        JJJ0221
*     IOWR$AA - TO WRITE OUT THE NEW BLOCK IMAGE.                        JJJ0221
*                                                                        JJJ0221
*     KYSV$IS - TO CONSTRUCT AND SAVE AN INDEX RECORD FOR THE NEW BLOCK. JJJ0221
*                                                                        JJJ0221
*     UNFX$AA - TO UNFREEZE THE NEW BLOCK AND INSERT IT IN THE KICKOUT   JJJ0221
*       CHAIN.                                                           JJJ0221
*                                                                        JJJ0221
* DC  NON-LOCAL VARIABLES                                                JJJ0221
*                                                                        JJJ0221
*     NONE                                                               JJJ0221
*                                                                        JJJ0221
 #                                                                       JJJ0221
                                                                         JJJ0221
                                                                         JJJ0221
          ITEM N , TILE ;                                                JJJ0221
                                                                         JJJ0221
                                                                         JJJ0221
          TILE = P<BLOK$AA> ;                                            ISRAR
          HAWK$AA ( NEWBFWA ) ;                                          ISRAR
          IF MIPMODE EQ 0 AND SPLTCNT NQ 0                              015300
            AND FIXHOLD[0] NQ FSUNWR1[0] THEN IOWR$AA ( 1 ) ;           015400
          KYSV$IS ( N ) ;                                                ISRAR
          HAWK$AA ( TILE ) ;                                             ISRAR
          UNFX$AA ( 1 ) ;                                                ISRAR
          END                                                            ISRAR
                                                                         ISRAR
          END TERM                                                       ISRAR
