*DECK NRODAK                                                             NRODAK 
*CALL COMUSETXT 
PROC NRO$AK;                                                             GAG0905
      BEGIN                                                              GAG0905
     XREF BEGIN                                                          GAG0905
          FUNC UUCC$AA ;                                                 GAG0905
          PROC ALTR$AA ;                                                 GAG0905
          FUNC LWAD$AA;                                                  GAG0905
          PROC RPPT$AA;                                                  GAG0905
          PROC RPGT$AA;                                                  GAG0905
          PROC LOCR$AA;                                                  GAG0905
          PROC CONS$AA;                                                  GAG0905
          PROC VOKM$AA;                                                  GAG0905
          PROC ADRC$AA;                                                  GAG0905
          FUNC MXPR$AA;                                                  GAG0905
          FUNC QUMP$AA;                                                  GAG0905
          PROC MSGZ$AA;                                                  GAG0905
          PROC FIXX$AA;                                                  GAG0905
          PROC CCAL$AA;  #FOR CONDITIONAL CALLS TO RARE FUNC#            GAG0905
          PROC TROW$AA;                                                  GAG0905
          PROC EXRP$AA;                                                  GAG0905
          PROC LOCB$AA;                                                  GAG0905
          PROC SLOG$AA ;                                                020200
          PROC UNFX$AA;                                                  GAG0905
          PROC CMRC$AA;                                                  GAG0905
          PROC NWEM$AK;                                                  GAG0905
          PROC DLT$MP;                                                   GAG0905
          PROC REPL$MP;                                                  GAG0905
          PROC PUT$MP;                                                   GAG0905
          PROC MOVC$AA;                                                  GAG0905
          LABEL EXIT$AA;                                                 GAG0905
          PROC CURR$AA;                                                  GAG0905
          PROC NUBL$AA ;                                                 GAG0905
          PROC SEBL$AA;                                                  GAG0905
          PROC CURR$AK ;                                                 GAG0905
          PROC LBK$AK ;                                                  GAG0905
          PROC LBK2$AK ;                                                 GAG0905
          FUNC MACH$AK ;                                                 GAG0905
          PROC RDBK$AK ;                                                 GAG0905
          PROC MSGF$AA ;                                                 GAG0905
          PROC SETR$AA ;                                                 GAG0905
          PROC DUPK$AA ;
          END                                                            GAG0905
     XDEF BEGIN                                                          GAG0905
          PROC DELL$AK;                                                  GAG0905
          PROC DLT$AK;                                                   GAG0905
          PROC NUBL$AK;                                                  GAG0905
          PROC RCKN$AK;                                                  GAG0905
          PROC PWOK$AK;                                                  GAG0905
          PROC PCEM$AK;                                                  GAG0905
          PROC PUT$AK;                                                   GAG0905
          PROC REPL$AK;                                                  GAG0905
          PROC RLOV$AK;                                                  GAG0905
          PROC SPAC$AK;                                                  GAG0905
          PROC SETR$AK ;                                                 GAG0905
          PROC ADRC$AK ;                                                 GAG0905
          PROC SVEC$AK ;
          END                                                            GAG0905
CONTROL WEAK PUT$MP, DLT$MP, REPL$MP;                                    GAG0905
                                                                         GAG0905
          ITEM T1 ;                                                      GAG0905
          ITEM IX;         #INDUCTION VARIABLE#                          GAG0905
          ITEM MIP;                                                      GAG0905
          ITEM OVF;  #STORAGE FOR OVERFLOW KEY#                          GAG0905
          ITEM SVCKEY;  #STORAGE FOR CKEY#                               GAG0905
          ITEM OLDEC ;  #STORAGE FOR EC VALUE BEFORE BLOCK ALTERED #
CONTROL EJECT ;                                                          GAG0905
PROC ADRC$AK ;                                                           GAG0905
 #                                                                       AFB1004
* *   ADRC$AK - PUT A RECORD IN AN AK BLOCK       PAGE 1                 AFB1004
* *   A.F.R.BROWN                                                        AFB1004
* 1DC ADRC$AK                                                            AFB1004
*                                                                        AFB1004
* DC  FUNCTION                                                           AFB1004
*                                                                        AFB1004
*     TO PUT A RECORD INTO AN AK BLOCK. THE ACTION IS                    AFB1004
*     ALWAYS HANDLED AS A REPLACE, NEVER AS AN INSERT. IF A              AFB1004
*     RECORD IS TO GO BETWEEN TWO LIVE RECORDS, THERE MUST               AFB1004
*     ALREADY BE A DEAD RECORD IN EXISTENCE, OCCUPYING THE SLOT.         AFB1004
*     WHERE A NEW RECORD IS TO BE ADDED AFTER THE LAST RECORD            AFB1004
*     IN A BLOCK, WE (TO SIMPLIFY THE LOGIC) FIRST ADD THE               AFB1004
*     NECESSARY NUMBER OF DEAD RECORDS AT THE END, AND THEN CALL         AFB1004
*     ADRC$AK TO REPLACE THE LAST OF THEM WITH THE NEW RECORD.           AFB1004
*     THIS IS IN CONTRAST TO DA AND IS FILES, WHERE A PUT MAY            AFB1004
*     TAKE THE FORM OF REPLACING A DEAD RECORD, BUT MAY ALSO BE          AFB1004
*     A CREATION OF A NEW LIVE RECORD BETWEEN TWO LIVE RECORDS           AFB1004
*     THAT WERE PREVIOUSLY NEIGHBORS.                                    AFB1004
*                                                                        AFB1004
*     WHERE A LIVE RECORD IS TO BE REPLACED BY A LIVE RECORD,            AFB1004
*     THERE IS NOTHING PECULIAR ABOUT ADRC$AK.                           AFB1004
*                                                                        AFB1004
* DC  ENTRY CONDITIONS                                                   AFB1004
*                                                                        AFB1004
*     P<PTRE$AA> POINTS TO THE PTREE OF THE CURRENT AK FILE,             AFB1004
*     AND CURPTR (WHICH IS 0 OR 1) SPECIFIES A WORD THAT                 AFB1004
*     POINTS TO THE BLOCK AND THE RECORD SLOT IN WHICH THE               AFB1004
*     NEW RECORD IS TO BE PUT. THIS SLOT MAY BE OCCUPIED BY              AFB1004
*     A LIVE RECORD OR BY A DEAD ONE.                                    AFB1004
*                                                                        AFB1004
*     IF CURPTR=0, THE NEW RECORD IS NATIVE TO THE SLOT.                 AFB1004
*     IF CURPTR=1, IT IS AN ALIEN.                                       AFB1004
*                                                                        AFB1004
*     P<BLOK$AA> POINTS TO THE BLOCK IMAGE.                              AFB1004
*     RECFWA, RECLNG, AND RECLWA ARE THE FWA, LENGTH IN WORDS, AND       AFB1004
*     LWA+1 OF THE RECORD NOW IN THE SLOT.                               AFB1004
*                                                                        AFB1004
*     RNO IS THE RECORD NUMBER WITHIN THE BLOCK.                         AFB1004
*                                                                        AFB1004
*     NEWFWA IS THE FWA OF WHAT IS TO BE THE NEW RECORD,                 AFB1004
*     AND NEWLNG IS ITS LENGTH IN CHARACTERS.                            AFB1004
*     THE LENGTH INCLUDES THE PREFIX AT THE BEGINNING, IF THIS           AFB1004
*     IS AN ALIEN RECORD. SUCH A PREFIX IS AN INTEGRAL PART OF           AFB1004
*     THE RECORD AS FAR AS ADRC$AK IS CONCERNED.                         AFB1004
*                                                                        AFB1004
*     IT MUST ALREADY BE KNOWN THAT THERE IS ROOM IN THE BLOCK           AFB1004
*     FOR THE NEW RECORD. IF NOT, THERE WILL BE A FATAL ERROR,           AFB1004
*     OF A TYPE THAT WE REALLY DO NOT EVER EXPECT TO GET.                AFB1004
*                                                                        AFB1004
*     VERY IMPORTANT IS THAT ADRC$AA, WHEN DOING THE JOB FOR DA AND      AFB1004
*     IS FILES WITHOUT THE HELP OF AN INTERFACE SUCH AS THIS ONE,        AFB1004
*     NEVER HAS TO REPLACE A DEAD RECORD, EVEN OF ZERO LENGTH, BY A LIVE AFB1004
*     ONE. DA AND IS ALWAYS CALL CONS$AA TO SQUEEZE OUT THE DEAD ONES    AFB1004
*     FIRST.                                                             AFB1004
*                                                                        AFB1004
* DC  EXIT CONDITIONS                                                    AFB1004
*                                                                        AFB1004
*     THE NEW RECORD HAS REPLACED THE OLD ONE IN THE SLOT.               AFB1004
*     EC, THE COUNT OF FREE SPACE IN THE BLOCK, HAS BEEN                 AFB1004
*     ADJUSTED, AND SO HAS BLFRESLTS[0], THE COUNT OF DEAD               AFB1004
*     RECORDS NOW OCCUPYING SLOTS IN THE BLOCK.                          AFB1004
*                                                                        AFB1004
*     THE UR BIT IN THE BLOCK HAS BEEN SET TO 0, BECAUSE                 AFB1004
*     UNIFORM RECORDS ARE NEVER CONSIDERED TO OCCUR IN AN                AFB1004
*     AK FILE.                                                           AFB1004
*                                                                        AFB1004
*     FSRECCNT[0], THE COUNT OF LIVE RECORDS IN THE FILE,                AFB1004
*     HAS BEEN ADJUSTED AS NECESSARY, AND IF THE NEW RECORD              AFB1004
*     IS AN ALIEN, FSORCNT[0], THE COUNT OF OVERFLOW RECORDS             AFB1004
*     IN THE FILE, HAS BEEN ADJUSTED TO THE SAME EXTENT.                 AFB1004
*                                                                        AFB1004
*     THE MOST-EMPTY TABLE AND THE PERCENT-EMPTY TABLE IN THE            AFB1004
*     FSTT HAVE BEEN UPDATED.                                            AFB1004
*                                                                        AFB1004
* DC  ERROR CONDITIONS                                                   AFB1004
*                                                                        AFB1004
*     EC547 - FATAL IF THERE IS NOT ENOUGH ROOM IN THE BLOCK.            AFB1004
*                                                                        AFB1004
* DC  CALLED ROUTINES                                                    AFB1004
*                                                                        AFB1004
*     MSGF$AA - TO ISSUE FATAL ERROR.                                    AFB1004
*     ADRC$AA - TO PUT THE RECORD IN THE BLOCK.                          AFB1004
*     NWEM$AK - TO UPDATE THE MOST-EMPTY BLOCK TABLE.                    AFB1004
*     PCEM$AK - TO UPDATE THE PERCENT-EMPTY TABLE.                       AFB1004
*                                                                        AFB1004
* DC  NON-LOCAL VARIABLES                                                AFB1004
*                                                                        AFB1004
*     OUTKEY - SET 0 TO TELL ADRC$AA THERE IS NO EXTRA NON-              AFB1004
*       EMBEDDED KEY TO BE STORED (IN AN AK FILE A PRIMARY               AFB1004
*       KEY IS USUALLY NON-EMBEDDED, BUT THEN WE DONT STORE              AFB1004
*       IT ANYWHERE BECAUSE IT IS INHERENT IN THE RECORD                 AFB1004
*       POSITION.)                                                       AFB1004
*     BARREN - SET 0 TO TELL ADRC$AA THIS RECORD DOESNT HAVE             AFB1004
*       A SUBFILE DEPENDING ON IT.                                       AFB1004
*     NRECINS - SET 1 TO TELL ADRC$AA THERE IS ONLY ONE RECORD           AFB1004
*       BEING PUT (SOMETIMES INDEX RECORDS IN AN IS FILE ARE PUT         AFB1004
*       2 OR 3 AT A TIME).                                               AFB1004
*     FUNCT - SET 0 TO TELL ADRC$AA THIS IS A REPLACE, NOT               AFB1004
*       AN INSERT.                                                       AFB1004
*     IX - SCRATCH.                                                      AFB1004
*                                                                        AFB1004
* DC  NARRATIVE                                                          AFB1004
*                                                                        AFB1004
*     FIRST SET OUTKEY, BARREN, AND NRECINS FOR ADRC$AA.                 AFB1004
*     NOW ADRC$AA ALWAYS ((THINKS)), IF FUNCT=0, THAT A LIVE             AFB1004
*     RECORD IS BEING REPLACED BY A LIVE ONE, AND ADJUSTS                AFB1004
*     ALL COUNTS ON THAT BASIS. SO IF THE RECORD WE ARE                  AFB1004
*     ABOUT TO REPLACE IS A DEAD ONE, WE HAVE TO MAKE                    AFB1004
*     OUR OWN ADJUSTMENTS, AS FAR AS THE ADDITION OF A                   AFB1004
*     RECORD IS CONCERNED (FSORCNT AND RECCNT). WE ALSO                  AFB1004
*     HAVE TO REDUCE BLFRESLTS, WHICH IS A COUNT THAT ONLY               AFB1004
*     AK USES. AND WE ALSO HAVE TO REDUCE EC, THE COUNT OF               AFB1004
*     EMPTY SPACE IN THE BLOCK. SUPPOSE A DEAD RECORD 3                  AFB1004
*     WORDS LONG IS BEING REPLACED BY A LIVE ONE 2 WORDS LONG.           AFB1004
*     EC SHOULD IN THE END BE REDUCED BY TWICE 2, THE LENGTH             AFB1004
*     OF THE NEW RECORD IN HALFWORDS -- THE OTHER TWO                    AFB1004
*     HALFWORDS THAT WERE IN THE DEAD RECORD WILL STILL BE               AFB1004
*     FREE, THOUGH MOVED TO A DIFFERENT PLACE IN THE BLOCK.              AFB1004
*     BUT ADRC$AA WILL INCREASE EC BY 2, I.E. 2*(3-2),                   AFB1004
*     BECAUSE IT ((THINKS)) A 3-WORD RECORD IS BEING REPLACED            AFB1004
*     BY A 2-WORD RECORD, WHICH IS A GAIN OF 2 HALFWORDS OF              AFB1004
*     FREE SPACE. SO WE HAVE TO DIMINISH EC BY 6, THE LENGTH             AFB1004
*     OF THE DEAD RECORD IN HALFWORDS, IN ORDER TO MAKE EC               AFB1004
*     COME OUT RIGHT AT THE END. BETTER TO DO IT BEFORE                  AFB1004
*     CALLING ADRC$AA, TO AVOID LETTING EC GO ABOVE A LIMIT              AFB1004
*     IN AN EXTREME CASE. EC CANT LEGITIMATELY GO NEGATIVE               AFB1004
*     HERE, BECAUSE IT MUST AT LEAST BE EQUAL TO THE                     AFB1004
*     LENGTH OF THE DEAD RECORD WE ARE ABOUT TO REPLACE.                 AFB1004
*                                                                        AFB1004
*     THE REST IS OBVIOUS, EXCEPT THAT WE CALL PCEM$AK AT                AFB1004
*     THE END, TO UPDATE THE PERCENT-EMPTY TABLE. WHAT IT                AFB1004
*     DOES IS BASED ON THE NEW EC OF THIS BLOCK, AND ON                  AFB1004
*     BACKLEV AS CONTAINING THE INITIAL EC OF THE BLOCK,                 AFB1004
*     BEFORE THE CURRENT CHANGE. AS FAR AS ADRC$AK IS                    AFB1004
*     CONCERNED, BACKLEV HAS BEEN SET EXPLICITLY IN REPL$AK,             AFB1004
*     IF THIS IS A SIMPLE REPLACE OF A LIVE NATIVE RECORD BY             AFB1004
*     ANOTHER LIVE NATIVE RECORD, OR OTHERWISE SET BY                    AFB1004
*     SETR$AK, WHICH WILL BE FOUND TO HAVE BEEN CALLED FOR               AFB1004
*     THE CURRENT BLOCK.                                                 AFB1004
*                                                                        AFB1004
 #                                                                       AFB1004
          BEGIN                                                          GAG0905
          OUTKEY = 0 ;                                                   GAG0905
          BARREN = 0 ;                                                   GAG0905
          NRECINS = 1 ;                                                  GAG0905
          IF RPUCC EQ DEAD                                               GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              BLFRESLTS[0] = BLFRESLTS[0] - 1 ;                          GAG0905
              IX = EC - 2 * RECLNG ;                                     GAG0905
              IF IX LS 0                                                 GAG0905
              THEN                                                       GAG0905
                  BEGIN                                                  GAG0905
                  MSGF$AA ( EC547 ) ;                                    GAG0905
                  GOTO EXIT$AA ;                                         GAG0905
                  END                                                    GAG0905
              EC = IX ;                                                  GAG0905
              IF CURPTR NQ 0                                             GAG0905
              THEN                                                       GAG0905
                  BEGIN                                                  GAG0905
                  FSORCNT[0] = FSORCNT[0] + 1 ;                          GAG0905
                  END                                                    GAG0905
              ELSE                                                       GAG0905
                  BEGIN                                                  GAG0905
                  RECCNT = RECCNT + 1 ;                                  GAG0905
                  END                                                    GAG0905
              END                                                        GAG0905
          FUNCT = 0 ;                                                    GAG0905
          ADRC$AA ;                                                      GAG0905
          UR = 0 ;                                                       GAG0905
          NWEM$AK ;                                                      GAG0905
          PCEM$AK ;                                                      GAG0905
          END                                                            GAG0905
CONTROL EJECT;                                                           GAG0905
PROC DELL$AK;                                                            GAG0905
          BEGIN                                                          GAG0905
 #                                                                       GAG0905
* *   DELL$AK - DELETE AK RECORDS                PAGE  1                 GAG0905
* *   PROGRAM - NRO$AK                                                   GAG0905
* *   R.P.NG.                                   DATE.                    GAG0905
* 1CD DELL$AK                                                            GAG0905
*                                                                        GAG0905
* CD  FUNCTION                                                           GAG0905
*                                                                        GAG0905
*     TO DELETE A RECORD IN AN AK BLOCK.                                 GAG0905
*                                                                        GAG0905
* CD  ENTRY CONDITIONS                                                   GAG0905
*                                                                        GAG0905
*     P<FSTT$AA>,P<BLOK$AA> AND P<PTRE$AA> SHOULD BE SET.  A CURR$AA     GAG0905
*     CALL (OR EQUIVALENT CALLS) SHOULD HAVE BEEN MADE TO SET UP RNO,THE GAG0905
*     PTREE, BLOKFWA, RECLNG, RECFWA ETC. SO THAT DELL$AA CAN BE CALLED  GAG0905
*     DIRECTLY (SEE ENTRY CONDITIONS FOR DELL$AA ALSO).  IN OTHER WORDS, GAG0905
*     THE FILE SHOULD BE POSITIONED ON THE RECORD TO BE DELETED.         GAG0905
*                                                                        AFB1004
*     CURPTR IS 0 OR 1, AND INDICATES WHICH PTREE WORD POINTS TO THE     AFB1004
*       CURRENT RECORD. IF IT IS 0, THE RECORD IS AN ORDINARY NATIVE     AFB1004
*       RECORD, OR A PLACE HOLDER. IF CURPTR=1, THE RECORD IS AN ALIEN,  AFB1004
*       AN OVERFLOW POINTED TO BY THE RECORD TO WHICH PTREEWRD[0]        AFB1004
*       POINTS.                                                          AFB1004
*                                                                        GAG0905
* CD  EXIT CONDITIONS.                                                   GAG0905
*                                                                        GAG0905
*     THE RECORD IS LOGICALLY DELETED.  IT IS ONLY PHYSICALLY DELETED IF GAG0905
*     IT IS THE LAST RECORD IN THE BLOCK (RC IS ADJUSTED).  THE EMPTY    GAG0905
*     TABLES ARE UPDATED TO REFLECT THE CHANGE.                          GAG0905
*                                                                        GAG0905
* CD  ERROR CONDITIONS                                                   GAG0905
*                                                                        GAG0905
*     NONE.                                                              GAG0905
*                                                                        GAG0905
* CD  CALLED ROUTINES.                                                   GAG0905
*                                                                        GAG0905
*     SVEC$AK - TO SAVE THE VALUE OF EC AS IT WAS BEFORE THE BLOCK
*       WAS ALTERED, BUT SAVING 0 IF IT HAD NO VACANT SLOTS.
*     ALTR$AA - TO DO THE FORMALITIES BEFORE ALTERING A BLOCK IMAGE      AFB1004
*       FOR WHAT MAY BE THE FIRST TIME.                                  AFB1004
*     UUCC$AA - A FUNCTION THAT GIVES THE UNUSED CHARACTER COUNT OF      AFB1004
*       A RECORD SPECIFIED BY RECORD NUMBER, WHICH IS 15 FOR A DEAD      AFB1004
*       RECORD.                                                          AFB1004
*     RPPT$AA - TO REPLACE THE RECORD POINTER FOR A GIVEN RECORD BY      AFB1004
*       WHAT IS NOW IN RECPTR.                                           AFB1004
*     PCEM$AK - TO UPDATE PERCENT EMPTY TABLE.                           GAG0905
*     NWEM$AK - TO UPDATE THE MOST EMPTY TABLE.                          GAG0905
*                                                                        AFB1004
* DC  NON-LOCAL VARIABLES                                                AFB1004
*                                                                        AFB1004
*     IX - FOR SCRATCH.                                                  AFB1004
*                                                                        GAG0905
* CD  DESCRIPTION                                                        GAG0905
*                                                                        GAG0905
*     CALL ALTR$AA, AS WE MAY BE ALTERING THE BLOCK IMAGE FOR THE FIRST  AFB1004
*     TIME SINCE IT WAS READ FROM DISK. SAVE THE STARTING VALUE OF EC    AFB1004
*     IN BACKLEV, FOR USE BY PCEM$AK LATER. INCREASE EC BY THE LENGTH    AFB1004
*     OF THE RECORD WE ARE ABOUT TO DELETE. (THAT MUCH IS SURE. HOW MUCH AFB1004
*     EC WILL CHANGE FOR RECORD POINTERS IS ANOTHER MATTER.)             AFB1004
*     IF THIS IS THE LAST RECORD IN THE BLOCK, SCAN BACK FROM IT TO THE  AFB1004
*     LAST PRECEDING LIVE RECORD IN THE BLOCK, MAKE THAT THE LAST RECORD AFB1004
*     (I.E. ALTER RC TO ITS RECORD NUMBER), INCREASE EC BY 1 FOR EVERY   AFB1004
*     RECORD POINTER SO ELIMINATED, AND DECREASE BLFRESLTS[0] BY 1 FOR   AFB1004
*     EVERY DEAD RECORD POINTER SO ELIMINATED. IF THIS WAS THE ONLY LIVE AFB1004
*     RECORD IN THE BLOCK, RESET THE BLOCK HEADER AS FOR AN EMPTY        AFB1004
*     BLOCK.                                                             AFB1004
*                                                                        GAG0905
 #                                                                       GAG0905
          ALTR$AA ;                                                      GAG0905
          SVEC$AK ; 
          EC = EC + 2 * RECLNG ;                                         GAG0905
          IF RNO EQ RC                                                   GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              FOR IX = RNO-1 STEP -1                                     GAG0905
              DO                                                         GAG0905
                  BEGIN                                                  GAG0905
                  RC = IX ;                                              GAG0905
                  EC = EC + 1 ;                                          GAG0905
                  IF IX EQ 0                                             GAG0905
                  THEN                                                   GAG0905
                      BEGIN                                              GAG0905
                      GOTO DELMAR ;                                      GAG0905
                      END                                                GAG0905
                  IF UUCC$AA ( IX ) NQ DEAD                              GAG0905
                  THEN                                                   GAG0905
                      BEGIN                                              GAG0905
                      GOTO DELMAT ;                                      GAG0905
                      END                                                GAG0905
                  BLFRESLTS[0] = BLFRESLTS[0] - 1 ;                      GAG0905
                  END                                                    GAG0905
DELMAR:                                                                  GAG0905
              EC = MAXMT ;                                               GAG0905
              BLFRESLTS[0] = 0 ;                                         GAG0905
              END                                                        GAG0905
 #                                                                       AFB1004
*     BUT IF IT IS NOT THE LAST RECORD IN THE BLOCK THAT WE ARE          AFB1004
*     DELETING, ALL WE HAVE TO DO IS SET THE RECORD POINTER TO INDICATE  AFB1004
*     A DEAD RECORD, REPLACE IT IN THE BLOCK, INCREASE THE COUNT OF DEAD AFB1004
*     RECORD POINTERS BY 1.  WE KNOW THAT THIS
*     CANNOT BE THE LAST OR ONLY LIVE RECORD IN THE BLOCK, BECAUSE IT IS AFB1004
*     NOT THE LAST RECORD, AND THE RULE FOR ALL FILE ORGANIZATIONS IS    AFB1004
*     THAT THE LAST RECORD OF A BLOCK MUST BE LIVE.                      AFB1004
 #                                                                       AFB1004
          ELSE                                                           GAG0905
              BEGIN                                                      GAG0905
              BLFRESLTS[0] = BLFRESLTS[0] + 1 ;                          GAG0905
              RPUCC = DEAD ;                                             GAG0905
              RPPT$AA ( RNO ) ;                                          GAG0905
              END                                                        GAG0905
 #                                                                       AFB1004
*     IN EITHER CASE, WE CONCLUDE BY CLEARING BLCIP[0], INDICATING THAT  AFB1004
*     THE BLOCK IS NO LONGER IN AN INCOMPLETELY CHANGED STATE (THIS FLAG AFB1004
*     WILL HAVE BEEN SET BY ALTR$AA, AS A PRECAUTION AGAINST SYSTEM      AFB1004
*     CRASHES). IF CURPTR IS NOT 0, THIS MUST BE AN ALIEN RECORD, SO     AFB1004
*     DECREASE THE COUNT OF ALIEN RECORDS IN THE FILE.                   AFB1004
*     OTHERWISE, DECREASE THE COUNT OF LIVE RECORDS IN THE FILE.         AFB1004
*     WE DONT DECREASE THE LIVE RECORD COUNT WHEN AN ALIEN IS            AFB1004
*     DELETED, BECAUSE IT DOESNT REALLY COUNT -- THE ONE THAT            AFB1004
*     COUNTS FOR CENSUS PURPOSES IS THE PLACEHOLDER, OR                  AFB1004
*     ((MOTHER)) IN SOME OTHER BLOCK THAT OCCUPIES THE SLOT              AFB1004
*     CORRESPONDING TO THE KEY, AND POINTS TO THE ALIEN RECORD.          AFB1004
*     THEN CALL NWEM$AK AND PCEM$AK TO UPDATE THE EMPTY TABLES.          AFB1004
 #                                                                       AFB1004
DELMAT:                                                                  GAG0905
          BLCIP[0] = 0 ;                                                 GAG0905
          IF CURPTR NQ 0                                                 GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              FSORCNT[0] = FSORCNT[0] - 1 ;                              GAG0905
              END                                                        GAG0905
          ELSE                                                           GAG0905
              BEGIN                                                      GAG0905
              RECCNT = RECCNT - 1 ;                                      GAG0905
              END                                                        GAG0905
          NWEM$AK;  #UPDATE MOST EMPTY TABLE#                            GAG0905
          PCEM$AK ;                                                      GAG0905
          END  #END DELL$AK#                                             GAG0905
CONTROL EJECT;                                                           GAG0905
PROC DLT$AK;  #PROCESS AK RECORD DELETES#                                GAG0905
 #                                                                       AFB1004
* *   DLT$AK - DO A COMPLETE AK DELETE                     PAGE 1        AFB1004
* *   A.F.R.BROWN                                                        AFB1004
* 1DC DLT$AK                                                             AFB1004
*                                                                        AFB1004
* DC  FUNCTION                                                           AFB1004
*                                                                        AFB1004
*     TO CARRY OUT A COMPLETE DELETE IN AN AK FILE, WHETHER DELETING     AFB1004
*     A SIMPLE NATIVE RECORD, OR DELETING A PLACEHOLDER IN ONE BLOCK     AFB1004
*     AND THE CORRESPONDING ALIEN IN ANOTHER BLOCK.                      AFB1004
*                                                                        AFB1004
* DC  ENTRY CONDITIONS                                                   AFB1004
*                                                                        AFB1004
*     KP AND KA IN THE FIT POINT TO A PRIMARY KEY VALUE, SPECIFYING      AFB1004
*       THE RECORD TO BE DELETED.                                        AFB1004
*     P<FSTT$AA> POINTS TO THE FSTT OF THE CURRENT AK FILE.              AFB1004
*                                                                        AFB1004
* DC  EXIT CONDITIONS                                                    AFB1004
*                                                                        AFB1004
*     IF THE RECORD EXISTS, I.E. IF THE SLOT INDICATED BY THE KEY        AFB1004
*     CONTAINS A LIVE RECORD THAT IS NOT AN ALIEN, THEN THAT RECORD      AFB1004
*     HAS BEEN DELETED AND THE COUNT OF LIVE RECORDS IN THE FILE         AFB1004
*     HAS BEEN REDUCED BY ONE.                                           AFB1004
*                                                                        AFB1004
*     IF THE RECORD TURNED OUT TO BE A PLACEHOLDER, THEN THE ALIEN       AFB1004
*     RECORD THAT IT POINTED TO HAS ALSO BEEN DELETED, AND THE           AFB1004
*     COUNT OF ALIEN RECORDS IN THE FILE HAS ALSO BEEN REDUCED BY 1      AFB1004
*                                                                        AFB1004
*     IF THERE WAS A DELETION, AND THE AK FILE HAS A PARTNER MIP         AFB1004
*     FILE, ALL THE CORRESPONDING DELETIONS HAVE BEEN MADE IN THE        AFB1004
*     MIP FILE.                                                          AFB1004
*                                                                        AFB1004
*     FILE POSITION FOR PRIMARY KEY GETNEXT ETC., RECORDED               AFB1004
*     IN PTREEWRD[3] AND PTREEWRD[4], IS UNCHANGED.                      AFB1004
*                                                                        AFB1004
* DC  ERROR CONDITIONS                                                   AFB1004
*                                                                        AFB1004
*     EC445 - (NON-FATAL) THERE WAS NO RECORD CORRESPONDING TO           AFB1004
*       THE GIVEN KEY.                                                   AFB1004
*                                                                        AFB1004
* DC  CALLED ROUTINES                                                    AFB1004
*                                                                        AFB1004
*     INUP$AK - TO LOCATE THE RECORD CORRESPONDING TO THE KEY,           AFB1004
*       AND THE ALIEN RECORD TO WHICH IT POINTS, IF ANY. THE             AFB1004
*       POSITION OF THE MAIN RECORD IS NOTED IN PTREEWRD[0],             AFB1004
*       AND THAT OF THE ALIEN RECORD IF ANY IN PTREEWRD[1].              AFB1004
*       CURPTR IS LEFT=0 IF NO ALIEN, OR =1 IF ALIEN. RECFWA,            AFB1004
*       RECLWA, RECLNG DESCRIBE THE ALIEN IF ANY, ELSE THE               AFB1004
*       MAIN RECORD, AND THEY EXCLUDE THE PREFIX WORD IN AN              AFB1004
*       ALIEN.                                                           AFB1004
*     MSGZ$AA - TO ISSUE NON-FATAL ERROR MESSAGES.                       AFB1004
*     DLT$MP - IF THE AK FILE HAS A PARTNER MIP FILE, TO MAKE            AFB1004
*       ALL THE ALTERNATE KEY DELETIONS FOR THE RECORD RECFWA            AFB1004
*       POINTS TO, AND AFTERWARDS TO RESTORE US TO LOOKING AT            AFB1004
*       THE SAME BLOCK AND RECORD OF THE AK FILE AGAIN.                  AFB1004
*     DELL$AK - TO DELETE A LIVE RECORD FROM AN AK BLOCK.                AFB1004
*     CURR$AA - TO POSITION TO A BLOCK AND RECORD AS INDICATED           AFB1004
*       BY THE CURRENT WORD OF THE PTREE, BEING SURE IN ADVANCE          AFB1004
*       THAT THE NUMBERS IN THAT WORD ARE CORRECT.                       AFB1004
*     SLOG$AA - TO DO SOME SPECIAL LOGGING ACTIVITY IF FLAG             020400
*       SFLG IS SET IN THE FIT, IN ORDER TO SHOW THAT AN                020500
*       UPDATE INVOLVING MORE THAN ONE BLOCK IS BEGINNING.              020600
*                                                                        AFB1004
* DC  NON-LOCAL VARIABLES                                                AFB1004
*                                                                        AFB1004
*     QMF - RESULT SET BY INUP$AK, TO 0 IF THERE IS NO RECORD            AFB1004
*       FOR THIS KEY, NON-ZERO IF THERE IS. (ACTUALLY SET BY             AFB1004
*       LBK2$AK, CALLED BY INUP$AK.)                                     AFB1004
*     MIP - SET BY INUP$AK TO 0 IF THE AK FILE HAS NO MIP PARTNER,       AFB1004
*       OR NON-ZERO IF IT HAS.                                           AFB1004
*                                                                        AFB1004
* DC  NARRATIVE                                                          AFB1004
*                                                                        AFB1004
*     CALL INUP$AK TO FIND THE RECORD THE KEY POINTS TO, AND IF          AFB1004
*     THAT IS A MERE PLACE HOLDER, TO GO ON TO THE RECORD IT             AFB1004
*     POINTS TO. IF QMF=0, NO RECORD FOR THIS KEY, TRIVIAL ERROR.        AFB1004
*     ELSE, IF MIP IS NOT 0, CALL DLT$MP TO DO ALL THE MIP WORK          AFB1004
*     CONNECTED WITH DELETING THIS RECORD. DLT$MP WILL THEN              AFB1004
*     RETURN US TO THE BLOCK AND RECORD IN THE AK FILE,WHERE WE          AFB1004
*     WERE WHEN WE CALLED DLT$MP.                                        AFB1004
* 
*     BEFORE CALLING DLT$MP, IF THE DATA RECORD IS AN OVERFLOW
*     ONE, SHOWN BY CURPTR BEING 1, SET OUTKEY=1. THIS USUALLY
*     GIVES THE LENGTH OF A NON-EMBEDDED KEY AT THE START OF THE
*     RECORD, TO BE SKIPPED OVER BY DLT$MP. HERE WE USE IT TO 
*     INDICATE THE LENGTH OF THE BACK-POINTER AT THE BEGINNING
*     OF THE OVERFLOW RECORD. OUTKEY WAS SET TO 0 BY STMD$AA AND
*     HAS NOT BEEN TOUCHED SINCE. IT WILL BE RESTORED TO 0 WHEN 
*     STMD$AA(0) IS CALLED JUST BEFORE EXIT FROM DLT$MP.
*                                                                        AFB1004
*     CALL DELL$AK TO DELETE THE RECORD WE ARE AT, WHICH IS THE          AFB1004
*     ONE THAT CONTAINS THE REAL BODY OF INFORMATION. NOW IF             AFB1004
*     CURPTR=0, THIS WAS A NATIVE RECORD IN ITS PLACE. BUT IF            AFB1004
*     CURPTR=1, IT WAS AN ALIEN, AND PTREEWRD[0] POINTS TO ITS           AFB1004
*     MOTHER, WHICH MUST ALSO BE DELETED. IN THE LATTER CASE,            AFB1004
*     SET CURPTR=0 AND CALL CURR$AA TO LOCATE THE MOTHER (CURR$AA        AFB1004
*     NOT CURR$AK, BECAUSE WE ARE ALREADY CONFIDENT IN THE               AFB1004
*     MOTHER-S EXISTENCE, BECAUSE ALL THAT WAS CHECKED BY                AFB1004
*     INUP$AK.) THEN CALL DELL$AK TO DELETE THE MOTHER.                  AFB1004
*     FINALLY, INCREMENT THE COUNT OF DELETES ON THE FILE.               AFB1004
 #                                                                       AFB1004
          BEGIN  #DLT$AK CODE#                                           GAG0905
          INUP$AK;  #INITIALIZE FOR DELETE#                              GAG0905
          IF QMF EQ 0                                                    GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              MSGZ$AA(EC445);  #KEY NOT FOUND#                           GAG0905
              GOTO EXIT$AA;                                              GAG0905
              END                                                        GAG0905
          IF CURPTR NQ 0                                                020800
          THEN                                                          020900
              BEGIN                                                     021000
              SLOG$AA ;                                                 021100
              END                                                       021200
          IF MIP NQ 0                                                    GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              IF CURPTR NQ 0
              THEN
                  BEGIN 
                  OUTKEY = 1 ;
                  END 
              DLT$MP;  #PROCESS MIP DELETE#                              GAG0905
              END                                                        GAG0905
          DELL$AK;  #PROCESS THE LOGICAL DELETE#                         GAG0905
          IF CURPTR NQ 0                                                 GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              CURPTR = 0;                                                GAG0905
              CURR$AA;  #RETURN TO LEVEL 0 RECORD#                       GAG0905
              DELL$AK;  #DELETE OVERFLOW DESCRIPTOR#                     GAG0905
              END                                                        GAG0905
          FSDELCNT = FSDELCNT + 1;    #INCREMENT DELETE COUNT#           GAG0905
          RETURN;                                                        GAG0905
          END  #OF DLT$AK CODE#                                          GAG0905
CONTROL EJECT;                                                           GAG0905
PROC INUP$AK;                                                            GAG0905
          BEGIN                                                          GAG0905
 #                                                                       GAG0905
* *       INUP$AK                                PAGE  1                 GAG0905
* *       PROGRAM  - NRODAK                                              GAG0905
* *       R.P.NG.                               DATE.                    GAG0905
* 1CD     INUP$AK                                                        GAG0905
*                                                                        GAG0905
* CD      FUNCTION                                                       GAG0905
*                                                                        GAG0905
*         TO INITIALIZE FOR AN AK UPDATE.                                GAG0905
*                                                                        GAG0905
* CD      ENTRY CONDITIONS.                                              GAG0905
*                                                                        GAG0905
*     THE CALL TO INUP$AK IS THE FIRST STEP IN AN AK FILE DELETE,        AFB1004
*     PUT, OR REPLACE. SO THE INPUT CONDITIONS ARE ESSENTIALLY           AFB1004
*     AS FOR DLT$AK, PUT$AK, OR REPL$AK, AND FTCOP[0] CONTAINS           AFB1004
*     OPERATION CODE THAT DETERMINES WHICH. WHAT INUP$AK CHIEFLY         AFB1004
*     NEEDS IS THE INFORMATION FOR LOCATING THE KEY.                     AFB1004
*                                                                        GAG0905
* CD      EXIT CONDITIONS.                                               GAG0905
*                                                                        GAG0905
*     QMF = 0 IF THE GIVEN KEY DOES NOT CORRESPOND TO A LIVE             AFB1004
*       RECORD IN THE FILE.                                              AFB1004
*     OTHERWISE, CKEY CONTAINS THE KEY VALUE, RIGHT JUSTIFIED.           AFB1004
*     THIS HAS BEEN CONVERTED TO A BLOCK AND RECORD NUMBER IN            AFB1004
*     PTREEWRD[0], AND THE RECORD HAS BEEN LOCATED.                      AFB1004
*                                                                        AFB1004
*     IF CURPTR=0, THE RECORD IS SELF-CONTAINED.                         AFB1004
*     IF CURPTR=1, THAT RECORD WAS A PLACEHOLDER, THE POSITION           AFB1004
*       IT POINTS TO HAS BEEN INSERTED IN PTREEWRD[1], AND THE           AFB1004
*       ALIEN RECORD AT THAT POSITION HAS BEEN LOCATED AND IS            AFB1004
*       THE CURRENT RECORD. ITS BACKPOINTER HAS BEEN VERIFIED,           AFB1004
*       AND THE UCC FIELD OF RECPTR HAS BEEN REPLACED BY THE             AFB1004
*       TRUE VALUE FROM THE FIRST WORD OF THE RECORD.                    AFB1004
*                                                                        AFB1004
*     MIP = 0 IF THE AK FILE HAS NO MIP PARTNER, OR NON-                 AFB1004
*       ZERO IF IT DOES.                                                 AFB1004
*     IN EVERY FIAT THAT IS NOW ACTIVE AND ADDRESSES THIS AK             AFB1004
*       FILE AND/OR ITS MIP PARTNER IF ANY, FASEEKEY1[0] HAS             AFB1004
*       BEEN SET TO 0, AND FAALTPOS[0] HAS BEEN SET TO 1.                AFB1004
*       THIS HAS THE EFFECT OF TELLING ANY OPERATION THAT MIGHT          AFB1004
*       DEPEND ON A POSITION AS RECORDED IN A PTREE, OR ON THE           AFB1004
*       RESULTS OF A PREVIOUS SEEK, THAT THE FILE HAS BEEN ALTERED       AFB1004
*       AND SUCH THINGS ARE NOT TO BE RELIED ON.                         AFB1004
*                                                                        AFB1004
*     FTRRL HAS BEEN COPIED TO FTRL. THIS IS THE LENGTH OF               AFB1004
*       THE NEW RECORD, IF ANY. FOR SOME REASON IT COMES                 AFB1004
*       IN FTRRL, THOUGH THE USER PUT IT IN FTRL AND WE                  AFB1004
*       WANT IT THERE.                                                   AFB1004
*                                                                        GAG0905
* CD      ERROR CONDITIONS.                                              GAG0905
*                                                                        GAG0905
*         THOSE REPORTED BY VOKM$AA.                                     GAG0905
*     EC553 - (FATAL) IF THE KEY POINTS TO A PLACEHOLDER, AND            AFB1004
*       THE RECORD THE PLACEHOLDER POINTS TO IS NON-EXISTENT             AFB1004
*       OR DEAD, OR DOES NOT HAVE A CORRECT BACK-POINTER.                AFB1004
*                                                                        GAG0905
* CD      CALLED ROUTINES.                                               GAG0905
*                                                                        GAG0905
*     VOKM$AA - TO VERIFY IF UPDATE IS ALLOWED                           AFB1004
*     LBK2$AK - IF THIS IS A DELETE (HENCE NO NEW RECORD                 AFB1004
*       OFFERED), TO LOCATE THE KEY, TRANSLATE IT TO BLOCK AND           AFB1004
*       SLOT, INSERT THEM IN PTREEWRD[0], AND LOCATE THE BLOCK           AFB1004
*       AND RECORD.                                                      AFB1004
*     LBK$AK - THE SAME IF THIS IS A REPLACE OR PUT, WHERE THE           AFB1004
*       KEY MIGHT BE PART OF THE NEW RECORD.                             AFB1004
*     FIXX$AA - TO FREEZE A BLOCK CONTAINING A MOTHER RECORD,            AFB1004
*       SO THAT IT WONT GET KICKED OUT WHILE WE READ THE                 AFB1004
*       DAUGHTER ALIEN RECORD IN ANOTHER BLOCK. WE WANT BOTH             AFB1004
*       IN CORE AT ONCE.                                                 AFB1004
*     UNFX$AA - TO UNFREEZE IT, ONCE THE DAUGHTER HAS BEEN               AFB1004
*       READ.                                                            AFB1004
*     CURR$AK - TO LOCATE A BLOCK AND RECORD ACCORDING TO                AFB1004
*       A PTREE WORD, BUT GUARDING AGAINST POSSIBLE INVALID              AFB1004
*       BLOCK OR RECORD NUMBER.                                          AFB1004
*     MACH$AK - TO CHECK THE CORRECTNESS OF A BACKPOINTER.               AFB1004
*     MSGF$AA - TO ISSUE A FATAL ERROR.                                  AFB1004
*     VOID - TO CLEAR FASEEKEY1[0] AND SET FAALTPOS[0] IN                AFB1004
*       EVERY FIAT CURRENTLY CONNECTED WITH A GIVEN FSTT.                AFB1004
*                                                                        AFB1004
* DC  NON-LOCAL VARIABLES                                                AFB1004
*                                                                        AFB1004
*     NONE                                                               AFB1004
*                                                                        GAG0905
* CD      DESCRIPTION.                                                   GAG0905
*                                                                        GAG0905
*         FIRST, SET FTRL TO FTRRL TO GET READY FOR PUT OR REPLACE.      GAG0905
*         CALL VOKM$AA TO VALIDATE THE UPDATE REQUEST.  SET UP AND       GAG0905
*         CALL LOCR$AK TO LOCATE THE RECORD.  FAALTPOS IS SET TO 1 TO    GAG0905
*         INDICATE THAT POSITION ON THIS FIT IS NO LONGER VALID.  MIP IS GAG0905
*         SET TO FSMIPWORD, WHICH WILL BE NON ZERO IS MIP IS INVOLVED.   GAG0905
 #                                                                       GAG0905
          FTRL=FTRRL;                                                    GAG0905
          NEWLNG = FTRL;  #NEW REC LNG SET TO FTRL#                      GAG0905
          VOKM$AA;  #VERIFY OK TO MODIFY FILE#                           GAG0905
          NEWFWA = FTWSA[0] ;                                            GAG0905
          CURPTR = 0 ;                                                   GAG0905
          IF FTCOP[0] EQ OP"DLT"                                         GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              LBK2$AK ;                                                  GAG0905
              END                                                        GAG0905
          ELSE                                                           GAG0905
              BEGIN                                                      GAG0905
              LBK$AK ;                                                   GAG0905
              END                                                        GAG0905
          IF PTCURBLK[CURPTR] EQ O"77777777"
          THEN
            BEGIN 
            MSGZ$AA (EC442) ;      # INVALID ACTUAL KEY # 
            GOTO EXIT$AA ;
            END 
          IF RPUCC EQ OVERFLOW                                           GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              FIXX$AA ( P<BLOK$AA> , 0 ) ;                               GAG0905
              CURPTR = 1 ;                                               GAG0905
              PTREEWRD[1] = W[RECFWA] ;                                  GAG0905
              CURR$AK ;                                                  GAG0905
              UNFX$AA ( 0 ) ;                                            AFB1004
              IF QMF EQ 0 OR MACH$AK NQ 0                                GAG0905
              THEN                                                       GAG0905
                  BEGIN                                                  GAG0905
                  MSGF$AA ( EC553 ) ;                                    GAG0905
                  GOTO EXIT$AA ;                                         GAG0905
                  END                                                    GAG0905
              RPUCC = B<0,4>W[RECFWA] ;                                  GAG0905
              END                                                        GAG0905
          MIP = FSMIPWORD[0] ;                                           GAG0905
          VOID ( 0 ) ;                                                   GAG0905
          IF FSMIPFSTT[0] NQ 0                                           GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              VOID ( FSMIPFSTT[0]-P<FSTT$AA> ) ;                         GAG0905
              END                                                        GAG0905
          END                                                            GAG0905
                                                                         GAG0905
PROC VOID ( X ) ;                                                        GAG0905
 #                                                                       AFB1004
* *   VOID - VOID CURRENT PTREE AND SEEK POSITIONS                       AFB1004
*                                                                        AFB1004
*     THIS SUBROUTINE IS SEPARATED FROM INUP$AK JUST BECAUSE             AFB1004
*     THE SAME LOOP HAS TO BE GONE THROUGH FOR TWO DIFFERENT             AFB1004
*     FILES. THE INCOMING PARAMETER IS THE DIFFERENCE BETWEEN            AFB1004
*     P<FSTT$AA> AND THE ADDRESS OF THE FSTT OF THE FILE TO              AFB1004
*     BE TREATED. WE FOLLOW THE CHAIN OF FIT POINTERS                    AFB1004
*     THAT IS ATTACHED TO THAT FSTT, FIND THE FIAT BELONGING             AFB1004
*     TO EVERY FIT, AND MAKE TWO CHANGES IN THE FIAT.                    AFB1004
 #                                                                       AFB1004
          BEGIN                                                          GAG0905
          ITEM X ;                                                       GAG0905
                                                                         GAG0905
          FOR IX = FSFTCHN[X] WHILE IX NQ 0                              GAG0905
          DO                                                             GAG0905
              BEGIN                                                      GAG0905
              IX = IX - P<FIT$AA> ;                                      GAG0905
              T1 = FTFIAT[IX] - P<FIAT$AA> ;                             GAG0905
              FASEEKEY1[T1] = 0 ;                                        GAG0905
              FAALTPOS[T1] = 1 ;                                         GAG0905
              IX = FTFTCH[IX] ;                                          GAG0905
              END                                                        GAG0905
          END                                                            GAG0905
PROC NUBL$AK;   CONTROL EJECT;                                           GAG0905
          BEGIN                                                          GAG0905
 #                                                                       GAG0905
* *       NUBL$AK                                PAGE  1                 GAG0905
* *       PROGRAM - NRO$AK                                               GAG0905
* *       R.P.NG.                               DATE.                    GAG0905
* 1CD     NUBL$AK                                                        GAG0905
*                                                                        GAG0905
*         FUNCTION                                                       GAG0905
*                                                                        GAG0905
*         TO CREATE A NEW BLOCK AT THE END OF THE FILE IF POSSIBLE.      GAG0905
*                                                                        GAG0905
* CD      ENTRY CONDITIONS                                               GAG0905
*                                                                        GAG0905
*         P<FSTT$AA> MUST BE SET TO THE FILE IN QUESTION.                GAG0905
*                                                                        GAG0905
* CD      EXIT CONDITIONS                                                GAG0905
*                                                                        GAG0905
*         NEWBNUM IS 0 IF A BLOCK CANNOT BE CREATED BECAUSE WE HAVE      GAG0905
*         REACHED THE LIMIT OF BLOCKS THAT CAN BE DISCRIBED BY THE       GAG0905
*         ACUTAL KEY SIZE DEFINED.                                       GAG0905
*         IF A BLOCK IS CREATED, P<BLOK$AA> WILL POINT TO THE FRAME      GAG0905
*         OF THE BLOCK CREATED.  NEWBNUM WILL HAVE THE NEW BLOCK         GAG0905
*         NUMBER.                                                        GAG0905
*                                                                        GAG0905
* CD      ERROR CONDITIONS.                                              GAG0905
*                                                                        GAG0905
*         NONE                                                           GAG0905
*                                                                        GAG0905
* CD      CALLED ROUTINES.                                               GAG0905
*                                                                        GAG0905
*         MXPR$AA - A FUNCTION THAT GIVES THE PRU NUMBER AT              AFB1004
*           LOGICAL EOI.                                                 AFB1004
*         NUBL$AA - EXTEND THE FILE BY A NEW BLOCK AT EOI                AFB1004
*           (OR A BLOCK FROM THE EMPTY CHAIN -- BUT THERE IS NO          AFB1004
*           EMPTY CHAIN IN AN AK FILE.)                                  AFB1004
*         UNFX$AA - FOR REASONS THAT ARE IRRELEVANT FOR AN AK FILE,      AFB1004
*           NUBL$AA FREEZES THE NEW BLOCK. UNFX$AA IS CALLED HERE        AFB1004
*           TO UNFREEZE IT IMMEDIATELY, AND PUT IT INTO THE KICKOUT      AFB1004
*           CHAIN.                                                       AFB1004
*                                                                        GAG0905
* CD      DESCRIPTION.                                                   GAG0905
*                                                                        GAG0905
*         IF THE FILE HAS ALREADY REACHED ITS MAXIMUM POSSIBLE LENGTH,   AFB1004
*         DO NOTHING. OTHERWISE, CALL NUBL$AA TO ADD A NEW EMPTY BLOCK   AFB1004
*         AT EOI, THEN UNFX$AA TO UNDO THE FIXX$AA IMPLICIT IN           AFB1004
*         NUBL$AA, THEN ADJUST THE PERCENT-EMPTY TABLE -- WE HAVE A      AFB1004
*         NEW 100-PERCENT-EMPTY BLOCK, SO INCREASE BY 1 THE COUNT        AFB1004
*         OF SUCH BLOCKS IN THE TABLE.                                   AFB1004
 #                                                                       GAG0905
          IF MXPR$AA LS FSLSTPRU[0]                                      GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              NUBL$AA ( 0 ) ;                                            GAG0905
              UNFX$AA ( 0 ) ;                                            GAG0905
              FSPCEMTAB[10] = FSPCEMTAB[10] + 1 ;                        GAG0905
              END                                                        GAG0905
          ELSE
              BEGIN 
              NEWBNUM = 0 ; 
              END 
          END                                                            GAG0905
PROC PCEM$AK ;        CONTROL EJECT ;                                    GAG0905
          BEGIN                                                          GAG0905
 #                                                                       GAG0905
* *   PCEM$AK -- UPDATE THE PERCENT BLOCK EMPTY TABLE     PAGE 1         GAG0905
* *   G.B.KINGSLAND                                                      GAG0905
* 1DC PCEM$AK                                                            AFB1004
*                                                                        GAG0905
* DC  FUNCTION                                                           GAG0905
*                                                                        GAG0905
*     TO UPDATE THE PERCENT EMPTY TABLE AFTER A BLOCK HAS BEEN UPDATED.  GAG0905
*                                                                        GAG0905
* DC  ENTRY CONDITIONS                                                   GAG0905
*                                                                        GAG0905
*     P<BLOK$AA> POINTS TO THE BLOCK IN QUESTION.                        AFB1004
*     OLDEC CONTAINS THE VALUE THAT EC HAD, IN THIS BLOCK, BEFORE 
*     THE ALTERATION BEGAN, I.E. THE VALUE THAT DETERMINES WHICH WORD    AFB1004
*     OF THE PERCENT-EMPTY TABLE HAS HELD UNTIL NOW THE COUNT FOR THIS   AFB1004
*     BLOCK. HOWEVER, OLDEC=0 IF THIS BLOCK HAD NO AVAILABLE SLOT.
*                                                                        AFB1004
* DC  EXIT CONDITIONS                                                    AFB1004
*                                                                        AFB1004
*     THE PERCENT-EMPTY TABLE WORD CORRESPONDING TO OLDEC HAS BEEN
*     COUNTED DOWN BY 1, AND THE WORD CORRESPONDING TO THE CURRENT (NEW) AFB1004
*     VALUE OF EC IN THE BLOCK HAS BEEN COUNTED UP BY 1.                 AFB1004
*     HOWEVER, THE NEW VALUE OF EC IS TREATED AS 0, IF THERE ARE
*     NOW NO AVAILABLE SLOTS IN THE BLOCK.
*                                                                        GAG0905
 #                                                                       GAG0905
          DEF INCENTRY        #(+1)#;                                    GAG0905
          DEF DECENTRY        #(-1)#;                                    GAG0905
          DEF PETABLE( SP )   #FSPCEMTAB[ SP*10/MAXMT ]#;                GAG0905
          DEF ADJTAB( ID,SP ) #PETABLE( SP ) = PETABLE( SP ) + ID#;      GAG0905
                                                                         GAG0905
          T1 = EC ; 
          IF BLFRESLTS EQ 0 AND RC EQ FSBKFACTR 
          THEN
              BEGIN 
              T1 = 0 ; #NO AVAILABLE SLOTS# 
              END 
          ADJTAB ( INCENTRY , T1 ) ;
          ADJTAB ( DECENTRY , OLDEC ) ; 
          END #PCEM$AK#                                                  GAG0905
PROC POINTER ;     CONTROL EJECT ;                                       GAG0905
 #                                                                       AFB1004
* *   POINTER - PUT A POINTER IN THIS RECORD                  PAGE 1     AFB1004
* *   A.F.R.BROWN                                                        AFB1004
* 1DC POINTER                                                            AFB1004
*                                                                        AFB1004
* DC  FUNCTION                                                           AFB1004
*                                                                        AFB1004
*     TO MAKE THE FIRST WORD OF THE CURRENT RECORD A POINTER TO ITS      AFB1004
*     PARTNER IN A PLACEHOLDER-ALIEN PAIR.                               AFB1004
*                                                                        AFB1004
* DC  ENTRY CONDITIONS                                                   AFB1004
*                                                                        AFB1004
*     RECFWA IS THE FWA OF THE CURRENT RECORD, WHICH IS EITHER           AFB1004
*       A PLACEHOLDER OR AN ALIEN RECORD, NOT A NATIVE SELF-CONTAINED    AFB1004
*       RECORD.                                                          AFB1004
*     CURPTR = 0 IF THE CURRENT RECORD IS A PLACEHOLDER, OR 1 IF IT IS   AFB1004
*       AN ALIEN. PTREEWRD[CURPTR] CONTAINS THE RECORD NUMBER AND THE    AFB1004
*       BLOCK PRU NUMBER OR BLOCK ADDRESS, ACCORDING TO PTBLKIN,         AFB1004
*       FOR THE CURRENT RECORD.                                          AFB1004
*     PTREEWRD[1-CURPTR] CONTAINS THE SAME FOR THE PARTNER OF THE        AFB1004
*       CURRENT RECORD.                                                  AFB1004
*     RECPTR CONTAINS A COPY OF THE RECORD POINTER FOR                   AFB1004
*       THE CURRENT RECORD, SET UP WITH THE TRUE UCC IN                  AFB1004
*       ITS RPUCC FIELD.                                                 AFB1004
*     RNO IS THE RECORD NUMBER OF THE CURRENT RECORD.                    AFB1004
*                                                                        AFB1004
* DC  EXIT CONDITIONS                                                    AFB1004
*                                                                        AFB1004
*     THE FIRST WORD OF THE CURRENT RECORD HAS BEEN REPLACED             AFB1004
*     BY A COPY OF THE PTREEWRD FOR THE PARTNER RECORD, IN A             AFB1004
*     FORM CONTAINING A BLOCK PRU NUMBER RATHER THAN A BLOCK             AFB1004
*     ADDRESS.                                                           AFB1004
*                                                                        AFB1004
*     IF THE CURRENT RECORD IS AN ALIEN, THE LEFT 4 BITS OF              AFB1004
*     THAT WORD CONTAIN THE REAL UCC OF THE RECORD, TAKEN                AFB1004
*     FROM THE RPUCC FIELD AS IT WAS ON ENTRY.                           AFB1004
*                                                                        AFB1004
*     THE RECORD POINTER OF THE CURRENT RECORD, IN THE BLOCK             AFB1004
*     IMAGE, HAS BEEN REPLACED BY RECPTR, AND IF THE RECORD              AFB1004
*     IS AN ALIEN, THE RPUCC FIELD OF THE RECORD POINTER HAS THE         AFB1004
*     VALUE 14 (ALIEN). OTHERWISE THE CURRENT RECORD IS A                AFB1004
*     PLACEHOLDER, AND THE RPUCC FIELD OF THE RECORD POINTER HAS         AFB1004
*     THE VALUE 13 (OVERFLOW).                                           AFB1004
*                                                                        AFB1004
*     NOTE THAT WE DONT WORRY ABOUT CALLING ALTR$AA OR                   AFB1004
*     SETTING AND RESETTING BLCIP[0] FOR THIS ALTERATION,                AFB1004
*     BECAUSE THE BLOCK CANT HAVE BEEN WRITTEN TO DISK                   AFB1004
*     SINCE THESE FORMALITIES WERE LAST COMPLETED, AND HERE              AFB1004
*     WE JUST CHANGE ONE WORD, WHICH COULD NOT BE LEFT HALF-             AFB1004
*     COMPLETED BY A SYSTEM CRASH.                                       AFB1004
*                                                                        AFB1004
* DC  ERROR CONDITIONS                                                   AFB1004
*                                                                        AFB1004
*     NONE                                                               AFB1004
*                                                                        AFB1004
* DC  CALLED ROUTINES                                                    AFB1004
*                                                                        AFB1004
*     NONE                                                               AFB1004
*                                                                        AFB1004
* DC  NON-LOCAL VARIABLES                                                AFB1004
*                                                                        AFB1004
*     NONE                                                               AFB1004
 #                                                                       AFB1004
          BEGIN                                                          GAG0905
          ITEM X , Y ;                                                   GAG0905
          Y = 1 - CURPTR ;                                               GAG0905
          X = PTREEWRD[Y] ;                                              GAG0905
          IF PTBLKIN[Y] NQ 0                                             GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              PTCURBLK[Y] = BLOCKID[PTCURBADR[Y]-P<BLOK$AA>] ;           GAG0905
              END                                                        GAG0905
          IF Y EQ 0                                                      GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              B<0,4>PTREEWRD[0] = RPUCC ;                                GAG0905
              RPUCC = ALIEN ;                                            GAG0905
              END                                                        GAG0905
          ELSE                                                           GAG0905
              BEGIN                                                      GAG0905
              RPUCC = OVERFLOW ;                                         GAG0905
              END                                                        GAG0905
          W[RECFWA] = PTREEWRD[Y] ;                                      GAG0905
          PTREEWRD[Y] = X ;                                              GAG0905
          RPPT$AA ( RNO ) ;                                              GAG0905
          END                                                            GAG0905
PROC PUT$AK;                           CONTROL EJECT;                    GAG0905
          BEGIN                                                          GAG0905
 #                                                                       GAG0905
* *   PUT$AK - PUT AN AK RECORD                                   PAGE 1 GAG0905
* *   PROGRAM - NRO$AK                                                   GAG0905
* *   G.B.KINGSLAND                                                      GAG0905
* *   G.A.GREENE(PUT WITH KEY)                  DATE.                    GAG0905
* 1CD PUT$AK                                                             GAG0905
*                                                                        GAG0905
* CD  FUNCTION                                                           GAG0905
*                                                                        GAG0905
*     TO PUT A RECORD INTO AN ACTUAL KEY FILE.                           GAG0905
*                                                                        GAG0905
* CD  ENTRY CONDITIONS                                                   GAG0905
*                                                                        GAG0905
*     P<FIT$AA> MUST BE SET.                                             GAG0905
*     P<FIAT$AA> MUST BE SET.                                            GAG0905
*     P<FSTT$AA> MUST BE SET.                                            GAG0905
*     FTCOP IN FIT MUST BE SET TO THE PUT OPERATION CODE.                GAG0905
*     WSA IN THE FIT IS THE FWA OF THE NEW RECORD, AND RRL IN THE        AFB1004
*       FIT IS ITS LENGTH IN CHARACTERS.                                 AFB1004
*     IF THE FILE USES NON-EMBEDDED KEYS, KA AND KP IN THE FIT           AFB1004
*       GIVE THE ADDRESS AND THE CHARACTER OFFSET AT WHICH THE KEY       AFB1004
*       VALUE BEGINS.                                                    AFB1004
*     IF THE KEY IS NOT 0, IT INDICATES WHAT POSITION IN THE FILE        AFB1004
*       THE RECORD IS TO BE STORED AT. IF IT IS 0, THE RECORD CAN        AFB1004
*       BE STORED AT ANY CONVENIENT POSITION, AND THE KEY VALUE          AFB1004
*       CORRESPONDING TO THIS POSITION MUST BE RETURNED IN               AFB1004
*       THE KEY AREA.                                                    AFB1004
*     IF THE KEY IS EMBEDDED, THE KEY VALUE MUST BE INSERTED IN THE      AFB1004
*       RECORD SO THAT IT WILL BE THERE WHENEVER THE RECORD IS READ      AFB1004
*       IN FUTURE. BUT IF THE KEY IS NON-EMBEDDED, YET HAPPENS TO BE     AFB1004
*       WITHIN THE RECORD BECAUSE KA POINTS TO A WORD THAT IS IN FACT    AFB1004
*       WITHIN THE RECORD, THE VALUE IS NOT INSERTED AND THE FIELD       AFB1004
*       IS 0 ON DISK.                                                    AFB1004
*                                                                        GAG0905
* CD  EXIT CONDITIONS                                                    GAG0905
*                                                                        GAG0905
*     THE RECORD IS PUT INTO THE FILE AND THE TOTAL NUMBER OF PUTS IS    GAG0905
*     INCREMENTED BY ONE.                                                GAG0905
*                                                                        AFB1004
*     IN CASE OF PUT WITHOUT KEY, THE PRIMARY KEY VALUE                  AFB1004
*       IS RETURNED. IF KEYS ARE NON-EMBEDDED, THE VALUE                 AFB1004
*       IS RETURNED WHEREVER KA AND KP POINT. IF EMBEDDED,               AFB1004
*       THE VALUE IS RETURNED TO THE KEY AREA OF THE RECORD,             AFB1004
*       I.E. THE RECORD WHICH THE USER SUPPLIED AT WSA.                  AFB1004
*     FILE POSITION FOR PRIMARY-KEY GETNEXT ETC., RECORDED               AFB1004
*       IN PTREEWRD[3] AND PTREEWRD[4], IS UNCHANGED.                    AFB1004
*                                                                        GAG0905
* CD  ERROR CONDITIONS                                                   GAG0905
*                                                                        GAG0905
*     EC250 - FILE RMS LIMIT EXCEEDED.                                   GAG0905
*     EC253 - FILE RECORD COUNT EXCEEDED
*     EC503 - DUP ALT KEY ERROR.                                         GAG0905
*     EC446 - DUPLICATE PRIMARY KEY.                                     AFB1004
*                                                                        GAG0905
* CD  CALLED ROUTINES                                                    GAG0905
*                                                                        GAG0905
*     INUP$AK - INITIALIZE FOR AN AK UPDATE.                             GAG0905
*     CMRC$AA - TO COMPRESS THE RECORD IF NECESSARY.                     AFB1004
*     SPAC$AK - FIND A BLOCK WITH ENOUGH SPACE.                          GAG0905
*     MSGZ$AA - DIAGNOSE AN ERROR CONDITION.                             GAG0905
*     DUPK$AA - TO ISSUE ERROR MESSAGE FOR DUP KEYS 
*     PWOK$AK - PUT AK RECORD WITHOUT KEY.                               GAG0905
*     MOVC$AA - MOVE A CHARACTER STRING.                                 AFB1004
*     MXPR$AA - A FUNCTION THAT GIVES THE PRU NUMBER AT LOGICAL          AFB1004
*       EOI.                                                             AFB1004
*     NUBL$AK - ADD A NEW BLOCK TO AN AK FILE.                           AFB1004
*     MALR$AK (CALLED MALRDAK) - MOVE THE CURRENT RECORD OUT             AFB1004
*       OF ITS SLOT, IN WHICH IT IS AN ALIEN, BECAUSE WE HAVE            AFB1004
*       TO PUT BY KEY INTO THAT SLOT.                                    AFB1004
*     RCKN$AK - DECIDE WHETHER THE CURRENT BLOCK HAS ROOM FOR            AFB1004
*       THE NEW RECORD, AND IF NECESSARY CALL CONS$AA TO SQUEEZE         AFB1004
*       OUT EMPTY RECORDS AND CONSOLIDATE THE SPACE.                     AFB1004
*     MKRM$AK (CALLED MKRMDAK) - MAKE ROOM IN THE CURRENT                AFB1004
*       BLOCK FOR THE NEW RECORD, OR AT LEAST FOR A ONE-WORD             AFB1004
*       PLACEHOLDER THAT COULD POINT TO IT.                              AFB1004
*     ZIPMIP - DO THE MIP WORK CONNECTED WITH THIS PUT, IF               AFB1004
*       NECESSARY.                                                       AFB1004
*     SEBL$AA - LOCATE IN CORE THE IMAGE OF THE BLOCK TO WHICH           AFB1004
*       A GIVEN PTREE WORD POINTS.                                       AFB1004
*     RLOV$AK - IF THE NEW RECORD HAS BEEN STORED SOMEWHERE AS           AFB1004
*       AN ALIEN BY PWOK$AK, TO STORE THE CORRESPONDING PLACE-           AFB1004
*       HOLDER IN THE PROPER SLOT.                                       AFB1004
*     SETR$AK - TO POSITION IN THE CURRENT BLOCK, AT A RECORD            AFB1004
*       SPECIFIED BY NUMBER, AND IF THIS IS BEYOND RC, TO ADD            AFB1004
*       ENOUGH EXTRA DEAD RECORD POINTERS SO THAT IT IS NO               AFB1004
*       LONGER BEYOND RC.                                                AFB1004
*     ADRC$AK - TO PUT A RECORD IN AN AK BLOCK, AND ADJUST THE           AFB1004
*       MOST-EMPTY AND PERCENT-EMPTY TABLES.                             AFB1004
*     SLOG$AA - TO DO SOME SPECIAL LOGGING ACTIVITY IF FLAG             021400
*       SFLG IS SET IN THE FIT, IN ORDER TO SHOW THAT AN                021500
*       UPDATE INVOLVING MORE THAN ONE BLOCK IS BEGINNING.              021600
*                                                                        GAG0905
* CD  DESCRIPTION                                                        GAG0905
*                                                                        GAG0905
*     FIRST CHECK FLM TO SEE THAT THIS PUT WOULD NOT EXCEED THE FILE
*     LIMIT. NEXT CALL INUP$AK TO LOCATE THE POSITION SPECIFIED BY THE
*     KEY, IF NON-ZERO. IF QMF IS NOT ZERO ON RETURN, THERE IS           AFB1004
*     ALREADY A RECORD IN THAT SLOT, SO WE TAKE A NON-FATAL ERROR        AFB1004
*     EXIT. OTHERWISE, CALL CMRC$AA TO COMPRESS THE RECORD IF            AFB1004
*     NECESSARY, AND SET CURPTR=0. NOW PTREEWRD[0] POINTS TO THE         AFB1004
*     BLOCK AND RECORD POSITION WHERE WE WILL TRY TO PUT THE             AFB1004
*     RECORD.                                                            AFB1004
 #                                                                       GAG0905
          ITEM SVNEWFWA;  #STORAGE FOR NEWFWA#                           GAG0905
          ITEM Q , X , Y , Z ;                                           GAG0905
                                                                         GAG0905
          IF FTFLM[0] LQ FSRECCNT[0]
          THEN
              BEGIN 
              MSGZ$AA ( EC253 ) ; 
              RETURN; 
              END 
          NEWBNUM = 0;
          INUP$AK;                                                       GAG0905
 #                                                                      021800
*     IN OTHER SITUATIONS, AN OPERATION THAT ALTERS BOTH A DATA         021900
*     AND A MIP FILE WILL FINISH THE ACTUAL ALTERATIONS ON THE          022000
*     MIP FILE BEFORE BEGINNING THOSE ON THE DATA FILE. THEN IT         022100
*     IS ENOUGH TO CALL SLOG$AA (IT MUST BE CALLED BECAUSE THE          022200
*     TOTAL NUMBER OF BLOCKS TO BE CHANGED BY THE OPERATION IS          022300
*     MORE THAN ONE) THE FIRST TIME SUBROUTINE ALTR$AA IS CALLED        022400
*     FOR A MIP FILE BLOCK. BUT HERE, IN AN AK PUT, IT MAY BE           022500
*     (IF A PUT WITHOUT KEY) THAT THE DATA FILE WILL BE ALTERED         022600
*     BEFORE THE MIP FILE (BECAUSE THE PRIMARY KEY VALUE IS NOT         022700
*     KNOWN UNTIL THE DATA FILE HAS BEEN MASSAGED). SO WE MAKE          022800
*     A SPECIAL TEST OF WHETHER A MIP FILE IS PRESENT, AND CALL         022900
*     SLOG$AA IF SO, BEFORE ALTERING ANY BLOCKS AT ALL.                 023000
 #                                                                      023100
          IF MIP NQ 0                                                   023200
          THEN                                                          023300
              BEGIN                                                     023400
              SLOG$AA ;                                                 023500
              END                                                       023600
          IF QMF NQ 0                                                    AFB1004
          THEN                                                           AFB1004
              BEGIN                                                      AFB1004
              DUPK$AA ( EC446 ) ; 
              GOTO EXIT$AA ;                                             AFB1004
              END                                                        AFB1004
          CMRC$AA ;                                                      GAG0905
          CURPTR = 0 ;                                                   GAG0905
          IF CKEY EQ 0                                                   GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
 #                                                                       GAG0905
* 0   IF CKEY IS 0, THIS IS A PUT WITHOUT KEY, SO CALL SPAC$AK           AFB1004
*     TO FIND A BLOCK THAT HAS ENOUGH SPACE TO ACCEPT A NEW              AFB1004
*     RECORD OF NEWLNG CHARACTERS (NEWLNG WAS SET BY CMRC$AA             AFB1004
*     WHETHER WE COMPRESS OR NOT.) IF NO ROOM IN THE FILE, JUST          AFB1004
*     RETURN. THE ERROR MESSAGE HAS BEEN GIVEN BY SPAC$AK.
*     OTHERWISE CALL PWOK$AK TO FIND A FREE SLOT IN THE CURRENT          AFB1004
*     BLOCK AND PUT THE RECORD THERE. (THIS IS THE ONLY PLACE WHERE      AFB1004
*     PWOK$AK IS CALLED TO PUT A NATIVE RECORD. EVERYWHERE ELSE IT       AFB1004
*     HAS TO PUT AN ALIEN RECORD. PWOK$AK KNOWS THE DIFFERENCE           AFB1004
*     BECAUSE HERE CURPTR=0, AND IN ALL THE OTHER CASES CURPTR=1.)       AFB1004
*     ON RETURN, CONSTRUCT THE PRIMARY KEY VALUE FROM THE BLOCK AND      AFB1004
*     RECORD NUMBERS, AND PUT IT IN CKEY. NOW IF KEYS ARE OFFICIALLY     AFB1004
*     EMBEDDED IN THIS FILE, THE RECORD HAS ALREADY BEEN PUT INTO        AFB1004
*     THE BLOCK IMAGE WITH 0 IN THE KEY FIELD. BUT RECFWA STILL          AFB1004
*     POINTS TO THE RECORD IN THE BLOCK IMAGE, SO WE CAN EASILY          AFB1004
*     INSERT THE KEY NOW. NOTE THAT WE DONT CALL ALTR$AA BEFORE          AFB1004
*     MAKING THIS CHANGE TO THE BLOCK IMAGE, BECAUSE IT WAS              AFB1004
*     CALLED DURING THE PWOK$AK PROCESS, AND THE BLCIP[0] FLAG           AFB1004
*     WAS CLEARED AT THE END OF PWOK$AK. THE BLOCK IMAGE CANNOT          AFB1004
*     HAVE BEEN WRITTEN TO DISK SINCE THEN, SO ONE MOTIVE FOR            AFB1004
*     CALLING ALTR$AA, TO SET THE ((ALTERED)) FLAG, IS MISSING.          AFB1004
*     THE OTHER MOTIVE IS TO SET THE BLCIP[0] FLAG. BUT WE EXPECT        AFB1004
*     THAT IN PRACTICE THE KEY, IF EMBEDDED (WHICH WILL BE RARE ENOUGH)  AFB1004
*     WILL NEVER CROSS A WORD BOUNDARY, SO THAT MOVC$AA WILL ONLY ALTER  AFB1004
*     ONE WORD IN THE BLOCK IMAGE. HENCE THERE IS NO WAY A SYSTEM CRASH  AFB1004
*     COULD LEAVE THIS CHANGE PARTLY MADE. ALSO, IF KEYS ARE             AFB1004
*     EMBEDDED, RETURN THE KEY TO ITS EMBEDDED PLACE IN THE              AFB1004
*     RECORD AREA BEGINNING AT WSA.                                      AFB1004
*     CALL ZIPMIP TO PUT THE ALTERNATE KEY VALUES IN THE MIP FILE. THE
*     PARAMETER IS 1, TELLING ZIPMIP THAT IF THERE IS A FORBIDDEN 
*     DUPLICATION OF ALTERNATE KEY VALUES, THIS RECORD MUST BE
*     DELETED FROM THE MAIN FILE BEFORE DECLARING THE ERROR.
*                                                                        AFB1004
*     ON THE OTHER HAND, IF KEY IS NON-EMBEDDED BUT KA, TELLING WHERE    AFB1004
*     THE NEW KEY MUST BE RETURNED TO THE CALLER, HAPPENS TO POINT INTO  AFB1004
*     THE RECORD AREA, THIS IS NOT REFLECTED IN THE RECORD IMAGE         AFB1004
*     ON DISK, SO WE RETURN THE KEY TO KA AFTER PWOK$AK HAS COMPLETED    AFB1004
*     ITS WORK, AND ZIPMIP HAS COMPLETED ITS WORK, WITHOUT AFFECTING
*     THE BLOCK IMAGE, OR THE RECORD AS ZIPMIP SEES IT (SINCE POSSIBLY
*     AN ALTERNATE KEY FIELD OVERLAPS THE AREA KA POINTS TO.) 
*     BEFORE CALLING ZIPMIP WE MUST ALTER KEYFWA AND KEYOFF TO POINT
*     TO WHERE THE KEY REALLY IS, SINCE THE MIP ROUTINES DEPEND ON THEM 
*     FOR THE PRIMARY KEY VALUE. HITHERTO KEYFWA WAS = FTKA, WHICH IN THE 
*     NON-EMBEDDED CASE STILL POINTS TO A ZERO FIELD. 
*                                                                        AFB1004
*     IN ANY CASE, IF KEYS IN THIS FILE ARE NON-EMBEDDED, RETURN         AFB1004
*     THE PRIMARY KEY VALUE WHERE KA AND KP POINT.                       AFB1004
*                                                                        AFB1004
*     THEN JUMP TO STATISTIC TO WIND UP.
 #                                                                       GAG0905
              SPAC$AK ( FSDATAPAD,0,0,0 ) ;                              GAG0905
              IF NEWBNUM EQ 0                                            GAG0905
              THEN                                                       GAG0905
                  BEGIN                                                  GAG0905
                  RETURN; 
                  END                                                    GAG0905
              PWOK$AK ;                                                  GAG0905
              CKEY = ((BLOCKID-PRU3)/FSBLKSIZ)*FSBKFACTR+RNO ;           GAG0905
              Q = RECFWA ;                                               GAG0905
              X = 0 ;                                                    GAG0905
              Y = FSKEYSIZE[0] ;                                         GAG0905
              Z = WC - Y ;                                               GAG0905
              IF FSKEYPOS[0] LS WC                                       GAG0905
              THEN                                                       GAG0905
                  BEGIN #EMBEDDED#                                       GAG0905
                  IF CMPREC EQ 0                                         GAG0905
                  THEN                                                   GAG0905
                      BEGIN                                              GAG0905
                      Q = Q + FSKEYLOC[0] ;                              GAG0905
                      X = FSKEYPOS[0] ;                                  GAG0905
                      END                                                GAG0905
                  MOVC$AA ( LOC(CKEY),Z,Q,X,Y) ;                         GAG0905
                  MOVC$AA ( LOC(CKEY),Z,FTWSA+FSKEYLOC,FSKEYPOS,Y );     AFB1004
                  ZIPMIP ( 1 ); 
                  IF RHO NQ 0 THEN RETURN;
                  END                                                    GAG0905
              ELSE                                                       AFB1004
                  BEGIN                                                  AFB1004
                  SVCKEY = CKEY ; 
                  KEYFWA = LOC(SVCKEY); 
                  KEYOFF = Z; 
                  ZIPMIP ( 1 ); 
                  IF RHO NQ 0 THEN RETURN;
                  MOVC$AA ( LOC(SVCKEY),Z,FTKA,FTKP,Y );
                  END                                                    AFB1004
              GOTO STATISTIC ;
              END                                                        GAG0905
                                                                         GAG0905
          ELSE                                                           GAG0905
              BEGIN  #PUT WITH KEY PROCESSING#                           GAG0905
 #                                                                       AFB1004
*     IF THE GIVEN KEY IS NON-ZERO, AND DOES NOT ALREADY                 AFB1004
*     DESIGNATE A RECORD, IT NAMES A SPECIFIC SLOT TO PUT INTO,          AFB1004
*     AND WE SHOULD NOW HAVE THE BLOCK FOR THAT SLOT IN CORE.            AFB1004
*     HOWEVER, IF THE QEI FLAG IS SET, WE ARE AT EOI, SO TO SPEAK.       AFB1004
*     THE SLOT IS BEYOND THE LAST EXISTING BLOCK. WE ARE ALLOWED TO      AFB1004
*     DO A PUT IN THE FIRST BLOCK BEYOND EOI, BUT NOT FURTHER OFF        AFB1004
*     THAN THAT. MXPR$AA GIVES THE PRU NUMBER OF THAT FIRST BLOCK,       AFB1004
*     AND IF THE WANTED BLOCK NUMBER IS HIGHER STILL, WE GET A           AFB1004
*     NON-FATAL INVALID KEY ERROR. IF THE FIRST BLOCK AT EOI IS          AFB1004
*     WANTED, CALL NUBL$AK TO BRING IT INTO EXISTENCE. THIS MAY FAIL     AFB1004
*     BECAUSE THE FILE HAS ALREADY REACHED MAXIMUM LENGTH (GOVERNED BY   AFB1004
*     KEY SIZE). IN THAT CASE NEWBNUM IS 0 ON RETURN FROM NUBL$AK AND    AFB1004
*     WE HAVE A NON-FATAL ERROR EXIT.                                    AFB1004
*     IF NEWBNUM IS NOT 0, WE HAVE A NEW BLOCK, WHICH IS                 AFB1004
*     COMPLETELY EMPTY AND WILL CERTAINLY ACCEPT THE NEW                 AFB1004
*     RECORD, SO DROP DOWN TO THE SETR$AK CALL.                          AFB1004
 #                                                                       AFB1004
              IF QEI EQ 1                                                GAG0905
              THEN                                                       GAG0905
                  BEGIN  #RECORD OUT OF BOUNDS#                          GAG0905
                  IF PTCURBLK[0] GR MXPR$AA                              GAG0905
                  THEN                                                   GAG0905
                      BEGIN                                              GAG0905
                      MSGZ$AA(EC442);  #INVALID ACTUAL KEY#              GAG0905
                      RETURN; 
                      END                                                GAG0905
              NUBL$AK;  #CREATE A NEW BLCOK IF POSSIBLE#                 GAG0905
              IF NEWBNUM EQ 0                                            GAG0905
              THEN  #CANNOT EXTEND FILE ANY MORE#                        GAG0905
                  BEGIN                                                  GAG0905
                  MSGZ$AA(EC250);                                        GAG0905
                  RETURN; 
                  END                                                    GAG0905
              ELSE                                                       GAG0905
                  BEGIN                                                  GAG0905
                  PTBLKIN[0] = 1;  #MARK BLOCK IN CORE#                  GAG0905
                  PTCURBADR[0] = P<BLOK$AA>;                             GAG0905
                  BLPTRADR[0] = LOC(PTREEWRD[0]) ;                       GAG0905
                  END                                                    GAG0905
                  END  #OF RECORD OUT OF BOUNDS CONDITIONAL CODE#        GAG0905
              ELSE                                                       GAG0905
                  BEGIN  #RECORD NOT OUT OF BOUNDS#                      GAG0905
 #                                                                       AFB1004
*     ONCE WE HAVE THE WANTED BLOCK IN CORE, EITHER RECPTR IS 0          AFB1004
*     (THE BLOCK WAS NEW OR EMPTY, OR THE RECORD NUMBER WAS BEYOND       AFB1004
*     RC FOR THE BLOCK) OR IT CONTAINS A RECORD POINTER FOR A DEAD       AFB1004
*     RECORD OR AN ALIEN. A DEAD RECORD CAN BE REPLACED IMMEDIATELY,     AFB1004
*     BUT AN ALIEN HAS TO BE MOVED OUT OF THE SLOT BEFORE THE SLOT       AFB1004
*     CAN BE REUSED. IF AN ALIEN, CALL MALR$AK WITH A PARAMETER OF 1,    AFB1004
*     WHICH MEANS THAT IT WOULD BE ACCEPTABLE JUST TO MOVE THE ALIEN     AFB1004
*     TO A DIFFERENT SLOT IN THE SAME BLOCK. THIS SUBROUTINE IS CALLED   AFB1004
*     AS ((MALRDAK)) BECAUSE IT IS IN A RARE CAPSULE THAT MAY HAVE TO    AFB1004
*     BE LOADED. ((MALRDAK)) IS A MACRO THAT ARRANGES THE LOADING IF     AFB1004
*     NECESSARY BEFORE JUMPING INTO THE SUBROUTINE.                      AFB1004
*                                                                        AFB1004
*     ONCE THE SLOT IS DEFINITELY FREE, CALL RCKN$AK TO SEE IF THERE IS  AFB1004
*     ROOM IN THE BLOCK FOR THE NEW RECORD, PLUS ANY ADDITIONAL RECORD   AFB1004
*     POINTERS THAT MAY BE NEEDED. IF SPLTFLG .LQ. 0 ON RETURN, THERE    AFB1004
*     IS ROOM AND WE DROP DOWN TO THE SETR$AK CALL.                      AFB1004
*                                                                        AFB1004
*     IF SPLTFLG .GR. 0 ON RETURN, THERE IS NOT ROOM, SO WE CALL MKRM$AK AFB1004
*     TO MAKE ENOUGH ROOM FOR A NEW RECORD OF NEWLNG CHARACTERS, OR AT   AFB1004
*     LEAST FOR A PLACEHOLDER. (MKRM$AK IS CALLED BY THE MACRO MKRMDAK,  AFB1004
*     FOR THE SAME REASON GIVEN ABOVE FOR MALRDAK.)                      AFB1004
*                                                                        AFB1004
*     IF MKRM$AK LEAVES SPLTFLG=0, IT HAS MADE ENOUGH ROOM FOR THE WHOLE AFB1004
*     NEW RECORD TO BE INSERTED, AND WE DROP DOWN TO THE SETR$AK CALL.   AFB1004
*     BUT IF NOT, THERE IS ONLY ROOM FOR A PLACEHOLDER. WE LEAVE THE     AFB1004
*     POSITION THE PLACEHOLDER WILL OCCUPY, MARKED IN PTREEWRD[0],       AFB1004
*     SET CURPTR=1 INDICATING WE ARE GOING INTO THE REALM OF ALIENS,     AFB1004
*     AND CALL SPAC$AK TO FIND A BLOCK WITH ROOM FOR A NEW RECORD OF     AFB1004
*     NEWLNG CHARACTERS. THE FIRST PARAMETER=0, INDICATING PADDING       AFB1004
*     IS NOT TO BE WORRIED ABOUT. THE SECOND IS THE PRU NUMBER OF THE    AFB1004
*     BLOCK THAT WILL HOLD THE PLACEHOLDER, WHICH SPAC$AK IS TO LEAVE    AFB1004
*     OUT OF CONSIDERATION. THE THIRD AND FOURTH ARE ZERO, INDICATING    AFB1004
*     THAT SPAC$AK IS NOT BEING CALLED FROM THE AK RARE CAPSULE (THIS    AFB1004
*     MATTERS TO SPAC$AK IF IT HAS TO CALL SPC1$AK, WHICH IS IN THE      AFB1004
*     RARE CAPSULE.)                                                     AFB1004
*                                                                        AFB1004
*     IF NEWBNUM IS 0 ON RETURN FROM SPAC$AK, AN ERROR MESSAGE HAS       AFB1004
*     ALREADY BEEN ISSUED IN SPAC$AK, AND WE JUST RETURN. 
*     BUT OTHERWISE WE HAVE A BLOCK, AND PTREEWRD[1] POINTS TO IT.       AFB1004
*     FIRST CALL ZIPMIP, TO DO THE MIP WORK OF THIS PUT IF ANY.          AFB1004
*     NOTE THAT HERE WE DO THE MIP BEFORE THE AK PUT, WHEREAS IN DOING   AFB1004
*     A SIMPLE PUT, WHERE THE AK RECORD GOES DIRECTLY INTO ITS NATIVE    AFB1004
*     SLOT, WE DO THE AK WORK FIRST. THIS IS BECAUSE THERE IS A RISK OF  AFB1004
*     FAILURE IN A MIP PUT OR REPLACE. A FORBIDDEN DUPLICATE ALTERNATE   AFB1004
*     KEY VALUE MAY TURN UP. THE MIP PROGRAMS WILL UNDO ANY ALTERATION   AFB1004
*     THAT MAY HAVE BEEN MADE IN THE MIP FILE, BEFORE THE ERROR TURNED   AFB1004
*     UP, BUT WHAT ABOUT THE AK FILE. WHERE THE PUT IS SIMPLE, WE CAN    AFB1004
*     DO IT FIRST AND THEN CALL ZIPMIP(1). THE 1 PARAMETER TELLS ZIPMIP  AFB1004
*     THAT IF THERE IS AN ERROR, IT SHOULD CALL DELL$AK TO RESTORE THE   AFB1004
*     AK FILE TO THE PRE-ATTEMPT STATE. BUT WHEN THE PUT INVOLVES A      AFB1004
*     PLACEHOLDER AND AN ALIEN RECORD, TO UNDO IT WOULD BE MORE          AFB1004
*     COMPLICATED, SO WE CALL ZIPMIP(0) BEFORE ALTERING THE AK FILE.     AFB1004
*     THE PARAMETER TELLS ZIPMIP NOT TO WORK ON THE AK FILE IF THERE     AFB1004
*     IS AN ERROR. IF THERE IS AN ERROR, ZIPMIP RETURNS WITH RHO NOT 0. 
*     WHY NOT DO IT ALWAYS THIS WAY, WITH ZIPMIP(0).
*     BECAUSE IN A PUT WITHOUT KEY, THE PRIMARY KEY VALUE ISNT KNOWN     AFB1004
*     TILL MOST OF THE AK WORK HAS BEEN DONE, SO IT IS MORE CONVENIENT   AFB1004
*     TO DO THE AK WORK FIRST, THEN CALL ZIPMIP(1).                      AFB1004
*                                                                        AFB1004
*     ANYWAY, IF WE RETURN FROM ZIPMIP(0), THERE WAS NO ERROR IN THE     AFB1004
*     MIP PART OF THE PUT. CALL SEBL$AA TO MAKE SURE THE BLOCK THAT      AFB1004
*     WILL HOUSE THE ALIEN IS IN CORE (THE MIP OPERATIONS MIGHT HAVE     AFB1004
*     FORCED IT OUT). THEN CALL PWOK$AA TO FIND A SLOT FOR THE ALIEN     AFB1004
*     AND PUT IT THERE. THEN RLOV$AK TO DROP TO PTREEWRD[0], WHICH       AFB1004
*     POINTS TO THE EMPTY SLOT CORRESPONDING TO THE KEY VALUE, AND       AFB1004
*     INSERT A PLACEHOLDER THERE. THEN SKIP TO STATISTIC TO COUNT        AFB1004
*     THIS PUT AND EXIT.                                                 AFB1004
 #                                                                       AFB1004
                  IF RPUCC EQ ALIEN                                      GAG0905
                  THEN                                                   GAG0905
                      BEGIN                                              GAG0905
                      SLOG$AA ;                                         023800
                      MALRDAK(1) ; #MOVE ALIEN RECORD OUT#               GAG0905
                      IF NEWBNUM EQ -1 THEN RETURN; 
                      END                                                GAG0905
                  RCKN$AK;  #TEST FOR ROOM IN THE BLOCK#                 GAG0905
                  IF SPLTFLG GR 0                                        GAG0905
                  THEN                                                   GAG0905
                      BEGIN  #NOT ENOUGH ROOM IN CURRENT BLOCK FOR REC#  GAG0905
                      SLOG$AA ;                                         024000
                      MKRMDAK;  #MAKE ROOM FOR RECORD IN CURRENT BLOCK#  GAG0905
                      IF NEWBNUM EQ -1 THEN RETURN; 
                      IF SPLTFLG NQ 0                                    GAG0905
                      THEN                                               GAG0905
                          BEGIN  #ONLY ROOM FOR OVF POINTER IN BLOCK#    GAG0905
                          CURPTR = 1 ;                                   GAG0905
                          SPAC$AK ( 0,BLOCKID,0,0 ) ;                    GAG0905
                            #FIND SPACE FOR RECORD PROPER#               GAG0905
                          IF NEWBNUM NQ 0                                GAG0905
                          THEN                                           GAG0905
                              BEGIN  #SPACE FOR THE RECORD PROPER FOUND# GAG0905
                              ZIPMIP ( 0 ) ;                             GAG0905
                              IF RHO NQ 0 THEN RETURN;
                              SEBL$AA(1,1);  #MAKE SURE BLOCK IN CORE#   GAG0905
                              PWOK$AK;  #DO PUT WITHOUT KEY#             GAG0905
                              RLOV$AK;  #INSERT OVF POINTER#             GAG0905
                              GOTO STATISTIC ;                           GAG0905
                              END  #OF SPACE FOUND PROCESSING#           GAG0905
                          ELSE                                           GAG0905
                              BEGIN  #NO SPACE FOR RECORD PROPER#        GAG0905
                              RETURN; 
                              END                                        GAG0905
                          END  #OF OVF RECORD PROCESSING#                GAG0905
                      END  #OF NOT ENOUGH ROOM FOR WHOLE REC PROCESSING# GAG0905
                  END #OF RECORD NOT OUT OF BOUNDS#                      GAG0905
 #                                                                       AFB1004
*     WE COME HERE FOR A PUT WITH KEY, IN WHICH THE DESTINATION          AFB1004
*     SLOT HAS BEEN FOUND AND FREED IF NECESSARY, AND THERE IS           AFB1004
*     ENOUGH ROOM IN ITS BLOCK FOR THE WHOLE NEW RECORD, HENCE           AFB1004
*     NO NEED TO FIDDLE WITH PLACEHOLDER AND ALIEN. CALL SETR$AK         AFB1004
*     TO LOCATE US AT THE WANTED SLOT. IF THIS IS BEYOND THE LAST        AFB1004
*     RECORD ALREADY IN THE BLOCK, SETR$AK ADDS ENOUGH DEAD RECORD       AFB1004
*     POINTERS AND ADJUSTS RC, EC AND BLFRESLTS. THEN CALL ADRC$AK       AFB1004
*     TO PUT THE NEW RECORD IN THE BLOCK -- THE ACTION TAKES THE         AFB1004
*     FORM OF REPLACING A DEAD RECORD BY A LIVE RECORD.                  AFB1004
 #                                                                       AFB1004
              SETR$AK ( PTCUREC[0] ) ;                                   GAG0905
              ADRC$AK ;                                                  GAG0905
              ZIPMIP ( 1 ) ;                                             GAG0905
              IF RHO NQ 0 THEN RETURN;
STATISTIC:                                                               GAG0905
              FSPUTCNT = FSPUTCNT + 1;  #PUT STATISTIC#                  GAG0905
              RETURN;                                                    GAG0905
          END  #OF PUT WITH KEY PROCESSING#                              GAG0905
                                                                         GAG0905
          END #PUT$AK#                                                   GAG0905
CONTROL EJECT;                                                           GAG0905
PROC PWOK$AK ;   #PUT WITHOUT KEY#                                       GAG0905
          BEGIN                                                          GAG0905
 #                                                                       GAG0905
* *       PWOK$AK - TO HANDLE PUT WITHOUT KEY    PAGE  1                 GAG0905
* *       PROGRAM - NRODAK                                               GAG0905
* *       R.P.NG.                               DATE.                    GAG0905
* 1CD     PWOK$AK - PUT WITHOUT KEY FOR AK.                              GAG0905
*                                                                        GAG0905
* CD      FUNCTION                                                       GAG0905
*                                                                        GAG0905
*         TO PUT A RECORD INTO THE FIRST AVAILABLE SLOT IN A BLOCK.      GAG0905
*         THIS CAN BE A PUT WITHOUT KEY, OR AN ATTEMPT TO FIND ROOM FOR  GAG0905
*         A RECORD THAT HAS OVERFLOWED.                                  GAG0905
*                                                                        GAG0905
* CD      ENTRY CONDITIONS                                               GAG0905
*                                                                        GAG0905
*     NEWFWA IS THE FWA OF THE NEW RECORD, ALREADY COMPRESSED            AFB1004
*     IF THAT IS NECESSARY, AND NEWLNG IS ITS LENGTH IN CHARACTERS.      AFB1004
*                                                                        AFB1004
*     CURPTR=0 OR 1, AND PTREEWRD[CURPTR] POINTS TO THE CURRENT          AFB1004
*     BLOCK, IN WHICH THE NEW RECORD IS TO BE STORED.                    AFB1004
*     P<BLOK$AA> POINTS TO THE BLOCK IMAGE.                              AFB1004
*     IF CURPTR=1, THE RECORD IS GOING INTO THE BLOCK AS AN ALIEN,       AFB1004
*     SO PWOK$AA SHOULD ADD AN EXTRA WORD AT THE BEGINNING OF THE        AFB1004
*     RECORD, IN WHICH A BACK POINTER CAN BE INSERTED AFTERWARD.         AFB1004
*                                                                        AFB1004
*     THERE MUST BE ROOM IN THE BLOCK FOR THE NEW RECORD, BUT            AFB1004
*     IT MAY BE STILL NECESSARY TO CALL CONS$AA TO SQUEEZE OUT           AFB1004
*     DEAD RECORDS AND CONSOLIDATE THE SPACE.                            AFB1004
*                                                                        AFB1004
* DC  EXIT CONDITIONS                                                    AFB1004
*                                                                        AFB1004
*     THE RECORD HAS BEEN PUT INTO THE BLOCK AT A VACANT SLOT,           AFB1004
*     AND PTREEWRD[CURPTR] NOW CONTAINS THAT SLOT NUMBER.                AFB1004
*                                                                        AFB1004
*     IF CURPTR=1, AND THE RECORD IS AN ALIEN, IT HAS HAD A WORD         AFB1004
*     PREFIXED TO IT, CONTAINING A COPY OF PTREEWRD[0] (USING BLOCK      AFB1004
*     PRU NUMBER RATHER THAN BLOCK IMAGE ADDRESS.) THE LEFTMOST          AFB1004
*     4 BITS OF THIS WORD CONTAIN THE UCC OF THE RECORD, WHILE THE       AFB1004
*     UCC OF THE RECORD POINTER =14 (ALIEN).                             AFB1004
*                                                                        AFB1004
* DC  ERROR CONDITIONS                                                   AFB1004
*                                                                        AFB1004
*     NONE                                                               AFB1004
*                                                                        AFB1004
* DC  CALLED ROUTINES                                                    AFB1004
*                                                                        AFB1004
*     SETR$AK - TO POSITION US AT A GIVEN SLOT IN THE BLOCK. IF          AFB1004
*       THIS IS NUMBER RC+1, TO ADD IN AN EXTRA DEAD RECORD              AFB1004
*       POINTER TO MAKE THE SLOT EXIST.                                  AFB1004
*     RCKN$AK - TO DECIDE IF CONS$AA HAS TO BE CALLED TO SQUEEZE         AFB1004
*       OUT DEAD RECORDS, AND CALL IT IF SO.                             AFB1004
*     ADRC$AK - TO PUT THE RECORD INTO THE BLOCK.                        AFB1004
*     POINTER - TO ADD THE BACK POINTER TO THE RECORD, IF IT IS          AFB1004
*       AN ALIEN.                                                        AFB1004
*                                                                        AFB1004
* DC  NON-LOCAL VARIABLES                                                AFB1004
*                                                                        AFB1004
*     RNO - USED AS CURRENT RECORD NUMBER. SET BY SETR$AK, USED BY       AFB1004
*       RCKN$AK.                                                         AFB1004
*     IX - SCRATCH.                                                      AFB1004
*                                                                        AFB1004
* DC  NARRATIVE                                                          AFB1004
*                                                                        AFB1004
*     SCAN FORWARD THROUGH THE BLOCK FOR A DEAD-RECORD,                  AFB1004
*     I.E. A FREE SLOT. IF NONE, USE SLOT RC+1. WE KNOW THERE            AFB1004
*     MUST BE EITHER ONE DEAD RECORD, OR ROOM FOR AN EXTRA SLOT          AFB1004
*     WITHIN THE BLOCKING FACTOR, OTHERWISE WE WOULDNT BE USING          AFB1004
*     THIS BLOCK.                                                        AFB1004
 #                                                                       GAG0905
                                                                         GAG0905
          ITEM LM ;                                                      GAG0905
          LM = RC;                                                       GAG0905
          RNO= LM + 1;                                                   GAG0905
          BLOCLWA = P<BLOK$AA> + BLKLG + DBLKFRAME;                      GAG0905
          FOR IX = 1 STEP 1 UNTIL LM DO                                  GAG0905
              BEGIN                                                      GAG0905
              IF RPFIELD(0,4,IX) EQ DEAD  #IF DEAD SLOT FOUND#           GAG0905
              THEN                                                       GAG0905
                  BEGIN                                                  GAG0905
                  RNO = IX;  #USE THIS SLOT#                             GAG0905
                  GOTO SLFD;                                             GAG0905
                  END                                                    GAG0905
              END                                                        GAG0905
 #                                                                       GAG0905
* 0   IF THIS IS AN ALIEN RECORD, ALTER NEWFWA AND NEWLNG SO AS          AFB1004
*     TO ADD A WORD OF GARBAGE AT THE BEGINNING. WE KNOW THERE IS        AFB1004
*     ROOM FOR THIS, BECAUSE SPAC$AK WAS WARNED, BY THE FACT THAT        AFB1004
*     CURPTR=1 WHEN IT WAS CALLED, TO LOOK FOR A BLOCK WITH ROOM.        AFB1004
*     SUBROUTINE POINTER WILL PUT THE BACKPOINTER INTO THIS WORD,        AFB1004
*     AFTER THE RECORD HAS BEEN INSERTED IN THE BLOCK IMAGE.             AFB1004
*     THEN CALL SETR$AK TO POSITION AT THE SLOT, AND ADRC$AK TO          AFB1004
*     INSERT THE RECORD. IF ALIEN, THEN CALL POINTER TO INSERT THE       AFB1004
*     BACKPOINTER.                                                       AFB1004
 #                                                                       GAG0905
SLFD:                                                                    GAG0905
          IF CURPTR NQ 0                                                 GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              NEWLNG = NEWLNG + WC;                                      GAG0905
              NEWFWA = NEWFWA - 1;                                       GAG0905
              END                                                        GAG0905
          SETR$AK ( RNO ) ;                                              GAG0905
          RCKN$AK;  #TEST IF CONSOLIDATION IS NEEDED#                    GAG0905
          ADRC$AK ;                                                      GAG0905
          IF CURPTR NQ 0                                                 GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              POINTER ;                                                  GAG0905
              END                                                        GAG0905
          END   #END PWOK$AK#                                            GAG0905
CONTROL EJECT;                                                           GAG0905
PROC RCKN$AK;                                                            GAG0905
          BEGIN                                                          GAG0905
 #                                                                       GAG0905
* *       RCKN$AK - TEST IF SPACE IS ENOUGH.     PAGE  1                 GAG0905
* *       PROGRAM - NRODAK                                               GAG0905
* *       R.P.NG.                               DATE.                    GAG0905
* 1CD     RCKN$AK                                                        GAG0905
*                                                                        GAG0905
* CD      FUNCTION                                                       GAG0905
*                                                                        GAG0905
*         TO TEST IF A BLOCK CAN ACCOMMODATE A NEW RECORD, AND IF YES,   GAG0905
*         TO DO CONSOLIDATION IF NECESSARY.                              AFB1004
*                                                                        GAG0905
* CD      ENTRY CONDITIONS.                                              GAG0905
*                                                                        GAG0905
*     P<BLOK$AA> POINTS TO THE BLOCK IMAGE.                              AFB1004
*     RNO IS THE SLOT NUMBER AT WHICH WE WOULD LIKE TO PUT               AFB1004
*       THE RECORD. IT MAY BE GREATER THAN RC.                           AFB1004
*     NEWLNG IS THE LENGTH OF THE NEW RECORD IN CHARACTERS.              AFB1004
*                                                                        AFB1004
* DC  EXIT CONDITIONS                                                    AFB1004
*                                                                        AFB1004
*     SPLTFLG = 0 IF THERE WAS ALREADY ROOM IN THE BLOCK, WITH           AFB1004
*       NO NEED FOR CONSOLIDATION.                                       AFB1004
*     SPLTFLG IS LESS THAN ZERO IF THERE WAS ROOM, BUT CONS$AA           AFB1004
*       HAS HAD TO BE CALLED TO CONSOLIDATE IT. (TO HAVE TWO             AFB1004
*       DIFFERENT VALUES FOR SPLTFLG HERE IS SUPERFLUOUS. IN AN          AFB1004
*       EARLIER VERSION, CONS$AA WAS NOT CALLED BY RCKN$AA, AND          AFB1004
*       THE ROUTINE THAT CALLED RCKN$AK HAD TO KNOW WHETHER              AFB1004
*       TO CALL CONS$AA AFTERWARDS.)                                     AFB1004
*     SPLTFLG IS GREATER THAN ZERO IF THERE IS NOT ENOUGH ROOM           AFB1004
*       IN THE BLOCK -- IT IS THE NUMBER OF HALFWORDS BY WHICH           AFB1004
*       FREE SPACE MUST BE INCREASED, IN ORDER TO MAKE ROOM FOR          AFB1004
*       THE NEW RECORD.                                                  AFB1004
*                                                                        AFB1004
* DC  ERROR CONDITIONS                                                   AFB1004
*                                                                        AFB1004
*     NONE                                                               AFB1004
*                                                                        AFB1004
* DC  CALLED ROUTINES                                                    AFB1004
*                                                                        AFB1004
*     CONS$AA - CALLED IF IT IS NECESSARY AND SUFFICIENT TO MAKE         AFB1004
*       ROOM.                                                            AFB1004
*                                                                        AFB1004
* DC  NON-LOCAL VARIABLES                                                AFB1004
*                                                                        AFB1004
*     NONE                                                               AFB1004
*                                                                        AFB1004
* DC  EXPLANATION                                                        AFB1004
*                                                                        AFB1004
*     THERE ARE TWO SPACE QUESTIONS -- (1) WHETHER THERE IS              AFB1004
*     ROOM IN THE BLOCK FOR THE NEW RECORD (2) IF SO, WHETHER            AFB1004
*     CONS$AA HAS TO BE CALLED TO SQUEEZE OUT DEAD RECORDS               AFB1004
*     FIRST. WE SET VARIABLE SPACE TO THE AMOUNT OF SPACE FOR            AFB1004
*     QUESTION (1), AND AVAIL TO THE AMOUNT OF SPACE FOR                 AFB1004
*     QUESTION (2). SPACE IS EC MINUS THE NUMBER OF NEW RECORD           AFB1004
*     POINTERS THAT WOULD HAVE TO BE ADDED TO THE BLOCK.                 AFB1004
*     AVAIL IS THE AMOUNT OF SPACE BETWEEN WHAT IS NOW THE END           AFB1004
*     OF THE LAST RECORD AND WHAT WOULD BE THE BEGINNING OF              AFB1004
*     THE GROUP OF RECORD POINTERS IF THE NEW RECORD WERE                AFB1004
*     ADDED, PLUS, IF THE SLOT ALREADY EXISTS (I.E. RNO LQ RC)           AFB1004
*     THE SIZE OF THE DEAD RECORD NOW IN THE SLOT.                       AFB1004
 #                                                                       GAG0905
                                                                         GAG0905
          ITEM SPACE,NEED,AVAIL;                                         GAG0905
          SPACE = EC ;                                                   GAG0905
          AVAIL = MAXMT - LWAD$AA(RC) * 2;                               GAG0905
          IF RNO GR RC  #PUT BEYOND END OF BLOCK#                        GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              SPACE = SPACE - RNO + RC;  #RESERVE FOR HEADER PADDING#    GAG0905
              AVAIL = AVAIL - RNO;                                       GAG0905
                          #AMOUNT OF SPACE AT END OF BLOCK#              GAG0905
              END                                                        GAG0905
          ELSE   #PUT WITHIN BLOCK#                                      GAG0905
              BEGIN                                                      GAG0905
              AVAIL = AVAIL + RECLNG * 2 - RC;                           GAG0905
              END                                                        GAG0905
          NEED = WLG(NEWLNG) * 2;                                        GAG0905
          IF NEED LQ AVAIL                                               GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              SPLTFLG = 0;  #ENOUGH ROOM, NO CONSOLIDATION#              GAG0905
              END                                                        GAG0905
          ELSE                                                           GAG0905
              BEGIN                                                      GAG0905
              SPLTFLG = NEED - SPACE ;                                   GAG0905
              IF SPLTFLG LQ 0                                            GAG0905
              THEN                                                       GAG0905
                  BEGIN                                                  GAG0905
                  CONS$AA ;                                              GAG0905
                  END                                                    GAG0905
              END                                                        GAG0905
          END  #END RCKN$AK#                                             GAG0905
CONTROL EJECT;                                                           GAG0905
PROC REPL$AK ;                                                           GAG0905
 #                                                                       AFB1004
* *   REPL$AK - DO A REPLACE IN AN AK FILE           PAGE 1              AFB1004
* *   A.F.R.BROWN                                                        AFB1004
* 1DC REPL$AK                                                            AFB1004
*                                                                        AFB1004
* DC  FUNCTION                                                           AFB1004
*                                                                        AFB1004
*     TO DO ALL THE WORK OF A REPLACE OPERATION, IN AN AK FILE.          AFB1004
*                                                                        AFB1004
* DC  ENTRY CONDITIONS                                                   AFB1004
*                                                                        AFB1004
*     WSA AND RRL IN THE FIT GIVE THE FWA AND THE LENGTH IN              AFB1004
*     CHARACTERS OF THE NEW RECORD.                                      AFB1004
*                                                                        AFB1004
*     IF KEYS ARE NON-EMBEDDED, KA AND KP IN THE FIT GIVE THE            AFB1004
*     FWA AND POSITION OF THE KEY.                                       AFB1004
*                                                                        AFB1004
*     P<FSTT$AA> POINTS TO THE FSTT OF THE AK FILE.                      AFB1004
*                                                                        AFB1004
* DC  EXIT CONDITIONS                                                    AFB1004
*                                                                        AFB1004
*     IF THERE WAS ALREADY A RECORD IN THE FILE WITH THE SAME            AFB1004
*     KEY, IT HAS BEEN REPLACED, AND THE NECESSARY CHANGES IN            AFB1004
*     THE MIP FILE HAVE BEEN MADE. HOWEVER, IF THERE IS A MIP            AFB1004
*     FILE, AND THE NEW RECORD TURNS OUT TO CONTAIN A FORBIDDEN          AFB1004
*     DUPLICATE KEY VALUE, NOTHING IS DONE.                              AFB1004
*                                                                        AFB1004
*     FILE POSITION, AS RECORDED IN PTREEWRD[3] AND PTREEWRD[4]          AFB1004
*     FOR USE IN GETNEXT OPERATIONS AND THE LIKE, HAS NOT BEEN           AFB1004
*     CHANGED.                                                           AFB1004
*                                                                        AFB1004
* DC  ERROR CONDITIONS                                                   AFB1004
*                                                                        AFB1004
*     EC445 (NON-FATAL) - THERE IS NO RECORD TO BE REPLACED,             AFB1004
*       I.E. NONE WITH THE GIVEN KEY.                                    AFB1004
*     EC503 (NON-FATAL, ISSUED BY ZIPMIP) - FORBIDDEN                    AFB1004
*       DUPLICATE ALTERNATE KEY VALUE.                                   AFB1004
*     EC250 (NON-FATAL, ISSUED BY SPAC$AK) - THE FILE IS FULL,           AFB1004
*       AND WE HAVE HAD TO ADD AN EXTRA BLOCK AT THE END TO              AFB1004
*       ACCOMODATE THE NEW RECORD. THE PRIMARY KEY VALUE FOR             AFB1004
*       ITS SLOT IS ACTUALLY TOO BIG TO FIT IN A NORMAL KEY              AFB1004
*       FIELD. HOWEVER, IT IS AN ALIEN THERE. WITHIN THE                 AFB1004
*       ALLOWED RANGE OF PRIMARY KEYS THERE IS A PLACEHOLDER             AFB1004
*       POINTING TO THE FAR-OUT SLOT, AND A PLACEHOLDER HAS              AFB1004
*       PLENTY OF ROOM FOR OVERSIZE KEYS. NO FURTHER PUTS OR             AFB1004
*       REPLACES WILL BE ALLOWED IN THE FILE.                            AFB1004
*                                                                        AFB1004
* DC  CALLED ROUTINES                                                    AFB1004
*                                                                        AFB1004
*     INUP$AK - TO LOCATE THE PRIMARY KEY VALUE, AND LOCATE              AFB1004
*       THE RECORD IT POINTS TO, PASSING FROM PLACEHOLDER TO             AFB1004
*       ALIEN IF NECESSARY. IT LEAVES CURPTR=0 IF THE RECORD IS A        AFB1004
*       SIMPLE ONE IN ITS OWN PLACE. IF THE RECORD HAS OVERFLOWED,       AFB1004
*       IT LEAVES CURPTR=1, PTREEWRD[1] BEING THE ONE THAT POINTS        AFB1004
*       TO THE REAL BODY OF THE RECORD.                                  AFB1004
*     MSGZ$AA - TO ISSUE A NON-FATAL ERROR MESSAGE.                      AFB1004
*     ZIPMIP - TO DO ALL THE MIP WORK.                                   AFB1004
*     CMRC$AA - TO COMPRESS THE NEW RECORD IF NECESSARY.                 AFB1004
*     DELL$AK - TO DELETE AN ALIEN RECORD. IF THE RECORD TO              AFB1004
*       BE REPLACED ACTUALLY CONSISTS OF A PLACEHOLDER AND AN            AFB1004
*       ALIEN, WE USE DELL$AK ON THE ALIEN BECAUSE WE DO NOT             AFB1004
*       SPECIALLY PLAN TO RE-USE ITS SPACE IMMEDIATELY.                  AFB1004
*     CURR$AA - TO POSITION TO A BLOCK AND RECORD, ACCORDING             AFB1004
*       TO THE CURRENT PTREE WORD, WHEN WE KNOW THE WORD IS              AFB1004
        CORRECT. (IT IS CORRECT BECAUSE INUP$AK HAS ALREADY              AFB1004
*       LOCATED THE WORD PTREEWRD[0] POINTS TO.)                         AFB1004
*     RCKN$AK - TO DECIDE IF THE NEW RECORD WILL FIT AT THE              AFB1004
*       POSITION INDICATED BY ITS KEY, AND TO CALL CONS$AA IF            AFB1004
*       NECESSARY TO SQUEEZE DEAD RECORDS OUT OF THAT BLOCK.             AFB1004
*     SPAC$AK - TO LOOK FOR A BLOCK THAT COULD ACCEPT THE                AFB1004
*       NEW RECORD AS AN ALIEN, IF RCKN$AK SAYS NO ON THE                AFB1004
*       HOME BLOCK.                                                      AFB1004
*     PWOK$AK - TO ADD THE NEW RECORD TO SOME OTHER BLOCK                AFB1004
*       AS AN ALIEN.                                                     AFB1004
*     RLOV$AK - TO INSERT THE PLACEHOLDER IN THE HOME BLOCK,             AFB1004
*       POINTING TO THE BODY OF THE RECORD WHERE PWOK$AK                 AFB1004
*       PLACED IT.                                                       AFB1004
*     SVEC$AK - TO SAVE THE CURRENT VALUE OF EC BEFORE CALLING
*       ADRC$AK, WHEN THE REPLACE IS A SIMPLE SUBSTITUTION IN 
*       THE HOME BLOCK (CHANGES TO THE OLD OVERFLOW BLOCK IF
*       ANY ARE ALREADY COMPLETE.) BUT 0 IS SAVED, IF THE 
*       BLOCK HAS NO AVAILABLE SLOT. THIS IS TO HELP PCEM$AK, 
*       WHICH WILL BE CALLED BY ADRC$AK.
*     ADRC$AK - IF THE NEW RECORD WAS ABLE TO FIT DIRECTLY               AFB1004
*       INTO THE HOME BLOCK, TO REPLACE THE OLD RECORD THERE             AFB1004
*       BY THE NEW RECORD.                                               AFB1004
*     SLOG$AA - TO DO SOME SPECIAL LOGGING ACTIVITY IF FLAG             024200
*       SFLG IS SET IN THE FIT, IN ORDER TO SHOW THAT AN                024300
*       UPDATE INVOLVING MORE THAN ONE BLOCK IS BEGINNING.              024400
*                                                                        AFB1004
* DC  NON-LOCAL VARIABLES                                                AFB1004
*                                                                        AFB1004
*     SPLTFLG - RESULT SET BY RCKN$AK, TO 0 OR NEGATIVE IF THERE         AFB1004
*       IS ROOM IN THE BLOCK, TO GREATER THAN 0 IF NOT.                  AFB1004
*                                                                        AFB1004
* DC  EXPLANATION                                                        AFB1004
*                                                                        AFB1004
*     THERE ARE TWO WAYS A PUT OR REPLACE IN AN AK FILE CAN FAIL,        AFB1004
*     ONCE WE KNOW THERE IS/IS NOT A PRIMARY KEY MATCH ALREADY           AFB1004
*     IN THE FILE -- (1) FORBIDDEN DUPLICATE ALTERNATE KEY               AFB1004
*     VALUE, FOUND IN ZIPMIP (2) LACK OF ROOM IN THE AK FILE,            AFB1004
*     FOUND IN SPAC$AK. IN A PUT, WE CONFRONT (2) FIRST, BY DOING        AFB1004
*     THE AK WORK FIRST, AND LETTING ZIPMIP UNDO THE AK PUT IF           AFB1004
*     FAILURE (1) OCCURS. BUT IN A REPLACE, THERE IS A SEVERE            AFB1004
*     CONFLICT IF RECORDS ARE COMPRESSED IN THIS FILE. TO DO THE         AFB1004
*     AK WORK, WE HAVE TO COMPRESS THE RECORD, USING THE                 AFB1004
*     COMPRESSION BUFFER, IN ORDER TO FIND OUT HOW MUCH SPACE IS         AFB1004
*     REALLY NEEDED. THUS FAILURE (2) CANT HAPPEN UNTIL THE              AFB1004
*     COMPRESSION BUFFER IS ALREADY OCCUPIED. ON THE OTHER HAND,         AFB1004
*     TO DO THE MIP WORK, WE HAVE TO DECOMPRESS THE OLD RECORD,          AFB1004
*     AGAIN USING THE COMPRESSION BUFFER, BEFORE FAILURE (1) CAN         AFB1004
*     OCCUR. SO WHICHEVER WE DO FIRST, MIP OR AK, IF IT SUCCEEDS         AFB1004
*     AND THE SECOND THING FAILS, WE THEN HAVE TO UNDO THE FIRST         AFB1004
*     THING, BUT THE COMPRESSION BUFFER HAS ALREADY BEEN REUSED          AFB1004
*     BY THE SECOND THING. IT WOULD BE NECESSARY TO RE-COMPRESS          AFB1004
*     OR RE-DECOMPRESS. TO AVOID THIS, WE MAKE SURE THAT FAILURE         AFB1004
*     (2) CANT OCCUR, AND DO THE MIP WORK FIRST. THUS ZIPMIP IS          AFB1004
*     CALLED WITH 0 PARAMETER, INDICATING THAT THE AK WORK HAS           AFB1004
*     NOT BEEN DONE, AND THERE IS NOTHING IN THE AK FILE TO              AFB1004
*     UNDO IF MIP FAILURE (1) OCCURS. TO PREVENT FAILURE (2) WE          AFB1004
*     MAKE SPAC$AK CHECK THE CURRENT OPERATION CODE. IF THE              AFB1004
*     OPERATION IS A REPLACE, SPAC$AK KNOWS THAT IT ((MUST NOT           AFB1004
*     FAIL)), AND ADDS ANOTHER BLOCK TO THE END OF THE FILE              AFB1004
*     EVEN THOUGH A PRIMARY KEY COULD NOT DIRECTLY ADDRESS THE           AFB1004
*     BLOCK. A FLAG IS SET AT THIS TIME TO PREVENT FURTHER PUTS          AFB1004
*     OR REPLACES ON THE FILE.                                           AFB1004
*                                                                        AFB1004
*     NOTE ALSO THE PARAMETERS WITH WHICH SPAC$AK IS CALLED.             AFB1004
*     THE FIRST IS 0, INDICATING THAT PADDING IS NOT TO BE               AFB1004
*     WORRIED ABOUT. THE SECOND GIVES THE BLOCK PRU NUMBER OF            AFB1004
*     THE HOME BLOCK FOR THE RECORD. THIS LETS SPAC$AK LEAVE             AFB1004
*     THE BLOCK OUT OF CONSIDERATION. THE THIRD AND FOURTH ARE           AFB1004
*     0, INDICATING THAT SPAC$AK IS NOT BEING CALLED FROM                AFB1004
*     INSIDE THE AK RARE CAPSULE -- THUS IF SPAC$AK HAS TO CALL          AFB1004
*     SPC1$AK, WHICH IS PART OF THE RARE CAPSULE, IT CAN DO SO           AFB1004
*     IN THE ORDINARY WAY.                                               AFB1004
*                                                                        AFB1004
 #                                                                       AFB1004
          BEGIN                                                          GAG0905
          NEWBNUM = 0;
          INUP$AK ;                                                      GAG0905
          IF QMF EQ 0                                                    GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              MSGZ$AA ( EC445 ) ;                                        GAG0905
              RETURN; 
              END                                                        GAG0905
          IF CURPTR NQ 0
          THEN
              BEGIN 
              OUTKEY = 1 ; #COMPENSATE FOR BACK-POINTER AT START# 
              END 
          ZIPMIP ( 0 ) ;                                                 GAG0905
          IF RHO NQ 0 THEN RETURN;
          OUTKEY = 0 ;
          CMRC$AA ;                                                      GAG0905
          IF CURPTR NQ 0                                                 GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              SLOG$AA ;                                                 024600
              DELL$AK ;                                                  GAG0905
              CURPTR = 0 ;                                               GAG0905
              CURR$AA ;                                                  GAG0905
              END                                                        GAG0905
          RCKN$AK ;                                                      GAG0905
          IF SPLTFLG GR 0                                                GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              SLOG$AA ;                                                 024800
              CURPTR = 1 ;                                               GAG0905
              SPAC$AK ( 0,BLOCKID,0,0 ) ;                                GAG0905
              PWOK$AK ;                                                  GAG0905
              RLOV$AK ;                                                  GAG0905
              END                                                        GAG0905
          ELSE                                                           GAG0905
              BEGIN                                                      GAG0905
              SVEC$AK ; 
              ADRC$AK ;                                                  GAG0905
              END                                                        GAG0905
          FSREPCNT[0] = FSREPCNT[0] + 1 ;                                GAG0905
          END                                                            GAG0905
CONTROL EJECT;                                                           GAG0905
PROC RLOV$AK;  #ADD OVF REC DESC OR RPL REC BY OVF REC DESC#             GAG0905
 #                                                                       AFB1004
* *   RLOV$AK - INSERT A MOTHER RECORD                PAGE 1             AFB1004
* *   A.F.R.BROWN                                                        AFB1004
* 1DC RLOV$AK                                                            AFB1004
*                                                                        AFB1004
* DC  FUNCTION                                                           AFB1004
*                                                                        AFB1004
*     TO INSERT A PLACEHOLDER (MOTHER) RECORD AT THE POSITION            AFB1004
*     CORRESPONDING TO THE CURRENT PRIMARY KEY, JUST AFTER THE           AFB1004
*     BODY OF A RECORD HAS BEEN STORED AS AN ALIEN IN ANOTHER BLOCK BY   AFB1004
*     PWOK$AK. RLOV$AK IS ONLY CALLED IMMEDIATELY AFTER PWOK$AK.         AFB1004
*     (BUT PWOK$AK IS CALLED IN ONE CASE WITHOUT BEING IMMEDIATELY       AFB1004
*     FOLLOWED BY RLOV$AK.)                                              AFB1004
*                                                                        AFB1004
* DC  ENTRY CONDITIONS                                                   AFB1004
*                                                                        AFB1004
*     PTREEWRD[0] POINTS TO THE MOTHER SLOT, CORRESPONDING TO            AFB1004
*     THE CURRENT PRIMARY KEY.                                           AFB1004
*                                                                        AFB1004
*     PTREEWRD[1] POINTS TO THE SLOT IN WHICH THE RECORD HAS             AFB1004
*     JUST BEEN STORED AS AN ALIEN.                                      AFB1004
*                                                                        AFB1004
* DC  EXIT CONDITIONS                                                    AFB1004
*                                                                        AFB1004
*     AN OVERFLOW POINTER HAS BEEN STORED IN THE MOTHER SLOT AS          AFB1004
*     A ONE-WORD RECORD, CONTAINING THE BLOCK PRU NUMBER AND             AFB1004
*     THE SLOT NUMBER OF THE CORRESPONDING ALIEN. IN THE RECORD          AFB1004
*     POINTER FOR THIS RECORD, THE UCC FIELD=13, AS A SIGN OF            AFB1004
*     WHAT SORT OF RECORD IT IS.                                         AFB1004
*                                                                        AFB1004
*     NEWFWA AND NEWLNG ARE UNCHANGED.                                   AFB1004
*                                                                        AFB1004
*     IF THIS WAS PART OF A PUT, I.E. IF THE SLOT WAS NOT                AFB1004
*     PREVIOUSLY OCCUPIED BY A LIVE RECORD, THE COUNT OF RECORDS         AFB1004
*     IN THE AK FILE (FSRECCNT) HAS BEEN INCREASED BY 1.                 AFB1004
*                                                                        AFB1004
* DC  ERROR CONDITIONS                                                   AFB1004
*                                                                        AFB1004
*     NONE                                                               AFB1004
*                                                                        AFB1004
* DC  CALLED ROUTINES                                                    AFB1004
*                                                                        AFB1004
*     SEBL$AA - TO LOCATE, READING IF NECESSARY, THE BLOCK TO WHICH      AFB1004
*       PTREEWRD[0] POINTS.                                              AFB1004
*     SETR$AK - TO LOCATE THE SLOT WITHIN THAT BLOCK. IF IT LIES         AFB1004
*       AFTER THE LAST RECORD IN THE BLOCK, ENOUGH DEAD RECORD           AFB1004
*       POINTERS ARE CREATED TO MAKE THE NEW SLOT THE LAST RECORD        AFB1004
*       IN THE BLOCK.                                                    AFB1004
*     ADRC$AK - TO PUT THE MOTHER RECORD INTO THE SLOT. (IF THE SLOT     AFB1004
*       CONTAINED A DEAD RECORD, THIS IS A PUT. IF LIVE, A REPLACE.)     AFB1004
*       NOTE THAT THE CONTENT OF THE MOTHER RECORD IS MERE GARBAGE       AFB1004
*       AT THIS POINT.                                                   AFB1004
*     POINTER - TO SET THE MOTHER RECORD TO POINT TO ITS DAUGHTER,       AFB1004
*       THE ALIEN.                                                       AFB1004
*                                                                        AFB1004
* DC  NON-LOCAL VARIABLES                                                AFB1004
*                                                                        AFB1004
*     NEWLNG IS USED AS AN INPUT TO ADRC$AK. BUT IN CASE THIS CALL       AFB1004
*       TO RLOV$AK IS PART OF A LARGER OPERATION IN WHICH NEWLNG         AFB1004
*       DESCRIBES A FULL RECORD, WE SAVE AND RESTORE NEWLNG. (IN         AFB1004
*       PRACTICE IT APPEARS THAT WHENEVER RLOV$AK IS CALLED, WE          AFB1004
*       ARE THROUGH WITH NEWLNG.)                                        AFB1004
*                                                                        AFB1004
 #                                                                       AFB1004
          BEGIN  #RLOV$AK CODE#                                          GAG0905
          ITEM SVNEWLNG;  #STORAGE FOR NEWLNG#                           GAG0905
                                                                         GAG0905
          CURPTR = 0 ;                                                   GAG0905
          SEBL$AA ( 0 , 1 ) ;                                            GAG0905
          SETR$AK ( PTCUREC[0] ) ;                                       GAG0905
          SVNEWLNG = NEWLNG;                                             GAG0905
          NEWLNG = 10;                                                   GAG0905
          ADRC$AK ;                                                      GAG0905
          POINTER ;                                                      GAG0905
          NEWLNG = SVNEWLNG;                                             GAG0905
          RETURN;                                                        GAG0905
          END  #OF RLOV$AK CODE#                                         GAG0905
PROC SETR$AK ( N ) ;     CONTROL EJECT ;                                 GAG0905
          BEGIN                                                          GAG0905
 #                                                                       AFB1004
* *   SETR$AK - POSITION AT A GIVEN SLOT                   PAGE 1        AFB1004
* *   A.F.R.BROWN                                                        AFB1004
* 1DC SETR$AK                                                            AFB1004
*                                                                        AFB1004
* DC  FUNCTION                                                           AFB1004
*                                                                        AFB1004
*     WITHIN A BLOCK ALREADY IN CORE, TO WHICH THE CURRENT PTREE         AFB1004
*     WORD POINTS, TO POSITION US AT A GIVEN SLOT. THIS IS LIKE          AFB1004
*     SETR$AA, BUT WITH THE ADDED POSSIBILITY THAT THE SLOT NUMBER       AFB1004
*     MAY BE GREATER THAN RC (NOT ALLOWED IN DA AND IS ROUTINES.)        AFB1004
*     IF NECESSARY, SETR$AK ADDS DEAD RECORD POINTERS, REPRESENTING      AFB1004
*     ZERO-LENGTH DEAD RECORDS THAT OCCUPY SLOTS NUMBERS                 AFB1004
*     RC+1 THROUGH RNO, AND THEN POSITIONS ON SLOT NUMBER RNO.           AFB1004
*                                                                        AFB1004
* DC  ENTRY CONDITIONS                                                   AFB1004
*                                                                        AFB1004
*     THE INCOMING PARAMETER, N, IS THE WANTED SLOT NUMBER. THIS         AFB1004
*     MUST BE WITHIN THE BLOCKING FACTOR FOR THIS FILE, AS WE DONT       AFB1004
*     CHECK THAT QUESTION HERE.                                          AFB1004
*                                                                        AFB1004
*     P<BLOK$AA> POINTS TO THE CURRENT BLOCK, TO WHICH THE CURRENT       AFB1004
*     WORD OF THE PTREE ALSO POINTS.                                     AFB1004
*                                                                        AFB1004
*     BLOCLWA IS THE LWA+1 OF THE BLOCK.                                 AFB1004
*                                                                        AFB1004
*     IF N IS GREATER THAN RC, THERE MUST BE ROOM IN THE BLOCK           AFB1004
*     FOR THE ADDITIONAL DEAD RECORD POINTERS, I.E. EC MUST NOT          AFB1004
*     BE LESS THAN N-RC. WE DO NOT CHECK FOR THAT HERE.                  AFB1004
*                                                                        AFB1004
* DC  EXIT CONDITIONS                                                    AFB1004
*                                                                        AFB1004
*     WE ARE NOW POSITIONED AT RECORD NUMBER N OF THE BLOCK,             AFB1004
*     WHICH MAY BE A DEAD RECORD.                                        AFB1004
*                                                                        AFB1004
*     RECFWA, RECLWA AND RECLNG ARE THE FWA, LWA+1 AND LENGTH            AFB1004
*     IN WORDS OF THE RECORD.                                            AFB1004
*                                                                        AFB1004
*     RECPTR CONTAINS A COPY OF ITS RECORD POINTER.                      AFB1004
*                                                                        AFB1004
*     OLDEC CONTAINS A COPY OF EC AS IT WAS WHEN THE PROCESS
*     BEGAN. SETR$AK IS OFTEN THE FIRST STAGE OF A PUT OR REPLACE        AFB1004
*     IN A BLOCK, AT THE END OF WHICH PCEM$AK WILL HAVE TO BE            AFB1004
*     CALLED TO UPDATE THE PERCENT-EMPTY TABLE. SO SETR$AK IS A          AFB1004
*     CONVENIENT PLACE TO CAPTURE THE STARTING EC VALUE, WHICH           AFB1004
*     WILL BE USED WITH THE FINAL EC VALUE BY PCEM$AK.                   AFB1004
*                                                                        AFB1004
* DC  CALLED ROUTINES                                                    AFB1004
*                                                                        AFB1004
*     ALTR$AA - TO DO THE HONORS BEFORE ALTERING THE BLOCK IMAGE, 
*       IF THE BLOCK RECORD COUNT IS GOING TO INCREASE
*     SVEC$AK - TO SAVE THE CURRENT VALUE OF EC IN OLDEC. HOWEVER,
*       IT SAVES 0 INSTEAD, IF THE BLOCK HAS NO AVAILABLE SLOT. 
*     SETR$AA - TO DO EVERYTHING EXCEPT SETTING BACKLEV AND              AFB1004
*       DEALING WITH THE POSSIBILITY THAT N IS GREATER THAN RC,          AFB1004
*     LWAD$AA - TO GET THE POSITION IN THE BLOCK OF THE LWA+1            AFB1004
*       OF THE LAST EXISTING RECORD, TO SEE IF IT WOULD                  AFB1004
*       OVERLAP THE SERIES OF RECORD POINTERS ONCE THE SERIES IS         AFB1004
*       EXTENDED (BACKWARDS) FROM RC TO N HALF-WORDS.                    AFB1004
*     CONS$AA - IF LWAD$AA SHOWS POTENTIAL OVERLAP, TO SQUEEZE           AFB1004
*       OUT DEAD RECORD SPACE IN ORDER TO PREVENT IT. BUT WE MUST        AFB1004
*       HAVE CHECKED BEFORE CALLING SETR$AK, TO MAKE SURE THE            AFB1004
*       SPACE WAS AVAILABLE IN THE FIRST PLACE.                          AFB1004
*     RPGT$AA - TO COPY INTO RECPTR THE RECORD POINTER OF THE            AFB1004
*       LAST RECORD OF THE FILE.                                         AFB1004
*     RPPT$AA - TO PUT THE SAME RECPTR, WITH RPUCC SET=15 FOR            AFB1004
*       A DEAD RECORD INDICATOR, BACK INTO THE BLOCK AT SLOTS            AFB1004
*       RC+1 THROUGH N IN THE SERIES OF RECORD POINTERS.                 AFB1004
*                                                                        AFB1004
* DC  NON-LOCAL VARIABLES                                                AFB1004
*                                                                        AFB1004
*     NONE                                                               AFB1004
*                                                                        AFB1004
 #                                                                       AFB1004
          ITEM N , P ;                                                   GAG0905
                                                                         GAG0905
          SVEC$AK ; 
          IF N GR RC                                                     GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              ALTR$AA ; 
              IF 2 * LWAD$AA ( RC ) + N GR MAXMT                         GAG0905
              THEN                                                       GAG0905
                  BEGIN                                                  GAG0905
                  CONS$AA ;                                              GAG0905
                  END                                                    GAG0905
              IF RC EQ 0                                                 GAG0905
              THEN                                                       GAG0905
                  BEGIN                                                  GAG0905
                  RECPTR = 0 ;                                           GAG0905
                  END                                                    GAG0905
              ELSE                                                       GAG0905
                  BEGIN                                                  GAG0905
                  RPGT$AA ( RC ) ;                                       GAG0905
                  END                                                    GAG0905
              RPUCC = DEAD ;                                             GAG0905
              FOR P = RC+1 STEP 1 UNTIL N                                GAG0905
              DO                                                         GAG0905
                  BEGIN                                                  GAG0905
                  RPPT$AA ( P ) ;                                        GAG0905
                  END                                                    GAG0905
              BLFRESLTS[0] = BLFRESLTS[0] + N - RC ;                     GAG0905
              EC = EC - ( N - RC ) ;                                     GAG0905
              RC = N ;                                                   GAG0905
              END                                                        GAG0905
          SETR$AA ( N ) ;                                                GAG0905
          END                                                            GAG0905
CONTROL EJECT;                                                           GAG0905
PROC SPAC$AK ( (PAD) , PRU , WHO , XYZ ) ;                               GAG0905
          BEGIN                                                          GAG0905
 #                                                                       GAG0905
* *   SPAC$AK - FIND A BLOCK THAT HAS ENOUGH SPACE PAGE 1                GAG0905
* *   PROGRAM - NRO$AK                                                   GAG0905
* *   R.P.NG.                                   DATE.                    GAG0905
* 1CD SPAC$AK - SPACE SEARCH ROUTINE FO AK                               GAG0905
*                                                                        GAG0905
*     FUNCTION - TO FIND A BLOCK IN AN AK FILE WITH ENOUGH SPACE TO      GAG0905
*     ACCEPT A RECORD OF LENGTH SPECIFIED IN GCOM CELL NEWLNG.           GAG0905
*                                                                        GAG0905
* CD  ENTRY CONDITIONS                                                   GAG0905
*                                                                        GAG0905
*     PARAMTER PAD IS THE AMOUNT OF PADDING THAT SHOULD BE ADDED IN FOR  GAG0905
*     THE SPACE SEARCH.                                                  GAG0905
*     PARAMETER PRU IS THE PRU NUMBER OF A BLOCK THAT SHOULD NOT BE      GAG0905
*     CONSIDERED FOR USE.  0 MEANS ALL BLOCKS ARE ELIGIBLE FOR USE.      GAG0905
*                                                                        AFB1004
*     PARAMETERS HOW AND XYZ TELL HOW SPAC$AK SHOULD GO ABOUT            AFB1004
*     CALLING SUBROUTINE SPC1$AK, IF IT BECOMES NECESSARY. SPC1$AK       AFB1004
*     IS THE ((RARE)) PART OF SPAC$AK, AND RESIDES IN THE AK RARE        AFB1004
*     CAPSULE. NORMALLY, ALL ROUTINES OUTSIDE THE RARE CAPSULE           AFB1004
*     THAT CALL A ROUTINE INSIDE THE RARE CAPSULE DO SO BY SETTING       AFB1004
*     CALCODE = SOME SMALL NUMBER, AND CALLING CCAL$AA, WHICH LOADS      AFB1004
*     THE CAPSULE IF NECESSARY BEFORE JUMPING TO THE SUBROUTINE.         AFB1004
*     EXIT FROM THE SUBROUTINE IS TO ROUTINE CCAL$AA, AND FROM           AFB1004
*     THERE BACK TO THE REAL CALLER.                                     AFB1004
*                                                                        AFB1004
*     NOW IF SPAC$AK IS CALLED BY MALR$AK OR MKRM$AK, WHICH ARE IN       AFB1004
*     THE RARE CAPSULE, THEN IF                                          AFB1004
*     SPAC$AK CALLED SPC1$AK IN THE NORMAL WAY IT WOULD CAUSE THE        AFB1004
*     RETURN ADDRESS RELATING TO SPC1$AK TO OVERLAY THE RETURN           AFB1004
*     ADDRESS RELATING TO MALR$AK OR MKRM$AK. THIS IS BAD. RATHER        AFB1004
*     THAN SET UP A SYSTEM OF RECURSIVE ENTRY TO THE CAPSULE, WE         AFB1004
*     JUST GIVE SPAC$AK TWO MORE PARAMETERS, HOW AND XYZ. IF HOW=0       AFB1004
*     SPAC$AK IS TO USE THE MACRO SPC1CLL TO CALL CCAL$AA. THIS IS       AFB1004
*     FOR WHEN SPAC$AK IS CALLED FROM OUTSIDE THE RARE CAPSULE.          AFB1004
*     IF HOW IS NOT 0, SPAC$AK IS TO CALL XYZ, WHICH HAS BEEN SET        AFB1004
*     EQUAL TO THE ENTRY TO SUBROUTINE SPC1$AK, WHICH IS ALREADY         AFB1004
*     IN CORE. THIS AVOIDS DESTROYING THE RETURN ADDRESS FROM            AFB1004
*     MALR$AK OR MKRM$AK, SAVED AT CCAL$AA.                              AFB1004
*                                                                        AFB1004
*     NEWLNG IS THE LENGTH IN CHARACTERS OF THE NEW RECORD FOR           AFB1004
*       WHICH WE NEED ROOM.                                              AFB1004
*     IF CURPTR=0, THE RECORD IS TO BE STORED AS A NATIVE.               AFB1004
*     IF CURPTR=1, THE RECORD IS TO BE STORED AS AN ALIEN, AND           AFB1004
*       AN EXTRA WORD OF ROOM WILL BE NEEDED, TO TAKE CARE OF            AFB1004
*       THE BACKPOINTER.                                                 AFB1004
*                                                                        AFB1004
*     FTCOP[0] CONTAINS THE CODE FOR THE CURRENT OPERATION. IF           AFB1004
*       THIS IS A REPLACE, SPAC$AK ((MUST NOT FAIL)), FOR                AFB1004
*       REASONS DISCUSSED IN THE NOTES TO REPL$AK.                       AFB1004
*                                                                        GAG0905
* CD  EXIT CONDITIONS                                                    GAG0905
*                                                                        GAG0905
*     GCOM CELL NEWBNUM WILL BE SET TO THE PRU NUMBER OF BLOCK TO BE     GAG0905
*     USED IF A BLOCK IS FOUND, 0 OTHERWISE.                             GAG0905
*                                                                        AFB1004
*     IF NEWBNUM IS NOT 0, THE BLOCK IS NOW IN CORE,                     AFB1004
*       PTREEWRD[CURPTR] POINTS TO IT, P<BLOK$AA> IS ITS FWA,            AFB1004
*       BLOCLWA IS ITS LWA+1.                                            AFB1004
*                                                                        AFB1004
*     IF WE HAVE HAD TO MAKE SPACE BY CREATING A BLOCK BEYOND            AFB1004
*       THE OFFICIAL MAXIMUM SIZE OF THE FILE, AS EXPLAINED IN           AFB1004
*       THE COMMENTS TO REPL$AK, THE FLAG FSINXFUL[0] IN THE FSTT        AFB1004
*       HAS BEEN SENT TO 1. THIS WILL PREVENT ANY FURTHER PUTS OR        AFB1004
*       REPLACES.                                                        AFB1004
*     FSSPSRCNT[0] HAS BEEN INCREASED  BY 1. THIS IS THE COUNT OF        AFB1004
*       THE NUMBER OF TIMES SPAC$AK HAS BEEN CALLED FOR THIS FILE        AFB1004
*       SINCE THE LAST TIME A SERIAL SCAN FOR SPACE WAS DONE (OR         AFB1004
*       SINCE BIRTH IF SUCH A SCAN NEVER YET.)                           AFB1004
*                                                                        GAG0905
* CD  ERROR CONDITIONS                                                   GAG0905
*                                                                        GAG0905
*     EC250 (NONFATAL) - THE FILE IS TOO FULL, WE CANT FIND A            AFB1004
*       BLOCK WITH ROOM. HOWEVER, IF THE CURRENT OPERATION IS            AFB1004
*       A REPLACE, WE HAVE CREATED ONE MORE BLOCK, WHICH AN              AFB1004
*       ORDINARY KEY IS NOT BIG ENOUGH TO ADDRESS, BUT WHICH             AFB1004
*       AN OVERFLOW POINTER CAN ADDRESS, AND THEN SET FSINXFUL[0]        AFB1004
*       TO PREVENT ANY FURTHER PUTS OR REPLACES.                         AFB1004
*     NOTE046 (NONFATAL) - THE CALL WAS MADE WITH NONZERO IN             AFB1004
*       PARAMETER PAD, WHICH MUST MEAN WE WERE DOING A PUT WITHOUT       AFB1004
*       KEY, BUT WE COULDNT FIND ROOM WHILE ALLOWING THE PADDING,        AFB1004
*       AND HAD TO MAKE A SECOND PASS USING ZERO PADDING. WHETHER        AFB1004
*       OR NOT THE SECOND PASS SUCCEEDED, THIS MESSAGE 046 IS            AFB1004
*       GIVEN THE USER TO WARN THAT THE FILE IS UNCOMFORTABLY            AFB1004
*       FULL.                                                            AFB1004
*                                                                        GAG0905
* CD  CALLED ROUTINES.                                                   GAG0905
*                                                                        GAG0905
*     MSGZ$AA - PUT OUT DIAGNOSTIC.                                      GAG0905
*     SPC1$AK - DO THE ((RARE)) PART OF THE SPACE SEARCH.                AFB1004
*       THIS IS CALLED EITHER BY MACRO SPC1CLL OR UNDER THE              AFB1004
*       ALIAS XYZ, FOR REASONS EXPLAINED ABOVE UNDER ENTRY               AFB1004
*       CONDITIONS.                                                      AFB1004
*     NUBL$AA - TO ADD A NEW BLOCK AT THE END OF THE FILE.               AFB1004
*       THIS IS CALLED ONLY FOR THE DESPERATE CASE OF A                  AFB1004
*       REPLACE, AS MENTIONED ABOVE, BECAUSE NUBL$AA, UNLIKE             AFB1004
*       NUBL$AK, DISREGARDS THE MAXIMUM FILE SIZE IMPOSED                AFB1004
*       BY KEY SIZE.                                                     AFB1004
*     UNFX$AA - NUBL$AA INCLUDES, FOR REASONS IRRELEVANT TO              AFB1004
*       AK, A FREEZE OF THE NEW BLOCK. UNFX$AA IS CALLED                 AFB1004
*       TO LEAVE IT UNFROZEN AND IN THE KICKOUT CHAIN.                   AFB1004
*     RDBK$AK - TO READ IN THE BLOCK THAT PTREEWRD[CURPTR]               AFB1004
*       POINTS TO, AND SET P<BLOK$AA> AND BLOCLWA.                       AFB1004
*                                                                        GAG0905
* CD  DESCRIPTION                                                        GAG0905
*                                                                        GAG0905
*     THERE ARE 5 STAGES TO THE SPACE SEARCH PROCESS.                    GAG0905
*     1. LOOK FOR SPACE IN THE IN CORE BLOCKS.  USE THE ONE WITH         GAG0905
*        THE TIGHTEST FIT.  IF NO BLOCKS QUALIFY, TRY NEXT STAGE.        GAG0905
*     2. CONSULT THE MOST EMPTY TABLE.  FIND AN ENTRY THAT WILL          GAG0905
*        PROVIDE THE TIGHTEST FIT. IF FAIL, CALL SPC1$AK TO CONTINUE.    AFB1004
*     3. IN SPC1$AK, TOTAL UP THE NUMBER OF BLOCKS FROM THE PERCENT      GAG0905
*     EMPTY TABLE THAT ARE LARGE ENOUGH TO ACCEPT THE NEW RCORD.  IF     GAG0905
*     THIS TOTAL DIVIDED BY TOTAL NUMBER OF BLOCKS IN THE FILE IS        GAG0905
*     LARGER THAN FSPRCNTBK, WE WILL START UP A SERIAL PROBE FOR SPACE   GAG0905
*     WE WILL START AT FSTRIGBNO.  THE BLOCK IS READ FROM DISK, AND WE   GAG0905
*     TEST IF THERE IS ENOUGH ROOM.  IF SO THE BLOCK IS USED.  OTHER-    GAG0905
*     WISE, THE PROCESS IS REPEATED FOR FSPROBLIM TIMES.                 GAG0905
*     4. IF WE FAIL AT 3, WE WILL TRY TO EXTEND THE FILE BY 1 BLOCK.     GAG0905
*        THE NEW BLOCK WILL THEN BE USED.  THIS MIGHT FAIL IF WE HAVE    GAG0905
*        USED THE LAST BLOCK NUMBER THAT CAN BE DESCRIBED BY THE AK      GAG0905
*        KEY.  IF SO, WE TRY OUR LAST RESORT.                            GAG0905
*     5.  FROM 3, WE CAN TELL IF WE HAVE AT LEAST ONE BLOCK IN THE FILE  GAG0905
*        THAT CAN ACCOMODATE THE NEW RECORD.  IF WE DO NOT, THEN WE GIVE GAG0905
*        UP.  OTHERWISE, WE WILL ATTEMPT A SEARCH OF THE FILE FROM       GAG0905
*        BEGINNING TO END.  WE WILL PUT OUT A NOTE TO THE USER TO WARN   GAG0905
*        THE USER FIRST.  STEP 5 WILL ALSO BE SKIPPED IF THE FSSRCNT IS  GAG0905
*        LESS THAN 2 * LENGTH OF THE MOST EMPTY TABLE.  THE JUSTIFICA-   GAG0905
*        TION BEHIND THAT IS EVERY TIME WE DO A COMPLETE PASS OF THE     GAG0905
*        FILE, THE COUNT IS ZEROED OUT.  HENCE, THE COUNTER FSSRCNT SHOW GAG0905
*        US HOW MANY SPACE SEARCH REQUESTS HAVE BEEN MADE SINCE THE LAST GAG0905
*        COMPLETE PASS.  EVERY COMPLETE PASS RESULTS IN THE MOST EMPTY   GAG0905
*        TABLE BEING UPDATED TO REFLECT THE DFMETLG(16) BEST ENTRIES FOR GAG0905
*        THE FILE.  IF ANOTHER SPACE REQUEST COMES IN SHORTLY AFTERWARDS GAG0905
*        THAT FAILS TO BE HONORED BY THE MOST EMPTY TABLE,  CHANCES ARE  GAG0905
*        THAT THE FILE IS SO FULL THAT ANOTHER SERIAL SEARCH IS JUST     GAG0905
*        GOING TO BE A WASTE OF TIME.                                    GAG0905
*     WHEN THE SPACE ROUTINE IS CALLED, IT MIGHT BE CALLED FOR A PUT     GAG0905
*     WITHOUT KEY.  AS WE ARE AT LIBERTY TO PUT THE RECORD ANYWHERE,     GAG0905
*     IT IS RIGHT TO HONOR PADDING IF POSSIBLE.  BUT IF THE SPACE        GAG0905
*     SEARCH HAS FAILED, IT IS LONGER TIME FOR LUXURY, SO WE WILL        GAG0905
*     RETRY THE SPACE SEARCH PROCESS WITH PAD = 0.  PAD WILL BE 0 ON     GAG0905
*     ENTRY IF WE ARE DOING A PUT WITH KEY, OR A REPLACE.                GAG0905
*     IF WE GET TO THE END OF THIS PROCESS WITH PAD=0, THE               AFB1004
*     OPERATION IS GOING TO FAIL BECAUSE THERE IS SIMPLY NO ROOM         AFB1004
*     IN THE FILE. BUT IF THE OPERATION IS A REPLACE, FOR REASONS        AFB1004
*     DESCRIBED IN THE NOTES TO SUBROUTINE REPL$AK, IT WOULD BE          AFB1004
*     VERY AWKWARD TO LET IT FAIL. INSTEAD, WE ADD ONE MORE BLOCK        AFB1004
*     TO THE END OF THE FILE, AND SET FSINXFUL TO PREVENT ANY MORE       AFB1004
*     PUTS OR REPLACES IN FUTURE.                                        AFB1004
 #                                                                       GAG0905
          ITEM PAD , PRU , WHO ;                                         GAG0905
          FPRC XYZ ;                                                     GAG0905
          ITEM UNUSE , RCLG ;                                            GAG0905
                                                                         GAG0905
          FSSPSRCNT = FSSPSRCNT + 1;  #BUMP SPACE REQUEST COUNTER#       GAG0905
TRYAGAIN:                        #TAG FOR RETRY IF PAD NE 0#             GAG0905
          RCLG = PAD + WLG(NEWLNG) * 2 ;                                 GAG0905
          IF CURPTR NQ 0                                                 GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              RCLG = RCLG + 2 ;                                          GAG0905
              END                                                        GAG0905
          NEWBNUM = 0;                                                   GAG0905
          UNUSE = 2 ** 15;   #INITIALIZE TO LARGE NUMBER FOR COMPARE#    GAG0905
          P<BLOK$AA> = P<FSTT$AA>;                                       GAG0905
          ASLONGAS BLKFPTR[0] NQ LOC(FSFRM2[0]) DO  #FOLLOW IN CORE      GAG0905
                                                       BLOCKS CHAIN#     GAG0905
                  BEGIN                                                  GAG0905
                  P<BLOK$AA>=BLKFPTR[0]-1; #FOLLOW FORWARD BLK CHAIN#    GAG0905
                  IF BLOCKID NQ PRU  #EXCLUDE PRU#                       GAG0905
                  AND (BLFRESLTS NQ 0 OR RC LS FSBKFACTR) #FREE SLOTS#   GAG0905
                  AND BLRIP[0] EQ 0 
                  THEN                                                   GAG0905
                      BEGIN                                              GAG0905
                      T1 = EC - RCLG ;                                   GAG0905
                      IF (T1 GR 0 OR (T1 EQ 0 AND BLFRESLTS NQ 0) )      GAG0905
                       AND T1 LS UNUSE                                   GAG0905
                      THEN                                               GAG0905
                          BEGIN                                          GAG0905
                          UNUSE = T1 ;                                   GAG0905
                          NEWBNUM = BLOCKID[0] ;                         GAG0905
                          END                                            GAG0905
                      END                                                GAG0905
                  END                                                    GAG0905
              IF NEWBNUM NQ 0                                            GAG0905
              THEN                                                       GAG0905
                  BEGIN                                                  GAG0905
                  GOTO EXSP;    #EXIT WITH BLOCK NO#                     GAG0905
                  END                                                    GAG0905
              ELSE                                                       GAG0905
                  BEGIN                                                  GAG0905
                  FOR IX = 0 STEP 1 UNTIL DFMETLG -1 DO                  GAG0905
                      BEGIN    #SEARCH MOST EMPTY TABLE#                 GAG0905
                      IF FSMTPRU[IX] NQ PRU   #EXCLUDE PRU#              GAG0905
                      AND FSMTUSW[IX] - RCLG GQ 0 #ENOUGH SAPCE#         GAG0905
                      AND FSMTUSW[IX] - RCLG LS UNUSE #TIGHTER FIT#      GAG0905
                      THEN                                               GAG0905
                          BEGIN                                          GAG0905
                          UNUSE = FSMTUSW[IX] - RCLG;                    GAG0905
                          NEWBNUM = FSMTPRU[IX]; #USE NEW BN#            GAG0905
                          END                                            GAG0905
                      END                                                GAG0905
                  END                                                    GAG0905
              IF NEWBNUM NQ 0                                            GAG0905
              THEN                                                       GAG0905
                  BEGIN                                                  GAG0905
                  GOTO EXSP;                                             GAG0905
                  END                                                    GAG0905
              ELSE                                                       GAG0905
                  BEGIN                                                  GAG0905
                  IF WHO EQ 0                                            GAG0905
                  THEN                                                   GAG0905
                      BEGIN                                              GAG0905
                      SPC1CLL ( RCLG , PRU ) ;                           GAG0905
                          #RARE CAPSULE WITH CONTINUATION MAY HAVE       GAG0905
                            TO BE LOADED#                                GAG0905
                      END                                                GAG0905
                  ELSE                                                   GAG0905
                      BEGIN                                              GAG0905
                      XYZ ( RCLG , PRU ) ;                               GAG0905
                        #WE WERE CALLED FROM A ROUTINE IN THE SAME       GAG0905
                          RARE CAPSULE, DONT TRY TO LOAD IT TWICE#       GAG0905
                      END                                                GAG0905
                  END                                                    GAG0905
              IF NEWBNUM NQ 0                                            GAG0905
              THEN                                                       GAG0905
                  BEGIN                                                  GAG0905
                  GOTO EXSP;                                             GAG0905
                  END                                                    GAG0905
              ELSE                                                       GAG0905
                  BEGIN                                                  GAG0905
                  IF PAD EQ 0                                            GAG0905
                  THEN                                                   GAG0905
                      BEGIN                                              GAG0905
                      MSGZ$AA ( EC250 ) ;                                GAG0905
                      IF FTCOP[0] EQ OP"RPL"                             GAG0905
                      THEN                                               GAG0905
                          BEGIN #MUST NOT FAIL#                          GAG0905
                          FSINXFUL[0] = 1 ;                              GAG0905
                          NUBL$AA ( 0 ) ;                                AFB1004
                          UNFX$AA ( 0 ) ;                                AFB1004
                          END                                            GAG0905
                      ELSE                                               GAG0905
                          BEGIN                                          GAG0905
                          RETURN ;                                       GAG0905
                          END                                            GAG0905
                      END                                                GAG0905
                  ELSE                                                   GAG0905
                      BEGIN                                              GAG0905
                      PAD = 0;                                           GAG0905
                      MSGZ$AA(NOTE046); #PADDING NOT HONORED#            GAG0905
                      GOTO TRYAGAIN;  #TRY WITH PAD=0#                   GAG0905
                      END                                                GAG0905
EXSP:                                                                    GAG0905
                  PTREEWRD[CURPTR] = NEWBNUM ;                           GAG0905
                  RDBK$AK ( 1 ) ;                                        GAG0905
                  END                                                    GAG0905
          END                                                            GAG0905
CONTROL EJECT ; 
PROC SVEC$AK ;
 #
* *   SVEC$AK - SET OLDEC TO THE EFFECTIVE EMPTY COUNT OF THE BLOCK 
* *   A.F.R.BROWN 
* 1DC SVEC$AK 
* 
* DC  FUNCTION
* 
*     TO SAVE A STARTING VALUE OF THE EFFECTIVE EMPTY COUNT OF THE
*     CURRENT BLOCK, WHICH PCEM$AK MAY USE IN CONNECTION WITH A 
*     FINAL VALUE TO DECIDE HOW TO MODIFY THE PERCENT-EMPTY TABLE 
*     IN THE FSTT (FSPCEMTAB). THE EFFECTIVE EMPTY COUNT = EC 
*     IF THE BLOCK HAS AT LEAST ONE AVAILABLE SLOT, OR 0 IF NOT.
* 
* DC  EROOR CONDITIONS
* 
*     NONE
* 
* DC  CALLED ROUTINES 
* 
*     NONE
* 
 #
      BEGIN 
      IF RC EQ FSBKFACTR AND BLFRESLTS EQ 0 
      THEN
          BEGIN 
          OLDEC = 0 ; 
          END 
      ELSE
          BEGIN 
          OLDEC = EC ;
          END 
      END 
PROC ZIPMIP ( N ) ;      CONTROL EJECT ;                                 GAG0905
 #                                                                       AFB1004
* *   ZIPMIP - DO THE MIP WORK FOR AN AK PUT/REPLACE        PAGE 1       AFB1004
* *   A.F.R.BROWN                                                        AFB1004
* 1DC ZIPMIP                                                             AFB1004
*                                                                        AFB1004
* DC  FUNCTION                                                           AFB1004
*                                                                        AFB1004
*     DURING AN AK PUT OR REPLACE, TO SEE IF THERE IS A PARTNER MIP      AFB1004
*     FILE THAT ALSO HAS TO BE UPDATED, AND IF SO TO DO IT.              AFB1004
*                                                                        AFB1004
* DC  ENTRY CONDITIONS                                                   AFB1004
*                                                                        AFB1004
*     THERE IS ONE FORMAL PARAMETER, N, WHICH TELLS WHAT TO DO IF        AFB1004
*     THERE IS A MIP FILE, BUT THE ATTEMPT TO UPDATE IT FAILS            AFB1004
*     ON ACCOUNT OF A DUPLICATE ALTERNATE KEY VALUE.                     AFB1004
*     IF N=0, NOTHING IS DONE TO THE AK FILE BY ZIPMIP IN THAT CASE.     AFB1004
*     IF N IS NOT 0, THE CURRENT RECORD IS TO BE DELETED FROM            AFB1004
*     THE AK FILE, BECAUSE IT IS THE ALREADY-INSERTED NEW RECORD.        AFB1004
*     (THE SIMPLE CALL TO DELL$AK WOULD NOT BE ENOUGH IF                 AFB1004
*     THE CURRENT RECORD WERE NOT A SIMPLE RECORD IN ITS                 AFB1004
*     OWN NATIVE SLOT. BUT ZIPMIP WITH A NON-ZERO PARAMETER              AFB1004
*     IS CALLED ONLY DURING A PUT WITHOUT KEY, WHICH ALWAYS              AFB1004
*     FINDS A NATIVE SLOT FOR THE NEW AK RECORD.)                        AFB1004
*                                                                        AFB1004
*     VARIABLE MIP = 0 IF NO MIP, NON-ZERO IF YES MIP.                   AFB1004
*                                                                        AFB1004
*     FTCOP[0] IS THE OPERATION CODE TELLING WHETHER THIS IS PART        AFB1004
*       OF A PUT OR A REPLACE.                                           AFB1004
*                                                                        AFB1004
*     IF THERE IS MIP, THE ENTRY CONDITIONS ARE AS FOR SUBROUTINE        AFB1004
*     REPL$MP OR PUT$MP, WHICH SEE IN PROGRAM NRO$MP.                    AFB1004
*     WE ARE POSITIONED AT THE CURRENT POSITION OF THE AK FILE WHEN      AFB1004
*     WE CALL REPL$MP OR PUT$MP, AND THEY RETURN US TO THE SAME          AFB1004
*     POSITION OF THE AK FILE BEFORE RETURNING.                          AFB1004
*                                                                        AFB1004
* DC  EXIT CONDITIONS                                                    AFB1004
*                                                                        AFB1004
*     IF MIP=0, NOTHING HAS BEEN DONE BUT RHO = 0.                       AFB1004
*                                                                        AFB1004
*     OTHERWISE, IF RHO=0, THE MIP WORK HAS ALL BEEN DONE.               AFB1004
*     NEWFWA, NEWLNG, KEYFWA, AND KEYOFF HAVE ALL BEEN SAVED AND         AFB1004
*     RESTORED, BECAUSE THEY ARE PROBABLY NEEDED TO DESCRIBE THE         AFB1004
*     NEW RECORD AND ITS KEY. NRECINS HAS BEEN RESET TO 1, ITS           AFB1004
*     NORMAL VALUE, AS ONLY ONE RECORD IS PUT AT A TIME IN AK.           AFB1004
*     IT MIGHT HAVE BEEN SET HIGHER BY MIP, BECAUSE IN AN INDEX          AFB1004
*     BLOCK OF AN IS-TYPE FILE, INDEX RECORDS SOMETIMES GO IN            AFB1004
*     2 OR 3 AT A TIME.                                                  AFB1004
*                                                                        AFB1004
*     IF RHO IS NOT 0, THE OPERATION WAS IMPOSSIBLE BECAUSE OF           AFB1004
*     A DUPLICATE ALTERNATE KEY VALUE IN THE NEW RECORD,                 AFB1004
*     BELONGING TO A SERIES OF ALTERNATE KEYS FOR WHICH UNIQUE           AFB1004
*     VALUES ARE REQUIRED. ANY CHANGES MADE TO THE MIP FILE              AFB1004
*     BEFORE THIS DISCOVERY HAVE BEEN UNDONE. IF THE FORMAL              AFB1004
*     PARAMETER TO ZIPMIP WAS NON-ZERO, THE CURRENT RECORD               AFB1004
*     HAS ALSO BEEN DELETED FROM THE AK FILE, THIS BEING                 AFB1004
*     THE NEW RECORD, ALREADY INSERTED. IF THE PARAMETER                 AFB1004
*     WAS 0, THE NEW RECORD HAD NOT YET BEEN INSERTED, SO HAS            AFB1004
*     NOT BEEN DELETED.                                                  AFB1004
*                                                                        AFB1004
* DC  ERROR CONDITIONS                                                   AFB1004
*                                                                        AFB1004
*     EC503 (NON-FATAL) - DUPLICATE ALTERNATE KEY VALUE, AS              AFB1004
*       DESCRIBED ABOVE. THIS IS IN ADDITION TO RHO NON-ZERO,            AFB1004
*       WHICH IS THE SIGNAL OF THE SAME THING TO THE ROUTINE             AFB1004
*       THAT CALLED ZIPMIP.                                              AFB1004
*                                                                        AFB1004
* DC  CALLED ROUTINES                                                    AFB1004
*                                                                        AFB1004
*     REPL$MP - TO DO THE MIP PART OF A REPLACE.                         AFB1004
*     PUT$MP - TO DO THE MIP PART OF A PUT.                              AFB1004
*     CURR$AA - TO POSITION US AT THE CURRENT BLOCK AND                  AFB1004
*       RECORD, ACCORDING TO THE PTREEWRD[CURPTR], WHICH                 AFB1004
*       IN THIS CASE WILL POINT TO THE NEW RECORD IN THE                 AFB1004
*       AK FILE.                                                         AFB1004
*     DELL$AK - TO DELETE THE CURRENT RECORD IN THE AK FILE.             AFB1004
*                                                                        AFB1004
* DC  NON-LOCAL VARIABLES                                                AFB1004
*                                                                        AFB1004
*     NONE                                                               AFB1004
 #                                                                       AFB1004
          BEGIN                                                          GAG0905
          ITEM N , SA , SB , SC , SD ;                                   GAG0905
                                                                         GAG0905
          RHO = 0 ;                                                      GAG0905
          IF MIP NQ 0                                                    GAG0905
          THEN                                                           GAG0905
              BEGIN                                                      GAG0905
              SA = NEWFWA ;                                              GAG0905
              SB = NEWLNG ;                                              GAG0905
              SC = KEYFWA ;                                              GAG0905
              SD = KEYOFF ;                                              GAG0905
              IF FTCOP[0] EQ OP"RPL"                                     GAG0905
              THEN                                                       GAG0905
                  BEGIN                                                  GAG0905
                  REPL$MP ;                                              GAG0905
                  END                                                    GAG0905
              ELSE                                                       GAG0905
                  BEGIN                                                  GAG0905
                  PUT$MP ;                                               GAG0905
                  END                                                    GAG0905
              IF RHO NQ 0                                                GAG0905
              THEN                                                       GAG0905
                  BEGIN                                                  GAG0905
                  IF N NQ 0                                              GAG0905
                  THEN                                                   GAG0905
                      BEGIN                                              GAG0905
                      CURR$AA ;                                          GAG0905
                      DELL$AK ;                                          GAG0905
                      END                                                GAG0905
                  END                                                    GAG0905
              NEWFWA = SA ;                                              GAG0905
              NEWLNG = SB ;                                              GAG0905
              KEYFWA = SC ;                                              GAG0905
              KEYOFF = SD ;                                              GAG0905
              NRECINS = 1 ;                                              GAG0905
              END                                                        GAG0905
          END                                                            GAG0905
      END                                                                GAG0905
      TERM;                                                              GAG0905
