*DECK,AAMDAA
*CALL COMUSETXT 
PROC AAM$AA;
      BEGIN 
                                                                         SAAM3
     XREF BEGIN                                                          SAAM3
          PROC MOVC$AA ;                                                 SAAM3
          PROC OWN$AA;       #JUMP TO OWN-CODE EXIT#                     JJJ1109
          PROC CPCH$AA ;                                                 SAAM3
          PROC MOVW$AA ;                                                 SAAM3
          PROC MERR ;                                                    SAAM3
          PROC BACK$IS ;                                                 SAAM3
          FUNC CMM$GOS;      #GET CMM STATS FOR TARGET CALC#             JJJ0402
          PROC LEVL$MP;                                                  JJJ0916
          PROC CRA1$AA;                                                  SAAM3
          FUNC ALFB$AA ;                                                 SAAM3
          PROC CMM$FRF ;                                                 SAAM3
          PROC UNL1$AA ;                                                 SAAM3
          PROC SLOG$AA ;                                                002000
          PROC ER$SRM;
          LABEL EXIT$AA;
          PROC TRN1$IS;                                                  VBG1025
          PROC CCAL$AA ;
          PROC DMPM$AA ;
          ITEM AAM$PBC ;
          END                                                            SAAM3
                                                                         SAAM3
CONTROL WEAK SLOG$AA,BACK$IS,LEVL$MP,TRN1$IS ;                          002200
                                                                         JJJ0724
     XDEF BEGIN                                                          SAAM3
          FUNC MXPR$AA ;
          PROC CMOV$AA;                                                  JJJ0811
          PROC CMMX$AA ;
          PROC MSGD$AA; 
          PROC MSGZ$AA; 
          PROC MSGF$AA; 
          PROC MSGO$AA; 
          PROC VOKG$AA; 
          CONTROL IFEQ 1,2 ; # CKSM$AA MOVED TO MISC$AA #                AFB0707
          FUNC CKSM$AA  U ;                                              SAAM3MO
          CONTROL ENDIF ;                                                AFB0707
          PROC FLSH$AA;                                                  JJJ0927
          PROC ALTR$AA ;                                                 SAAM3
          FUNC RESP$AA;      #RELEASE A GIVEN AMOUNT OF CMM SPACE#
          PROC RJUV$AA ;                                                 SAAM3
          PROC IMPR$AA; 
          PROC INCH$AA ;                                                 SAAM3
          PROC UNCH$AA ;                                                 SAAM3
          PROC MFET$AA ;                                                 SAAM3
          PROC IOWR$AA ;                                                 SAAM3
          PROC LOCB$AA ;                                                 SAAM3
          PROC EXRP$AA ;
          CONTROL IFEQ 1,2 ;                                             AFB0707
          # LWAD$AA,RPGT$AA,LOCR$AA MOVED TO MISC$AA#                    AFB0707
          FUNC LWAD$AA ;                                                 SAAM3
          PROC RPGT$AA ;                                                 SAAM3
          PROC LOCR$AA ;                                                 SAAM3
          CONTROL ENDIF ;                                                AFB0707
          PROC SEBL$AA ;                                                 SAAM3
          PROC CURR$AA ;                                                 SAAM3
          PROC GOFI$AA ;                                                 SAAM3
          PROC SKPF$AA ;                                                 SAAM3
          PROC STPF$AA ;                                                 SAAM3
          PROC BACK$AA ;                                                 SAAM3
          CONTROL IFEQ 1,2 ; #CPKY$AA MOVED TO MISC$AA#                  AFB0707
          PROC CPKY$AA ;                                                 SAAM3
          CONTROL ENDIF ;                                                AFB0707
          PROC FRLR$AA ;                                                 SAAM3
          FUNC QUMP$AA ;                                                 SAAM3
          PROC RDRC$AA ;                                                 SAAM3
          FUNC UUCC$AA ;                                                 SAAM3
          PROC STMD$AA ;                                                 SAAM3
          PROC SETR$AA ;                                                 SAAM3
          PROC STOV$AA ;                                                 SAAM3
          PROC SPKY$AA ;                                                 AFB0517
          PROC FILP$AA ;                                                 AFB0517
          PROC DABL$AA ;                                                 SAAM3
          FUNC SPRD$AA ;
          PROC TROW$AA ;                                                 SAAM3
          PROC WTIO$AA;                                                  RPNMIP 
          PROC HAWK$AA ;                                                 SAAM3
          PROC BCK1$AA ;                                                 SAAM3
          PROC FIXX$AA ;                                                 SAAM3
          PROC UNFX$AA ;                                                 SAAM3
          PROC LGFS$AA; 
          PROC LKEY$AA ;     #SET TEMPLOC AND TEMPOS#                    AFB0204
          END                                                            SAAM3
                                                                         SAAM3
                                                                         SAAM3
                                                                         SAAM3
          ITEM IX , IX2;     #USED AS INDUCTION VARIABLES#
          ITEM ENUM;         #ERR CODE# 
          ITEM BBLKORD;      #BAD BLOCK ORDINAL#
          ITEM T1 , T2;      #TEMP VARIABLES#                            ID0913 
          ITEM T3;           #ANOTHER TEMP#                              JJJ0625
          ITEM KRETWRD , KRETPOS;  #COMMUNICATION WITH RETPRKEY#         AFB0517
                                                                         DABBLE 
          DEF MSEX(N) #ENUM=N;GOTO MXEX# ;                               DABBLE 
                                                                         DABBLE 
MXEX:                                                                    DABBLE 
          MSGZ$AA ( ENUM ) ;                                             DABBLE 
          GOTO EXIT$AA ;                                                 DABBLE 
CONTROL EJECT ;                                                          JJJ1116
FUNC CHECKWRT ;                                                          JJJ1116
          BEGIN                                                          JJJ1116
                                                                         JJJ1116
 #                                                                       JJJ1116
* *   CHECKWRT - WAS THIS BLOCK WELL WRITTEN            PAGE 1           JJJ1116
* *   A.F.R.BROWN                                                        JJJ1116
* 1DC CHECKWRT                                                           JJJ1116
*                                                                        JJJ1116
* DC  FUNCTION                                                           JJJ1116
*                                                                        JJJ1116
*     WHENEVER A BLOCK IS WRITTEN, SOONER OR LATER THEREAFTER            JJJ1116
*     WTIO$AA IS CALLED FOR THAT FET, AND IT COPIES THE STATUS           JJJ1116
*     FROM BITS 0-8 OF THE FIRST WORD OF THE FET INTO THE                JJJ1116
*     BLCODSTAT FIELD OF THE BLOCK FRAME, AND ALSO FIGURES FROM          JJJ1116
*     THE FET POINTERS HOW MANY WORDS WERE ACTUALLY WRITTEN, AND         JJJ1116
*     STORES THE NUMBER IN THE BLKLNG[0] FIELD OF THE BLOCK FRAME.       JJJ1116
*                                                                        JJJ1116
*     THE GOODNESS OF THE WRITE IS ACTUALLY CHECKED STILL LATER,         JJJ1116
*     BY A CALL TO CHECKWRT, A FUNCTION THAT IS 0 FOR GOOD, OR           JJJ1116
*     NON-ZERO FOR BAD.                                                  JJJ1116
*                                                                        JJJ1116
* DC  ENTRY CONDITIONS                                                   JJJ1116
*                                                                        JJJ1116
*     P<BLOK$AA> LOCATES THE BLOCK TO BE CHECKED. IT MUST HAVE           JJJ1116
*       BEEN WRITTEN, AND WTIO$AA MUST HAVE BEEN CALLED FOR THAT         JJJ1116
*       FET, BUT THIS MUST BE THE FIRST TIME CHECKWRT IS CALLED          JJJ1116
*       SINCE THEN.                                                      JJJ1116
*                                                                        CY210
*     BLWIP[0] MUST BE 1, SHOWING IT IS THE FIRST TIME  CHECKWRT HAS     CY210
*       BEEN CALLED SINCE THE WRITE OF THE BLOCK. (BLWIP[0] IS           CY210
*       SET TO 1 BY  IOWRITE .)                                          CY210
*                                                                        JJJ1116
*     BLCODSTAT[0] AND BLKLNG[0] ARE SET IN THE BLOCK FRAME              JJJ1116
*       AS DESCRIBED ABOVE UNDER ((FUNCTION)).                           JJJ1116
*                                                                        JJJ1116
* DC  EXIT CONDITIONS                                                    JJJ1116
*                                                                        JJJ1116
*     THIS ROUTINE IS A FUNCTION, RETURNING AN ANSWER IN X6 IN THE       JJJ1116
*     USUAL SYMPL WAY. THIS RESULT IN X6 IS 0 IF THE BLOCK WAS WELL      JJJ1116
*     WRITTEN, AND OTHERWISE IS A COPY OF BLCODSTAT[0], WHICH OF COURSE  JJJ1116
*     IS THE FET STATUS.                                                 JJJ1116
*                                                                        JJJ1116
*     BLCODSTAT[0], BLWIP[0], AND BLXTEND[0] ARE SET TO 0.               CY210
*     (BLXTEND[0]=1 MEANS THAT THE BLOCK HAS BEEN WRITTEN FOR THE        CY210
*     FIRST TIME, AT THE PHYSICAL END OF THE FILE. IT IS SET TO          CY210
*     0 OR 1 BY NUBL$AA.)                                                CY210
*                                                                        JJJ1116
* DC  ERROR CONDITIONS                                                   JJJ1116
*                                                                        JJJ1116
*     NONE                                                               JJJ1116
*                                                                        JJJ1116
* DC  CALLED ROUTINES                                                    JJJ1116
*                                                                        JJJ1116
*     NONE                                                               JJJ1116
*                                                                        JJJ1116
* DC  NON-LOCAL VARIABLES                                                JJJ1116
*                                                                        JJJ1116
*     NONE                                                               JJJ1116
*                                                                        JJJ1116
 #                                                                       JJJ1116
                          # START OF CHECKWRT CODE #                     JJJ1116
        ITEM X , Y ;           # LOCAL TEMP #                            JJJ1116
                                                                         JJJ1116
          BLWIP[0] = 0 ;                                                 JJJ1116
          X = BLCODSTAT[0] ;                                             JJJ1116
          BLCODSTAT[0] = 0 ;                                             JJJ1116
          IF BLOCKID[0] EQ 1                                             JJJ1116
            THEN Y = 126 ;                                               JJJ1116
            ELSE Y = ( 64 * FSBLKSIZ[0] - 2 ) ;                          JJJ1116
          IF ( X EQ O"25" OR X EQ O"225" ) AND BLKLNG[0] EQ Y            JJJ1116
            THEN BEGIN                                                  017400
              BLXTEND[0] = 0 ;                                          017500
              CHECKWRT = 0 ;                                            017600
            END                                                         017700
            ELSE CHECKWRT = X ;                                          JJJ1116
          END                                                            JJJ1116
CONTROL EJECT;                                                           JJJ0625
          XREF FUNC CKSM$AA U ;                                          AFB0707
          CONTROL IFEQ 1,2 ;   # CKSM$AA MOVED TO MISC$AA #              AFB0707
FUNC CKSM$AA U;                                                          JJJ0625
          BEGIN                                                          JJJ0625
 #                                                                       CY210
* *   CKSM$AA -- FORM THE CHECKSUM OF THE BLOCK, AS A FUNCTION    PAGE 1 CY210
* *   A.F.R.BROWN                                                        CY210
* 1DC CKSM$AA                                                            CY210
*                                                                        CY210
* DC  FUNCTION                                                           CY210
*                                                                        CY210
*     TO RETURN THE CHECKSUM OF THE CURRENT BLOCK IN X6, AS A            CY210
*     SYMPL FUNCTION.                                                    CY210
*                                                                        CY210
* DC  ENTRY CONDITIONS                                                   CY210
*                                                                        CY210
*     P<BLOK$AA> IS THE FWA OF THE BLOCK IMAGE AREA IN CORE.             CY210
*                                                                        CY210
* DC  EXIT CONDITIONS                                                    CY210
*                                                                        CY210
*     THE FUNCTION ( X6 ) IS THE CHECKSUM, FORMED BY THE FOLLOWING       CY210
*       STEPS --                                                         CY210
*       (1) ADD TOGETHER ALL THE WORDS OF THE BLOCK IMAGE EXCEPT THE     CY210
*        PREFIX WORDS, I.E. ALL THOSE FROM THE FIRST WORD OF THE FIRST   CY210
*        RECORD TO THE LAST WORD OF THE BLOCK, INCLUSIVE. THE ADDITION   CY210
*        IS BY ORDINARY 6600 ADDITION OF 60-BIT SIGNED INTEGERS.         CY210
*       (2) TAKE THE LEFT AND RIGHT HALVES OF THE RESULTANT 60-BIT SUM,  CY210
*        TREAT THEM AS 30-BIT POSITIVE INTEGERS, AND ADD THEM TOGETHER.  CY210
*       (3) TAKE THE LOW-ORDER 30 BITS OF THE SUM AS THE BLOCK           CY210
*        CHECKSUM.                                                       CY210
*                                                                        CY210
* DC  ERROR CONDITIONS                                                   CY210
*                                                                        CY210
*     NONE                                                               CY210
*                                                                        CY210
* DC  CALLED ROUTINES                                                    CY210
*                                                                        CY210
*     NONE                                                               CY210
*                                                                        CY210
* DC  NON-LOCAL VARIABLES                                                CY210
*                                                                        CY210
*     T1, T2, T3 USED AS SCRATCH.                                        CY210
*                                                                        CY210
 #                                                                       CY210
          T1 = BLKLNG[0] + 2;                                            JJJ0625
          T2 = 0;                                                        JJJ0625
          FOR T3 = 4 STEP 1 UNTIL T1                                     JJJ0625
              DO                                                         JJJ0625
              BEGIN                                                      JJJ0625
              T2 = T2 + BLWRD0[T3];                                      JJJ0625
              END                                                        JJJ0625
          T2 = B<0,30>T2 + B<30,30>T2;                                   JJJ0625
          CKSM$AA = B<30,30>T2;                                          JJJ0625
          END                                                            JJJ0625
          CONTROL ENDIF ;                                                AFB0707
CONTROL EJECT;                                                           SAAM3MO
      FUNC GCMM$AA (LGTH);                                               JJJ0907
        BEGIN                                                            JJJ0907
                                                                         JJJ0907
 #                                                                       JJJ0907
* *   GCMM$AA - GET A PARCEL OF MEMORY FROM CMM  PAGE  1                 AM2A077
* *   A.F.R.BROWN                                                        JJJ0907
* 1DC GCMM$AA  (A FUNCTION)                                              JJJ0907
*                                                                        JJJ0907
* DC  FUNCTION                                                           JJJ0907
*                                                                        JJJ0907
*     TO RETURN TO THE CALLER (IN X6, AS A SYMPL FUNCTION)               JJJ0907
*     THE FWA OF A PARCEL OF MANAGED MEMORY, OBTAINED FROM CMM,          JJJ0907
*     WHOSE LENGTH IN WORDS WAS GIVEN BY THE CALLER AS A PARAMETER.      JJJ0907
*     IN ADDITION TO CALLING A CMM ROUTINE TO REQUEST THE BLOCK, IT      JJJ0907
*     ADDS THE LENGTH TO RUNTOTCM, OUR RUNNING TOTAL OF CMM BLOCKS THAT  JJJ0916
*     MIGHT BE RELEASED, AND IF ANY BLOCK HAS BEEN ALTERED SINCE THE     JJJ0907
*     LAST TIME THIS SUBROUTINE WAS CALLED, IT LOOKS THROUGH THE         JJJ0907
*     KICK-OUT CHAIN AND TRIES TO INITIATE ENOUGH WRITES WITHOUT RECALL  JJJ0907
*     TO LEAVE A RESIDUE OF BLOCKS, MODIFIED AND NOT YET WRITTEN OUT,    JJJ0907
*     THAT IS NO MORE THAN 2/3 OF TARGET.  TARGET IS THE MAXIMUM         JJJ0916
*     TOTAL OF SPACE FOR BLOCKS (OTHER THAN FSTT-S) AND CAPSULES THAT    JJJ0907
*     WE ARE ALLOWING OURSELVES TO HOLD ON LOAN FROM CMM AT ANY ONE      JJJ0907
*     TIME.                                                              JJJ0907
*                                                                        JJJ0907
* DC  ENTRY CONDITIONS                                                   JJJ0907
*                                                                        JJJ0907
*     ONE PARAMETER MUST BE PASSED IN STANDARD FORM -- THE LENGTH        JJJ0907
*     IN WORDS OF THE WANTED PARCEL..                                    JJJ0907
*                                                                        JJJ0907
* DC  EXIT CONDITIONS                                                    JJJ0907
*                                                                        JJJ0907
*     THE FWA OF THE NEW PARCEL IS RETURNED IN X6, AS THE VALUE          JJJ0907
*     OF FUNCTION GCMM$AA                                                JJJ0907
*                                                                        JJJ0907
* DC  ERROR CONDITIONS                                                   JJJ0907
*                                                                        JJJ0907
*     THERE ARE NO ERROR CONDITIONS, EXCEPT WHAT THERE MAY BE IN         JJJ0907
*     THE CMM ROUTINE ALFB$AA, WHICH IS CALLED TO DO MOST OF THE WORK.   JJJ0907
*                                                                        JJJ0907
* DC  CALLED ROUTINES                                                    JJJ0907
*                                                                        JJJ0907
*     ALFB$AA - THIS CMM ROUTINE IS CALLED TO GRANT THE PARCEL WITHOUT   JJJ0907
*     PRE-ZEROING IT.                                                    JJJ0907
*                                                                        JJJ0907
*     IOWR$AA - TO INITIATE WRITING OF ALTERED BLOCKS                    JJJ0907
*                                                                        JJJ0907
* DC  NON-LOCAL VARIABLES                                                JJJ0907
*                                                                        JJJ0907
*     ABLKINC IS CHECKED TO SEE IF ANY BLOCK HAS BEEN ALTERED SINCE      JJJ0916
*     THE LAST TIME GCMM$AA WAS CALLED. NON-ZERO IF YES. IF NON-ZERO     JJJ0907
*     IT IS CLEARED TO ZERO BEFORE STARTING THE ATTEMPTS TO DO SOME      JJJ0907
*     OVERLAPPED WRITING, WHICH IT IS INTENDED TO PROVOKE.               JJJ0907
*     THE ONLY OTHER SUBROUTINE THAT ALTERS THIS VARIABLE IS ALTR$AA.    JJJ0907
*                                                                        JJJ0907
*     RUNTOTCM, OUR RUNNING TOTAL OF CMM BLOCK SPACE, IS INCREASED       JJJ0916
*     BY THE LENGTH OF THE NEW BLOCK.                                    JJJ0907
*                                                                        CY210
*     TARGET, WHOSE MEANING IS DESCRIBED ABOVE, IS INCREASED TO EQUAL    CY210
*     RUNTOTCM IF IT WAS LOWER. THIS IS DONE ON THE OFF CHANCE THAT      CY210
*     CMOV$AA LOWERED TARGET.                                            CY210
*                                                                        JJJ0907
 #                                                                       JJJ0907
                                                                         JJJ0907
        ITEM LGTH, RR;                                                   JJJ0907
        ITEM TLN;            #TEMP BLOCK LENGTH#                         JJJ0209
                                                                         JJJ0907
                                                                         JJJ0907
                             #START OF GCMM$AA CODE#                     JJJ0916
          IF ABLKINC NQ 0                                                SAAM3MO
          THEN                                                           SAAM3MO
            BEGIN                                                        SAAM3MO
              ABLKINC = 0;                                               SAAM3MO
              RR = RUNTOTCM + LGTH - (TARGET*2+2) / 3; #2/3 TARGET#      SAAM3MO
              P<BLOK$AA> = LOC(BFCHNHD) ;                                SAAM3
              ASLONGAS RR GR 0 AND BLBKOPTR[0] NQ LOC(BFCHNHD)           SAAM3
                DO BEGIN #SCAN RELEASE CHAIN BACKWARD#                   SAAM3
                  P<BLOK$AA> = BLBKOPTR[0] ;                             SAAM3
                  IF BLUBSFLG[0] EQ 0 AND BLOCKID[0] NQ 0                SAAM3
                    THEN BEGIN #DATA BLOCK IN CMM#                       SAAM3
                      TLN = 64*FSBLKSIZ[BLFSTTADR-P<FSTT$AA>] - 2 +      JJJ0209
                                                     DBLKFRAME;          JJJ0209
                      IF BLALTFLG[0] EQ 0                                SAAM3
                        THEN                                             JJJ0209
                            BEGIN                                        JJJ0209
                            RR = RR - TLN;                               JJJ0209
                            END                                          JJJ0209
                        ELSE                                             JJJ0209
                            BEGIN                                        JJJ0209
                            IOWR$AA (0);                                 JJJ0209
                            IF WRITSTRT NQ 0                             JJJ0209
                            THEN                                         JJJ0209
                                BEGIN                                    JJJ0209
                                RR = RR - TLN;                           JJJ0209
                                END                                      JJJ0209
                            END                                          JJJ0209
                    END                                                  SAAM3
                END                                                      SAAM3
            END                                                          SAAM3
          GCMM$AA = ALFB$AA ( LGTH , 2 , 0 ) ;                           SAAM3
          RUNTOTCM = RUNTOTCM + LGTH;                                    SAAM3MO
          IF RUNTOTCM GR TARGET                                          AM2A011
          THEN                                                           AM2A011
              BEGIN                                                      AM2A011
              TARGET = RUNTOTCM;                                         AM2A011
              END                                                        AM2A011
          END                                                            SAAM3
CONTROL EJECT;                                                           JJJ0913
          XREF FUNC LWAD$AA ;                                            AFB0707
          CONTROL IFEQ 1,2 ; # LWAD$AA MOVED TO MISC$AA #                AFB0707
FUNC LWAD$AA ( (N) );                                                    JJJ0913
          BEGIN                                                          JJJ0913
                                                                         ID0913 
 #                                                                       JJJ0913
* *   LWAD$AA - RETURN THE LWA + 1 OF A SPECIFIED RECORD    PAGE  1      JJJ0916
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC LWAD$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO RETURN IN X6, OR AS A SYMPL FUNCTION, THE ADDRESS, RELATIVE     JJJ0913
*     TO THE FWA OF THE FIRST RECORD OF THE CURRENT BLOCK, OF THE LWA+1  JJJ0913
*     OF THE RECORD WHOSE NUMBER IS THE INCOMING PARAMETER.              JJJ0913
*     IF THE PARAMETER IS 0, THE FUNCTION IS SET TO 0.                   JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THERE IS ONE PARAMETER, PASSED IN THE NORMAL SYMPL WAY. THIS       JJJ0913
*     IS THE NUMBER OF THE RECORD IN QUESTION, WITHIN THE CURRENT        JJJ0913
*     BLOCK.                                                             JJJ0913
*                                                                        JJJ0913
*     THE PARAMETER MAY ALSO BE 0, IN WHICH CASE THE OUTPUT FUNCTION     JJJ0913
*     IS ALWAYS 0. THE LOGIC OF THIS IS THAT THE LWA+1 OF RECORD N       JJJ0913
*     IS THE FWA OF RECORD N+1. SO THE LWA+1 OF RECORD 0 IS ANOTHER      JJJ0913
*     WAY OF SAYING THE FWA OF RECORD 1, WHICH HAS THE VALUE 0.          JJJ0913
*                                                                        JJJ0913
*     IN ANY CASE, THE PARAMETER MUST NOT BE GREATER THAN THE COUNT      JJJ0913
*     OF RECORDS IN THE CURRENT BLOCK, AND THE BLOCK MUST BE IN CORE.    JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     THE FUNCTION IS RETURNED AS DESCRIBED ABOVE, BUT NOTHING           JJJ0913
*     IS CHANGED.                                                        JJJ0913
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     INDXLNG - THE LENGTH IN WORDS THAT AN INDEX RECORD IN THE CURRENT  JJJ0913
*       FILE OR SUBFILE MUST HAVE. THIS IS SET BY STMD$AA FOR AN         JJJ0913
*       ORDINARY FILE, AND BY LEVL$MP, UPLV$MP, AND DNLV$MP FOR A        JJJ0913
*       SUBFILE OF A MIP FILE.                                           JJJ0913
*                                                                        JJJ0913
 #                                                                       JJJ0913
          ITEM N;            #RECORD NUMBER#                             JJJ0913
                                                                         JJJ0913
                             #START OF LWAD$AA CODE#                     ID0913 
          IF N EQ 0                                                      SAAM3
            THEN LWAD$AA = 0 ;                                           SAAM3
            ELSE BEGIN                                                   SAAM3
              IF UR NQ 0 OR N EQ 1                                       SAAM3
                THEN BEGIN                                               SAAM3
                  IF INDEXFLAG NQ 0 AND BLOCKID[0] EQ PRBK               SAAM3
                    THEN  T1 = INDXLNG;                                  JJJ0913
                    ELSE  T1 = RPFIELD (17,13,1);                        JJJ0913
                  LWAD$AA = N * T1;                                      JJJ0913
                END                                                      SAAM3
                ELSE LWAD$AA = RPFIELD(17,13,N) ;                        SAAM3
            END                                                          SAAM3
          END                                                            SAAM3
          CONTROL ENDIF ;                                                AFB0707
CONTROL EJECT ; 
      FUNC MXPR$AA ;
      BEGIN 
  
 #
* *   MXPRA$AA - RETURN LOGICAL EOI PRU NUMBER         PAGE 1 
* *   A.F.R.BROWN 
* 1DC MXPR$AA (A FUNCTION)
* 
* DC  FUNCTION
* 
*     TO RETURN TO THE CALLER, (IN X6, AS A SYMPL FUNCTION) THE PRU 
*     NUMBER OF THE LOGICAL EOI OF THE CURRENT FILE. THE PHYSICAL 
*     EOI NUMBER MAY BE GREATER THAN THIS, BECAUSE OF JUNK AT THE 
*     END OF THE FILE, OR MORE LIKELY LESS THAN THIS, AS THERE CAN BE 
*     ONE OR TWO BLOCKS AT THE END OF THE FILE WHICH EXIST AS IMAGES
*     IN CORE BUT HAVE NOT YET BEEN WRITTEN ON DISK.
* 
* DC  ENTRY CONDITIONS
* 
*     FSNXTPRU[0] IS THE PRU NUMBER BEFORE WHICH THERE IS GOOD
*       INFORMATION ON THE FILE, AND AFTER WHICH EITHER NOTHING HAS 
*       BEEN WRITTEN, OR ONLY GARBAGE EXISTS. 
*     FSBLKSIZ[0] IS THE SIZE OF A BLOCK OF THIS FILE, IN PRUS. 
*     FSUNWR1[0] IS 0 IF NO BLOCK IMAGE IS WAITING TO BE WRITTEN
*       TO DISK FOR THE FIRST TIME. OTHERWISE, IT IS THE ADDRESS OF 
*       THE BLOCK IMAGE WAITING TO BE WRITTEN AT FSNXTPRU[0], THE 
*       FIRST AVAILABLE POSITION ON DISK. 
*     FSUNWR2[0] IS 0 IF NO BLOCK IMAGE, OR ONLY ONE, IS WAITING. 
*       OTHERWISE IT IS THE ADDRESS OF A BLOCK IMAGE WAITING TO BE
*       WRITTEN NEXT AFTER THE BLOCK IMAGE FSUNWR1[0] POINTS TO.
*     TWO SUCH WAITING IMAGES IS THE MAXIMUM NUMBER.
* 
* DC  EXIT CONDITIONS 
* 
*     THE PRU NUMBBER IS RETURNED AS A FUNCTION (IN X6).
* 
* DC  ERROR CONDITIONS
* 
*     NONE
* 
* DC  CALLED ROUTINES 
* 
*     NONE
* 
* DC  NON-LOCAL VARIABLES 
* 
*     NONE
* 
 #
  
          IF FSUNWR1[0] EQ 0
            THEN MXPR$AA = FSNXTPRU[0] ;
            ELSE BEGIN
              IF FSUNWR2[0] EQ 0
                THEN MXPR$AA = FSNXTPRU[0] + FSBLKSIZ[0] ;
                ELSE MXPR$AA = FSNXTPRU[0] + 2 * FSBLKSIZ[0] ;
            END 
          END 
  
CONTROL EJECT;                                                           JJJ0913
FUNC QUMP$AA ( TYPE );                                                   JJJ0913
          BEGIN                                                          JJJ0913
                                                                         ID0913 
 #                                                                       JJJ0913
* *   QUMP$AA - IS THIS OPERATION MIP OR NOT                   PAGE 1    JJJ0913
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC QUMP$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO RETURN IN X6, AS A SYMPL FUNCTION VALUE, A 0 IF THE CURRENT     JJJ0913
*     OPERATION WILL NOT INVOLVE A MIP FILE, OR A 1 IF IT WILL.          JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THERE IS ONE PARAMETER, PASSED IN THE USUAL SYMPL WAY.             JJJ0913
*     THIS IS 0 IF THE CURRENT OPERATION IS ONE THAT WILL NOT CHANGE     JJJ0913
*     A FILE, OR 1 IF IT WILL CHANGE A FILE (PUT/DELETE/REPLACE).        JJJ0913
*                                                                        JJJ0913
*     FTNDX[0] IS 1 IF THIS IS A MIP INDEX-ONLY OPERATION,               JJJ0913
*     0 OTHERWISE.                                                       JJJ0913
*                                                                        JJJ0913
*     IF THE INCOMING PARAMETER IS 0, THEN FTKL[0], FTRKW[0], AND        JJJ0913
*     FTRKP[0] GIVE THE LENGTH IN CHARACTERS, AND POSITION WITHIN THE    JJJ0913
*     RECORD, OF THE KEY. IF THESE COINCIDE WITH THE VALUES FOR A        JJJ0913
*     PRIMARY KEY IN THIS FILE, THE OPERATION WILL NOT INVOLVE A         JJJ0913
*     MIP FILE, BUT OTHERWISE THEY MUST DESIGNATE AN ALTERNATE KEY, AND  JJJ0913
*     THE MIP FILE WILL BE INVOLVED.                                     JJJ0913
*                                                                        JJJ0913
*     HOWEVER, IF THE MIP WORD IN THE FSTT OF THE DATA FILE IS 0,        JJJ0913
*     INDICATING THE FILE HAS NO MIP PARTNER, WE DO NOT BOTHER TO        JJJ0913
*     CHECK FTKL[0], FTRKW[0], AND FTRKP[0], AND ASSUME NO MIP.          JJJ0913
*                                                                        JJJ0913
*     IF THE INCOMING PARAMETER IS NON-ZERO, THEN THE QUESTION IS        JJJ0913
*     DECIDED SIMPLY ACCORDING TO WHETHER THE MIP WORD OF THE FSTT       JJJ0913
*     OF THE DATA FILE IS 0 OR NOT.                                      JJJ0913
*                                                                        JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     IF THE CURRENT OPERATION WILL NOT INVOLVE A MIP FILE, THE          JJJ0913
*     FUNCTION HAS THE VALUE 0.                                          JJJ0913
*                                                                        JJJ0913
*     IF IT WILL INVOLVE A MIP FILE, THE FUNCTION HAS THE VALUE 1.       JJJ0913
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     EC172 (NONFATAL) IF KL=0 IN THE FIT.                               AFB1010
*     EC515 (NONFATAL) IF KL,RKP,AND RKW IN THE FIT SUGGEST              AFB1010
*       AN ALTERNATE KEY BUT THERE IS NO MIP FILE.                       AFB1010
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     NONE                                                               CY210
*                                                                        JJJ0913
 #                                                                       JJJ0913
CONTROL EJECT;               #START OF QUMP$AA CODE#                     JJJ0913
          ITEM TYPE;         #0 FOR NON-ALTER, 1 FOR ALTER OP#           JJJ0913
          ITEM QUM;          #TEMP STORE FOR RESULT#                     JJJ0913
                                                                         JJJ0913
                                                                         JJJ0913
          QUM = 0 ;                                                      SAAM3
          IF TYPE EQ 0                                                   SAAM3
            THEN BEGIN                                                   SAAM3
              IF FTKL[0] EQ 0 
              THEN
                  BEGIN 
                  MSEX(EC172) ; #IMPROPER KL OR RKP#                     DABBLE 
                  END 
              IF FTNDX[0] NQ 0                                           SAAM3
                        OR                                               SAAM3
                 ( FSMIPWORD[0] NQ 0 AND ( FSKEYSIZE[0] NQ FTKL[0]       SAAM3
                                    OR                                   SAAM3
                               FSKEYLOC[0] NQ FTRKW[0]                   SAAM3
                                    OR                                   SAAM3
                               FSKEYPOS[0] NQ FTRKP[0] )                 JJJ1116
                                    AND FTRKP[0] NQ 10)                  JJJ1116
                THEN QUM = 1 ;                                           SAAM3
            END                                                          SAAM3
            ELSE BEGIN                                                   SAAM3
              IF FSMIPWORD[0] NQ 0 THEN QUM = 1 ;                        SAAM3
            END                                                          SAAM3
          IF QUM NQ 0 AND FTXN[0] EQ 0                                   AFB1010
            THEN BEGIN                                                   AFB1010
              MSEX(EC515); #MIP OP BUT NO MIP FILE NAMED#                AFB1010
            END                                                          AFB1010
          QUMP$AA = QUM ;                                                SAAM3
          END                                                            SAAM3
CONTROL EJECT;                                                           SAAM3MO
      FUNC RESP$AA (NUM,FSTTFWA);                                        JJJ0907
        BEGIN                                                            JJJ0907
                                                                         JJJ0907
 #                                                                       JJJ0907
* *   RESP$AA - TRY TO RELEASE A GIVEN AMOUNT OF CMM SPACE  PAGE  1      JJJ0916
* *   A.F.R.BROWN                                                        JJJ0907
* 1DC RESP$AA   ( A FUNCTION )                                           JJJ0907
*                                                                        JJJ0907
* DC  FUNCTION                                                           JJJ0907
*                                                                        JJJ0907
*     TO RELEASE A GIVEN TOTAL AMOUNT OF CMM SPACE, PREPARATORY TO       JJJ0907
*     ASKING CMM FOR A NEW BLOCK THROUGH GCMM$AA, IN ORDER TO KEEP       JJJ0907
*     THE RUNNING TOTAL OF SPACE RUNT$AA AT OR BELOW THE MAXIMUM TARG$AA JJJ0907
*     WE HAVE SET FOR OURSELVES.                                         JJJ0907
*                                                                        JJJ0907
* DC  ENTRY CONDITIONS                                                   JJJ0907
*                                                                        JJJ0907
*     TWO PARAMETERS PASSED IN THE STANDARD SYMPL MANNER --              JJJ0907
*     1. THE NUMBER OF WORDS OF SPACE TO RELEASE IF POSSIBLE.            JJJ0907
*     IF THE REASON FOR CALLING RESP$AA IS TO GET SPACE FOR A BLOCK OF   CY210
*     A FILE, THIS WILL BE EQUAL TO OR LESS THAN A BLOCK SIZE. IF IT IS  CY210
*     GREATER THAN A BLOCK SIZE, RESP$AA AND RESPA ASSUME THE REASON IS  CY210
*     MORE GENERAL, AND DO NOT ATTEMPT TO FIND A REUSEABLE BLOCK.        CY210
*     (SETTING BLOKNEED = 0 PREVENTS THE ATTEMPT.)                       CY210
*     2. THE FWA OF THE FSTT OF THE FILE FOR WHOSE BENEFIT THIS IS BEING JJJ0907
*     DONE, OR 0 IF NO SUCH FILE (I.E. IF THE SPACE THAT WILL BE         JJJ0907
*     REQUESTED AFTER THIS RELEASE IS FOR A CAPSULE NOT A BLOCK.)        JJJ0907
*     THE FILE IS SPECIFIED SO THAT IF UBS SPACE IS ASSIGNED TO IT, ITS  JJJ0907
*     BLOCKS IN THAT SPACE WILL BE SUBJECT TO POSSIBLE RELEASE -- ANY    JJJ0907
*     OTHER UBS SPACE WILL BE UNAFFECTED BY THIS ROUTINE.                JJJ0907
*                                                                        CY210
*     IF P<BLOK$AA> IS NOT 0, IT POINTS TO THE CURRENT BLOCK, WHICH MUST CY210
*     NOT BE KICKED OUT IN THE PROCESS OF MAKING FREE SPACE.             CY210
*     THIS MEANS ALSO THAT RESP$AA HAS BEEN CALLED TO MAKE ROOM FOR      CY210
*     LOADING A CAPSULE.                                                 CY210
*                                                                        JJJ0907
* DC  EXIT CONDITIONS                                                    JJJ0907
*                                                                        JJJ0907
*     THIS ROUTINE RETURNS, IN X6 OR AS THE FUNCTION VALUE IN SYMPL,     JJJ0907
*     THE NUMBER OF WORDS BY WHICH THE AMOUNT OF SPACE RELEASED FELL     JJJ0907
*     SHORT OF THE REQUESTED NUMBER (FIRST PARAMETER). AS LONG AS THIS   JJJ0907
*     IS NEGATIVE OR ZERO ALL IS WELL.                                   JJJ0907
*                                                                        CY210
*     IF P<BLOK$AA> WAS NOT 0 ON ENTRY, IT IS UNCHANGED ON EXIT.         CY210
*     OTHERWISE, IF FSTTFWA WAS NOT 0 ON ENTRY, P<BLOK$AA> MAY BE 0      CY210
*     OR NON-ZERO ON EXIT. IF NON-ZERO, IF IS THE ADDRESS OF A BLOCK     CY210
*     OF THE RIGHT SIZE FOR THE FILE SPECIFIED BY FSTTFWA, WHICH BLOCK   CY210
*     SHOULD BE USED IMMEDIATELY BY THE CALLER. GCMM$AA NEED NOT BE      CY210
*     CALLED, NOR RUNTOTCM ADJUSTED, BY THE CALLER IN THIS CASE.         CY210
*                                                                        JJJ0907
* DC  ERROR CONDITIONS                                                   JJJ0907
*                                                                        JJJ0907
*     IF THE FUNCTION VALUE, OR CONTENT OF X6 ON EXIT, IS GREATER THAN   JJJ0907
*     ZERO, WE HAVE NOT BEEN ABLE TO RELEASE AS MUCH SPACE AS REQUESTED. JJJ0907
*     THIS WOULD INDICATE A GROSS FAILURE IN OUR LOGIC, BECAUSE THE      JJJ0907
*     REQUEST SHOULD HAVE BEEN FORMULATED ACCORDING TO THE POSSIBI-      JJJ0907
*     LITIES.                                                            JJJ0907
*                                                                        JJJ0907
* DC  CALLED ROUTINES                                                    JJJ0907
*                                                                        JJJ0907
*     RESPA -- AN INTERNAL SUBROUTINE. THIS CODE IS CALLED TWICE, AND    JJJ0907
*     IS SET UP AS AN INTERNAL SUBROUTINE ONLY BECAUSE THAT MAKES IT     JJJ0907
*     LOOK MORE LIKE STRUCTURED PROGRAMMING.                             JJJ0907
*                                                                        JJJ0907
*     IOWR$AA -- CALLED TO GET BLOCKS WRITTEN OUT, BEFORE RELEASING      JJJ0907
*     THEM                                                               JJJ0907
*                                                                        JJJ0907
*     WTIO$AA -- TO WAIT FOR COMPLETION ON BLOCKS THAT ARE IN            JJJ0907
*     READ-IN-PROGRESS STATUS, BEFORE (SIGH) KICKING THEM OUT AND        JJJ0907
*     REUSING THE SPACE.                                                 JJJ0907
*                                                                        JJJ0907
*     UNPTREE -- TO CHANGE THE POINTER IN A PTREE WORD TO A GIVEN        JJJ0907
*     BLOCK, IF NECESSARY, FROM THE BLOCK ADDRESS TO THE PRU NUMBER      JJJ0907
*     (SINCE THE BLOCK IS ABOUT TO BE EVICTED FROM THAT ADDRESS.)        JJJ0907
*                                                                        JJJ0907
*     UNCH$AA -- TO REMOVE A BLOCK FROM THE KICK-OUT CHAIN, OR ITS       JJJ0907
*     FILE CHAIN, BEFORE GETTING RID OF IT.                              JJJ0907
*                                                                        JJJ0907
*     INCH$AA -- TO CHAIN A CAPSULE BACK INTO THE KICK-OUT CHAIN, AFTER  JJJ0907
*     REDUCING ITS RESIDUAL NUMBER OF LIVES BY 1. (UNCH$AA FOLLOWED BY   JJJ0907
*     INCH$AA COULD BE REPLACED BY RJUV$AA, BUT HERE IT IS MORE CONV-    JJJ0907
*     ENIENT TO DO IT IN SEPARATE STEPS.)                                JJJ0907
*                                                                        JJJ0907
*     CMM$FRF -- THE CMM ROUTINE THAT ACTUALLY RELEASES THE BLOCK        JJJ0907
*     TO THE POOL OF AVAILABLE MEMORY.                                   JJJ0907
*                                                                        JJJ0907
*     UNL1$AA -- AN FDL ROUTINE TO UNLOAD A CAPSULE AND SEND ITS         JJJ0907
*     SPACE BACK TO CMM.                                                 JJJ0907
*                                                                        JJJ0907
* DC  NON-LOCAL VARIABLES                                                JJJ0907
*                                                                        JJJ0907
*     P<FSTT$AA>, P<FET$AA>, AND P<PTRE$AA> ARE PRESERVED.               CY210
*                                                                        JJJ0907
*     RUNTOTCM -- OUR RUNNING TOTAL OF CMM FILE BLOCK SPACE, IS          CY210
*     REDUCED BY THE LENGTH IN WORDS OF EVERY SUCH BLOCK THAT IS         JJJ0907
*     RELEASED .                                                         JJJ0907
*                                                                        JJJ0907
 #                                                                       JJJ0907
                                                                         JJJ0907
                             #START OF RESP$AA CODE#                     JJJ0916
        ITEM NUM, FSTTFWA, RESULT;                                       JJJ0907
        ITEM SVBLOK,SVFET;   #SAVES CURRENT BLOCK AND FET ADDRESSES#     VBG0930
        ITEM BLOKNEED , BLN;   #SIZE OF BLOCK NEEDED, CUR BLOCK LENGTH#  JJJ0508
                                                                         JJJ0907
                                                                         JJJ0907
                                                                         JJJ0907
          SVBLOK=P<BLOK$AA>;                                             VBG0930
          SVFET=P<FET$AA>;                                               VBG0930
          IF FSTTFWA NQ 0                                                JJJ0508
          THEN                                                           JJJ0508
              BEGIN                                                      JJJ0508
              BLOKNEED = 64*FSBLKSIZ[FSTTFWA-P<FSTT$AA>]-2+DBLKFRAME;    JJJ0508
              IF BLOKNEED LS NUM                                         CY210
              THEN                                                       AM2A011
                  BEGIN                                                  AM2A011
                  BLOKNEED = 0;                                          AM2A011
                  END                                                    AM2A011
              END                                                        JJJ0508
          ELSE                                                           JJJ0508
              BEGIN                                                      JJJ0508
              BLOKNEED = 0;                                              JJJ0508
              END                                                        JJJ0508
          RESULT = NUM ;                                                 SAAM3
          RESPA ( 0 ) ;                                                  SAAM3
          IF RESULT GR 0 THEN RESPA ( 1 ) ;                              SAAM3
          RESP$AA = RESULT ;                                             SAAM3
          P<BLOK$AA>=SVBLOK;                                             VBG0930
          P<FET$AA>=SVFET;                                               VBG0930
          RETURN ;                                                       SAAM3
                                                                         SAAM3
                                                                         SAAM3MO
                                                                         SAAM3MO
PROC RESPA ((TRY));                                                      SAAM3MO
            BEGIN                                                        SAAM3MO
            ITEM TRY;        #FORMAL PARAM#                              SAAM3MO
            ITEM TFS;        #TEMP FSTT ADDR#                            SAAM3MO
            ITEM BP;         #BLOCK POINTER#                             SAAM3MO
          ITEM SFET;         #SAVE FET#                                  JJJ0225
                                                                         SAAM3MO
                                                                         SAAM3MO
                                                                         SAAM3MO
            P<BLOK$AA> = LOC(BFCHNHD) ;                                  SAAM3
            FOR BP = BLBKOPTR[0] WHILE BP NQ LOC(BFCHNHD)                SAAM3MO
                                      AND RESULT GR 0                    SAAM3MO
              DO BEGIN                                                   SAAM3
                P<BLOK$AA> = BP;                                         SAAM3MO
                BLN = 0 ;    #IN CASE ITS A CAPSULE#                     JJJ0508
                BP = BLBKOPTR[0];                                        SAAM3MO
                IF BLOCKID[0] NQ 0 OR BLUBSFLG[0] NQ 0                   SAAM3
                  THEN BEGIN #NOT A CAPSULE#                             SAAM3
                    IF P<BLOK$AA> EQ SVBLOK OR
                       (BLUBSFLG NQ 0 AND FSTTFWA NQ BLFSTTADR) 
                    THEN   TEST;  #BLOCK IS NOT TO BE RELEASED OR#
                                  #IS IN UBS FOR ANOTHER FILE#
                    BLN = BLKLNG[0] + DBLKFRAME;                         CY210
                    IF BLWIP[0] NQ 0 AND BLCODSTAT[0] NQ 0               VBG1026
                    THEN                                                 VBG1026
                      BEGIN                                              VBG1026
                      IOWR$AA (0);  #CLEANUP ALREADY WRITTEN BLOCK SO#   VBG1026
                                    #IT MAY BE RELEASED#                 VBG1026
                      END                                                VBG1026
                    IF BLALTFLG[0] NQ 0 OR BLWIP[0] NQ 0                 SAAM3
                      THEN BEGIN                                         SAAM3
                        IF TRY EQ 0 AND BLN NQ BLOKNEED                  JJJ0508
                        THEN                                             JJJ0508
                            BEGIN                                        JJJ0508
                            TEST;  #THIS BLOCK WILL NOT DO#              JJJ0508
                            END                                          JJJ0508
                        IOWR$AA ( 1 ) ;                                  SAAM3
                      END                                                SAAM3
                      ELSE BEGIN                                         SAAM3
                        IF BLRIP[0] NQ 0                                 SAAM3
                          THEN BEGIN                                     SAAM3
                            IF TRY EQ 0 AND BLFSTTADR[0] NQ FSTTFWA 
                              THEN TEST ;                               017230
                            SFET = P<FET$AA>;                            JJJ0225
                            TFS = P<FSTT$AA>;                            SAAM3MO
                            P<FSTT$AA> = BLFSTTADR[0] ;                  SAAM3
                            P<FET$AA> = FSBZFET[0] ;                     SAAM3
                            WTIO$AA ;                                    SAAM3
                            P<FSTT$AA> = TFS;                            SAAM3MO
                            P<FET$AA> = SFET;                            JJJ0225
                          END                                            SAAM3
                      END                                                SAAM3
                    UNPTREE ;                                            SAAM3
                    IF BLUBSFLG[0] EQ 0 THEN UNCH$AA ( P<BLOK$AA>+1 ) ;  SAAM3
                  END                                                    SAAM3
                UNCH$AA ( P<BLOK$AA> ) ;                                 SAAM3
                IF BLUBSFLG[0] NQ 0                                      SAAM3
                  THEN BEGIN                                             SAAM3
                    BLOCKID[0] = 0 ;                                     SAAM3
                    SVBLOK = P<BLOK$AA>;  #THIS IS THE NEW BLOCK#        JJJ0508
                  END                                                    SAAM3
                  ELSE BEGIN                                             SAAM3
                    IF BLOCKID[0] EQ 0 AND BLLIVES[0] NQ 0               SAAM3
                        AND TRY EQ 0
                      THEN BEGIN #CAPSULE#                               SAAM3
                        BLLIVES[0] = BLLIVES[0] - 1 ;                    SAAM3
                        INCH$AA ( P<BLOK$AA> , LOC(BFCHNHD) ) ;          SAAM3
                          #REJUVENATES IT#                               SAAM3
                        TEST ;                                           SAAM3
                      END                                                SAAM3
                    IF BLOCKID[0] NQ 0                                   SAAM3
                      THEN   #FILE BLOCK#                                JJJ0508
                        BEGIN                                            JJJ0508
                        IF BLN EQ BLOKNEED AND BLNORU[0] EQ 0            AFB1128
                        THEN                                             JJJ0508
                          BEGIN                                          JJJ0508
                          SVBLOK = P<BLOK$AA>;                           JJJ0508
                          BLOKINIT (FSTTFWA);                            JJJ0508
                          BLKLNG = BLN - DBLKFRAME;                      JJJ0508
                          END                                            JJJ0508
                        ELSE                                             JJJ0508
                          BEGIN                                          JJJ0508
                          CMM$FRF (P<BLOK$AA>);                          JJJ0508
                          RUNTOTCM = RUNTOTCM - BLN;                     CY210
                          END                                            JJJ0508
                        END                                              JJJ0508
                      ELSE                                               JJJ0209
                        BEGIN                                            JJJ0209
                        BLN = BLKLNG;                                    CY210
                        UNL1$AA (P<BLOK$AA>);                            JJJ0209
                        END                                              JJJ0209
                  END                                                    SAAM3
                RESULT = RESULT - BLN;                                   CY210
              END                                                        SAAM3
            END                                                          SAAM3
                                                                         SAAM3
          END # OF RESP$AA #                                             SAAM3
CONTROL EJECT ; 
FUNC SPRD$AA (SPF , SPL);                                                CY211
      BEGIN 
 #                                                                       CY210
* *   SPRD$AA -- DECOMPRESS A RECORD             PAGE  1                 AM2A077
* *   A.F.R.BROWN                                                        CY210
* 1DC SPRD$AA                                                            CY210
*                                                                        CY210
* DC  FUNCTION                                                           CY210
*                                                                        CY210
*     TO DECOMPRESS A RECORD IF NECESSARY, AND RETURN, AS A SYMPL        CY210
*     FUNCTION IN X6, THE LENGTH OF THE DECOMPRESSED RECORD IN           CY210
*     CHARACTERS.                                                        CY210
*                                                                        CY210
* DC  ENTRY CONDITIONS                                                   CY210
*                                                                        CY210
*     THERE ARE TWO PARAMETERS PASSED IN THE STANDARD WAY.               CY211
*     (1) THE FWA OF THE RECORD TO BE DECOMPRESSED. IT MUST BEGIN        CY210
*       AT THE FIRST CHARACTER OF THE WORD THIS POINTS TO.               CY210
*     (2) THE LENGTH IN CHARACTERS OF THE RECORD TO BE DECOMPRESSED.     CY210
*                                                                        CY210
*     THE DCA FIELD OF THE FIT CONTAINS THE ADDRESS OF THE               CY210
*     DECOMPRESSION SUBROUTINE.                                          CY210
*                                                                        CY210
*     SAMKLENG, SAMKLOC, AND SAMKPOS ARE THE KEY LENGTH IN               CY210
*       CHARACTERS, AND THE NUMBER OF WORDS AND CHARACTERS BY WHICH      CY210
*       THE KEY OF ANY DATA RECORD IN THIS FILE, IN ITS ORIGINAL FORM,   CY210
*       IS OFFSET FROM THE START OF THE RECORD.                          CY210
*     BUT IF THE KEY IS NON-EMBEDDED, SAMKLENG = 0 .                     CY210
*                                                                        CY210
*     CBUFAD AND CBUFSZ ARE THE FWA AND THE LENGTH IN CHARACTERS         CY210
*       OF THE COMPRESSION/DECOMPRESSION BUFFER, AN AREA DEDICATED       CY210
*       TO COMPRESSING OR DECOMPRESSING RECORDS INTO.                    CY210
*                                                                        CY210
* DC  EXIT CONDITIONS                                                    CY210
*                                                                        CY210
*     THE RECORD HAS BEEN DECOMPRESSED BY THE REAL DECOMPRESSION         CY210
*     ROUTINE AND STORED IN THE AREA CBUFAD POINTS TO.                   CY211
*                                                                        CY210
*     THE LENGTH OF THE DECOMPRESSED RECORD, IN CHARACTERS, IS           CY210
*     THE VALUE OF THE FUNCTION SPRD$AA .                                CY210
*                                                                        CY210
* DC  ERROR CONDITIONS                                                   CY210
*                                                                        CY210
*     NON-FATAL ERROR IF THE REAL DECOMPRESSION ROUTINE IS CALLED,       CY210
*     AND REPLIES THAT THE DECOMPRESSED RECORD WOULD BE LONGER THAN      CY210
*     CBUFSZ CHARACTERS.                                                 CY210
*                                                                        CY210
* DC  CALLED ROUTINES                                                    CY210
*                                                                        CY210
*     OWN$AA , TO INTERFACE WITH THE REAL DECOMPRESSION ROUTINE.         CY210
*                                                                        CY210
* DC  NON-LOCAL VARIABLES                                                CY210
*                                                                        CY210
*     T3 IS PASSED TO THE REAL COMPRESSION ROUTINE AS THE PLACE TO       CY210
*       PUT THE LENGTH OF THE DECOMPRESSED RECORD, OR TO RETURN A 0      CY210
*       IF THIS LENGTH WOULD BE GREATER THAN CBUFSZ. THERE IS NO         CY210
*       RISK OF CONFUSION IN USING A SCRATCH VARIABLE LIKE T3 THIS       CY210
*       WAY, BECAUSE THE DECOMPRESSION ROUTINE, FOR OBVIOUS REASONS,     CY210
*       AND OWN$AA, BECAUSE IT IS NECESSARILY A COMPASS ROUTINE,         CY210
*       ARE BOTH OUTSIDE OF AAM$AA, TO WHICH T3 IS LOCAL.                CY210
*                                                                        CY210
 #                                                                       CY210
      ITEM SPF , SPL;        #FORMAL PARAMETERS#                         CY211
              OWN$AA ( FTDCA[0] , SPF , SPL , SAMKLOC , SAMKPOS , 
                SAMKLENG , CBUFAD , CBUFSZ , T3 ) ; 
              IF T3 LS 0
                THEN BEGIN
                  MSEX(EC142) ;                                          DABBLE 
                END 
              SPRD$AA = T3 ;
      END 
CONTROL EJECT;                                                           JJJ0913
FUNC UUCC$AA ( (N) );                                                    JJJ0913
          BEGIN                                                          JJJ0913
                                                                         ID0913 
 #                                                                       JJJ0913
* *   UUCC$AA - RETURN THE UNUSED CHARACTER COUNT FOR A RECORD  PAGE  1  JJJ0916
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC UUCC$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO RETURN IN X6, OR AS A SYMPL FUNCTION, THE NUMBER OF CHARACTERS  JJJ0913
*     AT THE END OF THE LAST WORD OF A RECORD THAT CONTAIN GARBAGE NOT   JJJ0913
*     INFORMATION, AND SHOULD NOT BE MOVED WHEN THE RECORD IS BEING      JJJ0913
*     COPIED. ANY RECORD IN THE CURRENT BLOCK CAN BE REFERENCED, ITS     JJJ0913
*     NUMBER WITHIN THE BLOCK BEING THE INCOMING PARAMETER FOR UUCC$AA.  JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THERE IS ONE PARAMETER, PASSED IN THE NORMAL SYMPL WAY. THIS       JJJ0913
*     IS THE NUMBER OF THE RECORD IN QUESTION, AS NUMBERED WITHIN THE    JJJ0913
*     CURRENT BLOCK. THE NUMBER MUST BE NOT GREATER THAN THE COUNT OF    JJJ0913
*     RECORDS IN THE BLOCK.                                              JJJ0913
*                                                                        JJJ0913
*     THIS PARAMETER MAY ALSO BE 0, IN WHICH CASE UUCC$AA RETURNS A      JJJ0913
*     0 VALUE. THIS CONVENTION SIMPLIFIES THE USE OF THE FUNCTION        JJJ0913
*     IN ONE OR TWO PLACES.                                              JJJ0913
*                                                                        JJJ0913
*     THE CURRENT BLOCK MUST ALREADY BE IN CORE.                         JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     THE FUNCTION IS RETURNED AS DESCRIBED ABOVE, BUT NOTHING IS        JJJ0913
*     ALTERED.                                                           JJJ0913
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
 #                                                                       JJJ0913
          ITEM N;            #RECORD NUMBER#                             JJJ0913
                                                                         JJJ0913
                             #START OF UUCC$AA CODE#                     ID0913 
          IF N EQ 0                                                      SAAM3
            THEN UUCC$AA = 0 ;                                           SAAM3
            ELSE BEGIN                                                   SAAM3
              IF UR NQ 0 OR N EQ 1                                       SAAM3
                THEN UUCC$AA = RPFIELD(0,4,1) ;                          SAAM3
                ELSE UUCC$AA = RPFIELD(0,4,N) ;                          SAAM3
            END                                                          SAAM3
          END                                                            SAAM3
CONTROL EJECT;                                                           ID0913 
PROC AGE;                                                                ID0913 
          BEGIN                                                          ID0913 
                                                                         ID0913 
 #                                                                       ID0913 
* *   AGE - MOVE CURRENT BLOCK TOWARD END OF K-O CHAIN            PAGE 1 ID0913 
* *   A.F.R.BROWN                                                        ID0913 
* 1DC AGE                                                                ID0913 
*                                                                        ID0913 
* DC  FUNCTION                                                           ID0913 
*                                                                        ID0913 
*     TO MOVE THE CURRENT BLOCK, IF IT IS NOW IN THE KICK-OUT CHAIN,     ID0913 
*     TOWARDS THE TAIL END OF THAT CHAIN, SO AS TO GIVE IT A BETTER      ID0913 
*     CHANCE OF BEING KICKED OUT. WE DO THIS ORDINARILY TO A DATA BLOCK, ID0913 
*     WHENEVER IT CEASES TO BE CURRENT. AT THAT MOMENT, THE BLOCK IS     ID0913 
*     STILL ((BETTER)) THAN ANY LESS-RECENTLY-REFERENCED DATA BLOCK,     ID0913 
*     BUT IT IS ((WORSE)) THAN ANY INDEX BLOCK OR CAPSULE. SO THIS
*     ROUTINE TAKES THE GIVEN BLOCK, IF IT IS IN THE KICK-OUT CHAIN,
*     THEN SEARCHES TAILWARD FROM THAT POINT FOR THE LAST INDEX BLOCK 
*     OR CAPSULE, AND IF THERE IS ANY SUCH INDEX BLOCK OR CAPSULE 
*     (I.E. THE CURRENT BLOCK DID PRECEDE AT LEAST ONE INDEX BLOCK OR 
*     CAPSULE IN THE CHAIN), RECHAINS THE CURRENT BLOCK AT A
*     POSITION IMMEDIATELY AFTER IT.
*                                                                        ID0913 
*     THE CONCEPT OF AN INDEX BLOCK OR CAPSULE BEING ((BETTER)) THAN
*     A DATA BLOCK GIVES PRIORITY CONSIDERATION TO THE FORMER.
*     THE ITEM AAM$PBC GIVES THE MAXIMUM NUMBER OF INDEX BLOCKS OR
*     CAPSULES TO RECEIVE PRIORITY CONSIDERATION.  THE DATA BLOCK IS
*     RECHAINED AFTER THIS NUMBER OF PRIORITY BLOCKS, OR AT THE END 
*     OF ALL THE PRIORITY BLOCKS, WHICHEVER COMES FIRST.
* 
* DC  ENTRY CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     P<BLOK$AA> LOCATES THE BLOCK IMAGE IN CORE, FOR AGE TO ATTACK.     ID0913 
*     IF THE CURRENT BLOCK IS IN CORE, AS IT IS WHENEVER AGE IS CALLED,  ID0913 
*     ITS IMAGE IS THE ONE LOCATED.                                      ID0913 
*                                                                        ID0913 
*     THE BLOCK MAY OR MAY NOT BE IN THE KICK-OUT CHAIN, INDICATED       ID0913 
*     BY BLFKOPTR[0] IN ITS FRAME BEING NON-ZERO OR ZERO. IF ZERO,       ID0913 
*     THE ROUTINE JUST DOES NOTHING.                                     ID0913 
*                                                                        ID0913 
* DC  ERROR CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
* DC  CALLED ROUTINES                                                    ID0913 
*                                                                        ID0913 
*     UNCH$AA - TO DETACH THE CURRENT BLOCK FROM THE CHAIN.              ID0913 
*     INCH$AA - TO RE-LINK IT AT ITS NEW POSITION                        ID0913 
*                                                                        ID0913 
* DC  NON-LOCAL VARIABLES                                                ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
 #                                                                       ID0913 
          ITEM AX , AY;      #LOCAL TEMPORARIES#                         ID0913 
          ITEM PBCNT;        #PRIORITY BLOCK COUNT# 
                                                                         ID0913 
                             #START OF AGE CODE#                         ID0913 
          IF BLFKOPTR[0] NQ 0                                            SAAM3
            THEN BEGIN                                                   SAAM3
              AY = P<BLOK$AA> ;                                          SAAM3
              PBCNT = 0 ; 
              FOR AX = 0 WHILE BLFKOPTR[0] NQ LOC(BFCHNHD)               SAAM3
                DO BEGIN                                                 SAAM3
                  P<BLOK$AA> = BLFKOPTR[0] ;                             SAAM3
                  IF (INDEXFLAG NQ 0 OR BLOCKID[0] EQ 0)
                    THEN BEGIN
                      PBCNT = PBCNT + 1 ; 
                      AX = P<BLOK$AA> ; 
                      IF (LOC (AAM$PBC) GR 0) AND (PBCNT GQ AAM$PBC)
                        THEN GOTO SPOTFOUND;
                    END 
                END                                                      SAAM3
SPOTFOUND:  
              P<BLOK$AA> = AY ;                                          SAAM3
              IF AX NQ 0                                                 SAAM3
                THEN BEGIN                                               SAAM3
                  UNCH$AA ( P<BLOK$AA> ) ;                               SAAM3
                  INCH$AA ( P<BLOK$AA> , AX ) ;                          SAAM3
                END                                                      SAAM3
            END                                                          SAAM3
          END                                                            SAAM3
CONTROL EJECT;                                                           ID0913 
PROC ALTR$AA;                                                            ID0913 
          BEGIN                                                          ID0913 
                                                                         ID0913 
 #                                                                       ID0913 
* *   ALTR$AA - CEREMONY BEFORE ALTERING A BLOCK IMAGE        PAGE 1     ID0913 
* *   A.F.R.BROWN                                                        ID0913 
* 1DC ALTR$AA                                                            ID0913 
*                                                                        ID0913 
* DC  FUNCTION                                                           ID0913 
*                                                                        ID0913 
*     BEFORE ALTERING A BLOCK IMAGE, WE MUST ASCERTAIN WHETHER THIS IS   ID0913 
*     THE FIRST TIME IT WAS ALTERED SINCE THE LAST TIME IT WAS READ FROM ID0913 
*     OR WRITTEN TO DISK (I.E. WHETHER THE CORE IMAGE IS ABOUT TO        ID0913 
*     CHANGE FROM LIKE TO UNLIKE THE DISK IMAGE), AND IF SO, MUST CALL   CY210
*     ANY LOGGING ROUTINE THAT IS PROVIDED TO SAVE THE OLD IMAGE.        CY210
*     IT IS CHEAPER TO SAVE IT NOW FROM CORE THAN LATER FROM DISK.       CY210
*                                                                        CY210
*     ALSO, TO SET FSOPENFLG[0] TO 1, IF IT IS NOW 0. THIS WOULD MEAN    CY210
*     THAT THIS IS THE FIRST TIME THIS FILE HAS BEEN ALTERED SINCE IT    CY210
*     WAS MOST RECENTLY OPENED OR FLUSHED. AFTER SETTING IT TO 1,        CY210
*     IMMEDIATELY WRITE OUT THE FSTT WITH RECALL. THIS FLAG IS SET       CY210
*     TO 0, IN CORE AND ON DISK, BY A CLOSE OR A FLUSH. HENCE WHEN       CY210
*     A FILE IS OPENED, SEEING A 1 IN THIS FLAG MEANS THAT THE FILE      CY210
*     WAS ALTERED AND NOT CLOSED AT SOME TIME IN THE PAST.               CY210
*                                                                        CY210
*     ALSO, TO SET FSMODFLG[0] TO 1. THIS FLAG IS RESET TO 0 ON THE      CY210
*     COMPLETION OF ANY PUT, DELETE, OR REPLACE. HENCE, IF IT IS FOUND   CY210
*     TO BE 1 WHEN REPRIEVE PROCESSING BEGINS, IT MEANS THAT SOME        CY210
*     ALTERATION OF THE FILE WAS BEGUN BUT NOT COMPLETED, AND HENCE      CY210
*     THE FILE IS PROBABLY NOT WELL-FORMED.                              CY210
*                                                                        CY210
*     ALSO, TO SET BLCIP[0] TO 1. THIS IS THE CHANGE-IN-PROGESS FLAG     CY210
*     FOR INDIVIDUAL BLOCKS. FOR AN INDEX BLOCK, OR FOR ANY BLOCK IN     CY210
*     A MIP FILE, THIS FLAG MAY OR MAY NOT BE CLEARED TO 0 WHEN AN       CY210
*     ALTERATION TO THE BLOCK IS COMPLETED. BUT FOR A DATA BLOCK IN      CY210
*     A DATA FILE, WE INTEND THAT BLCIP[0] SHOULD ALWAYS BE ZEROED       CY210
*     WHEN AN ALTERATION OF THE BLOCK IMAGE IS COMPLETED. THUS,          CY210
*     DURING A REPRIEVE, IF SUCH A BLOCK IS FOUND WITH BLCIP[0]=0,       CY210
*     THE BLOCK IS PROBABLY WORTH FLUSHING. BUT IF BLCIP[0]=1,           CY210
*     THE RECORDS AND RECORD POINTERS ARE PROBABLY GARBLED.              CY210
*                                                                        ID0913 
* DC  ENTRY CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     P<BLOK$AA> LOCATES THE BLOCK IMAGE THAT IS ABOUT TO BE ALTERED.    ID0913 
*     BLALTFLG[0] IS 0 IF THE IMAGE HAS NOT BEEN CHANGED SINCE THE       ID0913 
*       MOST RECENT READING OR WRITING OF IT, OR 1 IF IT HAS BEEN        ID0913 
*       CHANGED. WHEN A BLOCK THAT DOES NOT EXIST ON DISK YET IS CREATED ID0913 
*       IN CORE,  BLALTFLG[0] IS SET TO 1 IMMEDIATELY.                   ID0913 
*     BLWIP[0] IS 1 IF A WRITE-WITHOUT RECALL HAS BEEN INITIATED FOR THE ID0913 
*       BLOCK IMAGE, BUT NOT YET COMPLETED. OTHERWISE 0.                 ID0913 
*       IF 1, BLALTFLG[0] WILL BE 0.                                     ID0913 
*                                                                        ID0913 
* DC  EXIT CONDITIONS                                                    ID0913 
*                                                                        ID0913 
*     BLALTFLG[0] IS 1.                                                  ID0913 
*     IF THIS FLAG WAS 0 AT ENTRY, THEN                                  ID0913 
*       1. ABLKINC HAS BEEN SET TO 1, TO TELL GCMM$AA THAT A BLOCK       ID0913 
*         IMAGE HAS BEEN ALTERED SINCE THE LAST TIME GCMM$AA ZEROED      ID0913 
*         ABLKINC.                                                       ID0913 
*       2. IF BLWIP[0] WAS 1 AT ENTRY, IOWR$AA HAS BEEN CALLED TO        ID0913 
*         BRING THIS WRITE TO COMPLETION.                                ID0913 
*       3. THE PROCEDURE FOR LOGGING, OR THE FIRST PHASE IF LOGGING IS   ID0913 
*         IN TWO PHASES, HAS BEEN CALLED, UNLESS THERE IS NO LOGGING.    ID0913 
*         (THE SECOND PHASE, IF ANY, IS CALLED JUST BEFORE BEGINNING     ID0913 
*         TO WRITE A BLOCK IMAGE TO DISK.)                               ID0913 
* 
*     FSALTFLG[0] IN THE FSTT IS 1. IF THIS WAS 0 ON ENTRY, 
*     THE FSTT HAS BEEN LOGGED IN THE SAME WAY THE BLOCK
*     WAS LOGGED IF BLALTFLG[0] CHANGED FROM 0 TO 1.
*                                                                        ID0913 
* DC  ERROR CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     FATAL ERROR, INDICATING A FLAW IN OUR LOGIC, IF BLRIP[0] WAS 1     ID0913 
*     AT ENTRY. THIS WOULD INDICATE A READ-IN-PROGRESS ON THE BLOCK      ID0913 
*     IMAGE, AND WE WOULD HAVE NO BUSINESS TO BE THINKING OF ALTERING    ID0913 
*     THAT IMAGE BEFORE READING WAS COMPLETE.                            ID0913 
*                                                                        ID0913 
* DC  CALLED ROUTINES                                                    ID0913 
*                                                                        ID0913 
*     LGFS$AA - TO LOG THE FSTT 
*     SLOG$AA - TO NOTE THAT A MULTI-BLOCK CHANGE IS TAKING PLACE,      002400
*       IF THE CURRENT BLOCK IS MIP. THE MIP FILE IS NORMALLY ALTERED   002500
*       BEFORE THE DATA FILE, SO NOTING THIS THE FIRST TIME A MIP       002600
*       BLOCK IS ALTERED WILL NORMALLY PRECEDE ALL BLOCK CHANGES.       002700
*     IOWR$AA - TO COMPLETE A WRITE OF THE BLOCK, IF ONE WAS IN          ID0913 
*       PROGRESS WHEN ALTR$AA WAS ENTERED.                               ID0913 
*     LOG$AA - A LOGGING ROUTINE.                                        CIM0201
*     MSGF$AA - TO OUTPUT FATAL ERROR MESSAGE.                           CIM0201
*     CKSM$AA - TO CHECKSUM BEFORE LOGGING, SO THAT THE LOG FILE WILL    CY210
*       CONTAIN GOOD CHECKSUMS.                                          CY210
*                                                                        ID0913 
* DC  NON-LOCAL VARIABLES                                                ID0913 
*                                                                        ID0913 
*     ABLKINC - SET AS NOTED ABOVE.                                      ID0913 
*                                                                        ID0913 
 #                                                                       ID0913 
                             #START OF ALTR$AA CODE#                     ID0913 
      ITEM TBLK;             #TEMP STORE FOR BLOK$AA#                    JJJ0510
      ITEM TIN;              #TEMP STORE FOR INDEX# 
      IF FSALTFLG[0] EQ 0 THEN LGFS$AA; 
      IF FTMIPGN[0] EQ 0
      THEN
          BEGIN 
          FSMODFLG[FTFSTT[0]-P<FSTT$AA>] = TRUE ; 
          END 
      IF BLMIPBLK[0] NQ 0                                               002900
      THEN                                                              003000
          BEGIN                                                         003100
          SLOG$AA ;                                                     003200
          END                                                           003300
      BLCIP[0] = 1 ;
      IF BLALTFLG[0] EQ 0    #FIRST ALTERATION TO BLOCK IN CORE#         VBG1007
      THEN                   #YES#                                       VBG1007
          BEGIN                                                          VBG1007
          ALTER;             #SUB-PROCEDURE, SEE BELOW#                  VBG1007
          IF P<BLOK$AA> EQ P<FSTT$AA>  #ALL DONE IF BLOCK AN FSTT#       VBG1007
          THEN                                                           VBG1007
              BEGIN                                                      VBG1007
              RETURN;                                                    VBG1007
              END                                                        VBG1007
          TIN = BLFSTTADR - P<FSTT$AA>;  #FSTT INDEX, DATA OR MIP#
          IF NOT FSOPENFLG[TIN] 
          THEN               #FIRST CHANGE SINCE LAST FLUSH#             VBG1007
              BEGIN                                                      VBG1007
              TBLK = P<BLOK$AA>;                                         JJJ0510
              P<BLOK$AA>=BLFSTTADR[0];                                   VBG1007
              FSOPENFLG[TIN] = TRUE;  #SET FILE ALTERED FLAG# 
              IF FTFWI EQ 0                                              CY209
              THEN                                                       CY209
                  BEGIN                                                  CY209
                             #FORCE WRITE FSTT UNLESS IT WILL BE DONE#   CY209
                             #AT END OF OPERATION BECAUSE USER IS DOING# CY209
                             #FORCED WRITE#                              CY209
                  IOWR$AA (1);                                           CY209
                  END                                                    CY209
              P<BLOK$AA> = TBLK;                                         JJJ0510
              END                                                        VBG1007
          END                                                            VBG1007
      RETURN;                                                            VBG1007
    PROC ALTER;    #SHARED CODE#                                         VBG1007
          BEGIN                                                          VBG1007
          IF BLRIP[0] NQ 0   #JUST IN CASE, VERIFY NO READS#             VBG1007
          THEN               #FATAL ERROR#                               VBG1007
              BEGIN                                                      VBG1007
              IMPOSSIBLE(ALTRIP);  #*** IMPOSSIBLE ***# 
              END                                                        VBG1007
          IF BLWIP[0] NQ 0   #JUST WAIT IF WRITE IN PROGRESS#            VBG1007
          THEN                                                           VBG1007
              BEGIN                                                      VBG1007
              IOWR$AA(1);                                                VBG1007
              END                                                        VBG1007
      IF FSLGX[0] NQ 0       #IS FILE BEING LOGGED#                      VBG1109
          THEN               #YES#                                       VBG1007
              BEGIN                                                      VBG1007
                                                                         JJJ0717
#     THE BLOCK IS CHECKSUMMED ERE LOGGING IN CASE TRIVIAL CHANGES MADE# JJJ0717
#     TO IN-CORE COPY, SUCH AS CHANGEING BLPARENT OR FSTT STATS#         JJJ0717
                                                                         JJJ0717
              BLCHKSUM = CKSM$AA;                                        JJJ0717
              LOG$AA(0);     #LOG THE BLOCK#                             VBG1007
              END                                                        VBG1007
          BLALTFLG[0]=1;     #SET ALTERED FLAG#                          VBG1007
          IF BLUBSFLG[0] EQ 0          #IF IN CMM SPACE#                 VBG1007
          THEN                                                           VBG1007
              BEGIN                                                      VBG1007
              ABLKINC=1;     #SET ALTERED FLAG FOR CMM SPACE#            VBG1007
              END                                                        VBG1007
          END                                                            VBG1007
      END                                                                VBG1007
CONTROL EJECT;                                                           SAAM3MO
PROC BACK$AA;                                                            SAAM3MO
          BEGIN                                                          SAAM3MO
                                                                         ID0913 
 #                                                                       JJJ0913
* *   BACK$AA - BACKSPACE ONE RECORD                           PAGE 1    JJJ0913
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC BACK$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO BACKSPACE THE FILE OR SUBFILE TO WHICH THE CURRENT PTREE        JJJ0913
*     REFERS, BY ONE RECORD.                                             JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THE CURRENT RECORD MUST BE IN CORE.                                JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     IF FAIL=0 , THE BACKSPACE WAS ACCOMPLISHED, THE PRECEDING RECORD   JJJ0913
*     IS NOW SHOWN CURRENT IN THE PTREE, AND RECFWA, RECLWA AND RECLG    JJJ0913
*     NOW LOCATE IT. IF THE NEWLY CURRENT RECORD IS THE FIRST IN THE     JJJ0913
*     FILE OR SUBFILE, QFR HAS BEEN SET TO 1. QLR HAS BEEN ZEROED.       CIM0202
*                                                                        JJJ0913
*     IF FAIL IS NOT 0, THE FIRST RECORD WAS ALREADY CURRENT, AND        JJJ0913
*     NOTHING HAS BEEN CHANGED.                                          JJJ0913
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     BCK1$AA - TO BACKSPACE WITHIN THE SAME BLOCK IF POSSIBLE.          JJJ0913
*       ALSO TO DISCOVER IF THE NEWLY CURRENT RECORD IS THE FIRST        JJJ0913
*       LIVE RECORD IN THE BLOCK.                                        JJJ0913
*     BACK$IS - TO BACKSPACE ACROSS A BLOCK BOUNDARY IN AN I-S FILE      JJJ0913
*       OR SUBFILE                                                       JJJ0913
*     SEBL$AA - TO BACKSPACE ACROSS BLK BOUNDARY FOR AK.                 RPN0629
*     SETR$AA - TO MAKE THE NEW RECORD CURRENT.                          CIM0201
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     BACKREC IS USED AS SCRATCH, AND TO COMMUNICATE RESULTS BETWEEN THE CY210
*       VARIOUS ROUTINES INVOLVED.                                       JJJ0913
*                                                                        JJJ0913
 #                                                                       JJJ0913
CONTROL EJECT;               #START OF BACK$AA CODE#                     JJJ0913
          FAIL = 1 ;                                                     SAAM3
          IF QFR NQ 0 THEN RETURN ;                                      SAAM3
          BCK1$AA ;                                                      SAAM3
          IF BACKREC EQ 0                                                SAAM3MO
          THEN                                                           SAAM3MO
            BEGIN                                                        SAAM3MO
            IF BLOCKID[0] EQ FIRDAT   THEN  RETURN;                      JJJ0916
                                                                         JJJ0916
            IF ORG EQ FO"AK"                                             RPN0629
            THEN                                                         RPN0629
              BEGIN                                                      RPN0629
BACKAK:                                                                  GAG0928
              IF BLOCKID[0] EQ PRU3                                      GAG0928
              THEN                                                       GAG0928
                  BEGIN                                                  GAG0928
                  RETURN;                                                GAG0928
                  END                                                    GAG0928
              PTCURBLK[CURPTR] = BLOCKID - FSBLKSIZ;                     RPN0629
              SEBL$AA(CURPTR,1);  #READ BLOCK IN WITH RECALL#            RPN0629
              END                                                        RPN0629
            ELSE                                                         RPN0629
              BEGIN                                                      RPN0629
              BACK$IS;                                                   RPN0629
              END                                                        RPN0629
            BACKREC = RC;                                                GAG0928
            IF BACKREC EQ 0                                              GAG0928
            THEN                                                         GAG0928
                BEGIN                                                    GAG0928
                GOTO BACKAK;                                             GAG0928
                END                                                      GAG0928
            END                                                          SAAM3MO
          FAIL = 0;                                                      JJJ0921
          QLR = 0;                                                       CIM0201
          SETR$AA (BACKREC);                                             SAAM3MO
          IF BLOCKID[0] EQ FIRDAT                                        JJJ0916
          THEN                                                           JJJ0916
            BEGIN                                                        JJJ0916
            BCK1$AA;                                                     JJJ0916
            IF BACKREC EQ 0   THEN QFR = 1;                              JJJ0916
            END                                                          JJJ0916
          END                                                            SAAM3
CONTROL EJECT;                                                           JJJ0913
PROC BCK1$AA;                                                            SAAM3MO
          BEGIN                                                          SAAM3MO
                                                                         ID0913 
 #                                                                       JJJ0913
* *   BCK1$AA - COULD WE BACKSPACE WITHIN THE CURRENT BLOCK      PAGE 1  JJJ0913
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC BCK1$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO DECIDE WHETHER, FROM THE CURRENT RECORD AS NAMED BY THE CURRENT JJJ0913
*     WORD OF THE PTREE, WE COULD BACKSPACE TO A LIVE RECORD IN THE SAME CY210
*     BLOCK, AND IF SO, TO DECIDE WHAT WOULD BE THE NUMBER OF THAT       CY210
*     RECORD.                                                            CY210
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THE CURRENT BLOCK, POINTED TO BY THE CURRENT WORD OF THE PTREE,    JJJ0913
*     MUST BE IN CORE, AND THE CURRENT RECORD NUMBER, GIVEN BY THE       JJJ0913
*     PTREE WORD, MUST NOT BE LARGER THAN THE COUNT OF RECORDS IN THE    JJJ0913
*     BLOCK.                                                             JJJ0913
*                                                                        JJJ0913
*     HOWEVER, THAT RECORD NUMBER COULD BE 0 WITHOUT CAUSING AN ERROR.   JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     BACKREC = 0 IF WE COULD NOT BACKSPACE TO A LIVE RECORD WITHIN THE  CY210
*     BLOCK. OTHERWISE, BACKREC IS THE RECORD NUMBER OF THE NEAREST      CY210
*     PRECEDING LIVE RECORD.                                             CY210
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     BACKREC FOR THE RESULT.                                            CY210
*     IX FOR SCRATCH.                                                    CY210
*                                                                        JJJ0913
 #                                                                       JJJ0913
                                                                         JJJ0913
                             #START OF BCK1$AA CODE#                     ID0913 
          FOR IX = PTCUREC[CURPTR]-1 STEP -1 UNTIL 1                     SAAM3MO
            DO                                                           SAAM3MO
            BEGIN                                                        SAAM3MO
            BACKREC = IX;                                                SAAM3MO
            IF UUCC$AA (BACKREC) LS ALIEN   THEN RETURN; #DONE#          AFB0801
                                                                         SAAM3MO
            END                                                          SAAM3MO
          BACKREC = 0;       #FAILURE#                                   SAAM3MO
          END                #END OF BCK1$AA#                            SAAM3MO
CONTROL EJECT;                                                           JJJ0508
PROC BLOKINIT (FSTT);                                                    JJJ0508
          BEGIN                                                          JJJ0508
 #                                                                       AM2A077
* *   BLOCKINIT - SET UP BLOCK HEADER            PAGE  1                 AM2A077
* *   J. JAN JANIK                                                       AM2A077
* 1DC BLOCKINIT                                                          AM2A077
*                                                                        AM2A077
* DC  FUNCTION                                                           AM2A077
*                                                                        AM2A077
*     TO CLEAR THE BLOCK FRAME WORDS AND SET BLFSTTADR AND BLMIPBLK      AM2A077
*     PROPERLY                                                           AM2A077
*                                                                        AM2A077
* DC  ENTRY CONDITIONS                                                   AM2A077
*                                                                        AM2A077
*     BLOK$AA POINTS TO THE BLOCK.                                       AM2A077
*     MIPMODE IS NON-ZERO IF WE ARE WORKING ON A MIP FILE.               AM2A077
*     A SINGLE PARAMETER, FSTT, IS PASSED AND IS USED TO SET BLFSTTADR.  AM2A077
*                                                                        AM2A077
* DC  EXIT CONDITIONS                                                    AM2A077
*                                                                        AM2A077
*     BLOCK FRAME SET UP AS DESCRIBED IN FUNCTION.                       AM2A077
 #                                                                       AM2A077
          ITEM FSTT;         #FORMAL PARAM#                              JJJ0508
                                                                         JJJ0508
          FOR IX = 0 STEP 1 UNTIL DBLKFRAME - 1                          JJJ0508
              DO  BLWRD0[IX] = 0;                                        JJJ0508
          BLFSTTADR = FSTT;                                              JJJ0508
          IF MIPMODE NQ 0                                                JJJ0508
          THEN                                                           JJJ0508
              BEGIN                                                      JJJ0508
              BLMIPBLK = 1;                                              JJJ0508
              END                                                        JJJ0508
          RETURN;                                                        JJJ0508
          END                                                            JJJ0508
CONTROL EJECT;
PROC CMMX$AA ;
          BEGIN 
  
 #
* *   CMMX$AA - RECHAIN THINGS AFTER CMM FAILURE
* *   A.F.R.BROWN 
* 1DC CMMX$AA 
* 
* DC  FUNCTION
* 
*     TO MAKE SURE THAT NO BLOCK BUFFERS, AND NO RARE CAPSULE 
*     THAT WOULD HAVE BEEN LINKED IN THE KICK-OUT CHAIN WHEN ITS
*     EXECUTION WAS COMPLETED, HAVE BEEN LEFT DE-LINKED BY THE
*     ABANDONMENT OF AN OPERATION, DUE TO CMM NOT BEING ABLE
*     TO FULFIL A REQUEST. THIS PROC IS NOT CALLED FROM WITHIN
*     AAM. IT IS CALLED BY CDCS, WHICH HAS ARRANGED TO GET
*     CONTROL AFTER THE ABSOLUTE FAILURE OF A CMM REQUEST. THEN 
*     CDCS CAN CLOSE THE TROUBLESOME FILE AND GO ON WITH OTHER
*     FILES, WITHOUT GETTING FATAL AAM ERRORS WHEN THINGS THAT
*     OUGHT TO BE IN THE CHAIN ARE NOT. 
* 
* DC  ENTRY CONDITIONS
* 
*     ANY BLOCK THAT WOULD NORMALLY BE IN THE KICKOUT CHAIN, BUT
*     WAS TEMPORARILY OUT OF IT WHEN CMM DISAPPOINTED US, SHOULD
*     HAVE ITS ADDRESS IN ARRAY FIXHOLD. IF AND ONLY IF A RARE
*     CAPSULE, NOT STATICALLY LOADED, WAS BEING EXECUTED AT THAT
*     TIME, AND SO TEMPORARILY DELINKED, CALCODE SHOULD BE NEGATIVE.
*     THE ADDRESS OF THE CAPSULE CAN BE FOUND FROM WORD JPWORD
*     IN AAM$CTL. 
* 
* DC  EXIT CONDITIONS 
* 
*     IF THE ENTRY CONDITIONS WERE AUTHENTIC, ANY SUCH BLOCK(S) 
*     AND/OR CAPSULE HAVE BEEN RE-LINKED IN THE KICK-OUT CHAIN. 
*     THE FILE MAY BE DAMAGED, BUT CDCS CAN GO ON.
* 
* DC  ERROR CONDITIONS
* 
*     NONE RECOGNIZED HERE
* 
* DC  CALLED ROUTINES 
* 
*     CCAL$AA - TO RELINK A RARE CAPSULE (AN EXCEPTIONAL USE) 
*     UNFX$AA - TO CLEAR A FIXHOLD CELL, IF NONZERO, AND RELINK THE 
*       BLOCK IT POINTS TO INTO THE KICK-OUT CHAIN
* 
* DC  NON-LOCAL VARIABLES 
* 
*     CALCODE - FOUND NEGATIVE IF A RARE CAPSULE NEEDS RE-LINKING.
*       CCAL$AA RESETS IT POSITIVE. 
* 
 #
  
          ITEM N ; #ARRAY COUNTER FOR FIXHOLD#
  
          IF CALCODE LS 0 
          THEN  #MUST RELINK RARE CAPSULE#
              BEGIN 
              CCAL$AA ; 
              END 
          FOR N = 0 STEP 1 UNTIL 3
          DO
              BEGIN 
              UNFX$AA ( N ) ; 
              END 
          END 
CONTROL EJECT;                                                           AM2A011
PROC CMOV$AA ((CALLNUM),(SIZE));                                         AM2A011
          BEGIN                                                          AM2A011
 #                                                                       AM2A077
* *   CMOV$AA - CMM OVERFLOW ACTION ROUTINE      PAGE  1                 AM2A077
* *   J. JAN JANIK                                                       AM2A077
* 1DC CMOV$AA                                                            AM2A077
*                                                                        AM2A077
* DC  FUNCTION                                                           AM2A077
*                                                                        AM2A077
*     TO HANDLE CMM OVERFLOW BY RELEASING AS MUCH SPACE AS POSSIBLE, AND AM2A077
*     STILL CONTINUE RUNNING.                                            AM2A077
* 0DC ENTRY CONDITIONS                                                   AM2A077
* 0   TWO FORMAL PARAMETERS, CALLNUM AND SIZE ARE PASSED BY CMM. CALLNUM AM2A077
*     IS THE NUMBER OF TIMES THIS OVERFLOW ROUTINE HAS BEEN CALLED TO    AM2A077
*     HANDLE THIS CMM REQUEST. SIZE IS THE NUMBER OF WORDS CMM HAS BEEN  AM2A077
*     ASKED TO ALLOCATE.                                                 AM2A077
*     NO BASED ARRAY POINTERS ARE ASSUMED TO BE SET                      AM2A077
* 0DC EXIT CONDITIONS                                                    AM2A077
* 0   IF CALLNUM = 1 OR 2, RESP$AA HAS BEEN CALLED TO RELEASE SIZE WORDS AM2A077
*     IF CALLNUM = 3 OR 4, RESP$AA HAS BEEN CALLED TO RELEASE TWO TIMES  AM2A077
*     SIZE WORDS.  IF CALLNUM = 5, RESP$AA IS CALLED TO RELEASE ALL CMM  AM2A077
*     SPACE ALLOCATED FOR BLOCKS FOR AAM FILES.                          AM2A077
*                                                                        AM2A077
*     IF CALLNUM NQ TO 5 TARGET IS ADJUSTED TO MINTARG OR RUNTOTCM.      AM2A077
* 0DC CALLED ROUTINES                                                    AM2A077
* 0   RESP$AA - RELEASE CMM BLOCKS                                       AM2A077
*                                                                        AM2A077
 #                                                                       AM2A077
          ITEM CALLNUM,SIZE; #NUM OF THIS CALL, SIZE OF REQUEST#         AM2A011
                                                                         AM2A011
          IF CALLNUM EQ 5                                                AM2A011
          THEN                                                           AM2A011
              BEGIN                                                      AM2A011
              #FLUSH ALL FILES #                                         AM2A011
              T1 = RESP$AA(RUNTOTCM,0);                                  AM2A088
              END                                                        AM2A011
          ELSE                                                           AM2A011
              BEGIN                                                      AM2A011
              IF CALLNUM GR 2                                            AM2A011
              THEN                                                       AM2A011
                  BEGIN                                                  AM2A011
                  SIZE = SIZE * 2;                                       AM2A011
                  END                                                    AM2A011
              T1 = RESP$AA(SIZE,0);                                      AM2A011
              IF T1 GR 0 OR RUNTOTCM LS MINTARG                          AM2A011
              THEN                                                       AM2A011
                  BEGIN                                                  AM2A011
                  TARGET = MINTARG;                                      AM2A011
                  END                                                    AM2A011
              ELSE                                                       AM2A011
                  BEGIN                                                  AM2A011
                  TARGET = RUNTOTCM;                                     AM2A011
                  END                                                    AM2A011
              END                                                        AM2A011
          RETURN;                                                        AM2A011
          END                                                            AM2A011
CONTROL EJECT;
          XREF PROC CPKY$AA ;                                            AFB0707
          CONTROL IFEQ 1,2 ; # CPKY$AA MOVED TO MISC$AA #                AFB0707
PROC CPKY$AA (THETA) ;                                                   SAAM3MO
          BEGIN                                                          SAAM3MO
                                                                         ID0913 
 #                                                                       JJJ0913
* *   CPKY$AA - COMPARE THE KEY OF A RECORD WITH THE GIVEN KEY  PAGE 1   JJJ0913
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC CPKY$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO COMPARE THE PRIMARY KEY OF ANY RECORD IN THE CURRENT BLOCK,     JJJ0913
*     SPECIFIED BY RECORD NUMBER, NOT NECESSARILY THE CURRENT RECORD     JJJ0913
*     AND NOT NECESSARILY A LIVE RECORD, WITH THE KEY LOCATED AND        JJJ0913
*     DESCRIBED BY KEYOFF, KEYFWA, MAJKEY, AND KTYPE.                    JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THE CURRENT BLOCK MUST BE IN CORE, BUT IT DOES NOT MATTER          JJJ0913
*     WHAT THE CURRENT RECORD IS.                                        JJJ0913
*                                                                        JJJ0913
*     THERE IS ONE INCOMING PARAMETER, PASSED IN THE USUAL SYMPL WAY.    JJJ0913
*     THIS SPECIFIES A RECORD BY NUMBER, SO IT MUST BE NOT LESS THAN 1   JJJ0913
*     AND NOT GREATER THAN THE COUNT OF RECORDS IN THE BLOCK.            JJJ0913
*                                                                        JJJ0913
*     KEYFWA AND KEYOFF LOCATE THE KEY TO BE USED, BY ADDRESS AND        JJJ0913
*     FIRST CHARACTER OFFSET.                                            JJJ0913
*                                                                        JJJ0913
*     MAJKEY CONTAINS THE NUMBER OF CHARACTERS TO BE USED IN THE         JJJ0913
*     COMPARISON. THIS MUST BE NOT LESS THAN 1 AND NOT MORE THAN THE     JJJ0913
*     FULL LENGTH OF A PRIMARY KEY IN THE FILE OR SUBFILE.               JJJ0913
*                                                                        JJJ0913
*     KTYPE (A FIELD IN THE FSTT FOR A MAIN FILE, OR IN THE FIAT FOR     JJJ0913
*     A SUBFILE) DESCRIBES THE KEY TYPE.                                 JJJ0913
*                                                                        JJJ0913
*     TEMPOS (SET BY LKEY$AA) GIVES THE POSITION OF THE FIRST CHARACTER  CY210
*     OF THE KEY, WITHIN ITS WORD.                                       CY210
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     COND = 0 IF THE TWO KEYS ARE EQUAL.                                JJJ0913
*     COND < 0 IF THE KEY IN THE RECORD IS GREATER.                      JJJ0913
*     COND > 0 IF THE KEY LOCATED BY KEYFWA AND KEYOFF IS GREATER.       JJJ0913
*                                                                        JJJ0913
*     BUT IF MAJKEY LS KLENG WE ARE TESTING THE RECORD KEY AGAINST A     JJJ1009
*     SHORT KEY (MAJOR KEY).  E.G. MACNAB AGAINST MAC.  MAC IS COUNTED   JJJ1009
*     AS LESS THAN MACNAB (COND < 0) EXCEPT WHEN WE ARE SEARCHING FOR    JJJ1009
*     A GREATER-THAN, WHEN MACNAB IS COUNTED LOW, TO FORCE THE SEARCH    JJJ1009
*     UP TO MAD---.                                                      JJJ1009
*                                                                        CY210
*     NOTE THAT RECFWA, RECLG, RECLWA AND TEMPLOC HAVE BEEN SET (THROUGH CY210
*     LOCR$AA) FOR RECORD THETA, THOUGH IT MAY NOT BE THE CURRENT        CY210
*     RECORD ACCORDING TO THE PTREE.                                     CY210
*                                                                        JJJ1009
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     LOCR$AA - TO SET TEMPLOC TO THE ADDRESS WHERE THE KEY              CY210
*       OF THE RECORD BEGINS.                                            CY210
*     CPCH$AA - TO DO THE COMPARISON, ONCE THE KEY IN THE RECORD HAS     JJJ0913
*       BEEN LOCATED.                                                    JJJ0913
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     COND IS SET BY CPCH$AA TO INDICATE THE RESULT.                     JJJ0913
*                                                                        JJJ0913
 #                                                                       JJJ0913
          ITEM THETA;        #FORMAL PARAMETER#                          SAAM3MO
                                                                         SAAM3MO
                             #START OF CPKY$AA CODE#                     ID0913 
          LOCR$AA ( THETA ) ;                                            AFB0528
          CPCH$AA ( KEYFWA,KEYOFF,TEMPLOC,TEMPOS,MAJKEY,KTYPE ) ;        AFB0528
          IF COND EQ 0 AND MAJKEY LS KLENG                               JJJ1009
          THEN                                                           JJJ1009
              BEGIN                                                      JJJ1009
              IF QREL EQ REL"GT"                                         JJJ1023
              THEN                                                       JJJ1023
                  BEGIN                                                  JJJ1023
                  COND = 1;                                              JJJ1023
                  END                                                    JJJ1023
              ELSE                                                       JJJ1023
                  BEGIN                                                  JJJ1023
                  COND = -1;                                             JJJ1023
                  END                                                    JJJ1023
              END                                                        JJJ1009
                                                                         JJJ1009
          END                                                            SAAM3MO
          CONTROL ENDIF ;                                                AFB0707
CONTROL EJECT;                                                           JJJ0913
PROC CURR$AA ;                                                           JJJ0916
          BEGIN                                                          JJJ0913
                                                                         ID0913 
 #                                                                       JJJ0913
* *   CURR$AA - LOCATE THE CURRENT BLOCK AND RECORD              PAGE 1  JJJ0913
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC CURR$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO LOCATE THE CURRENT BLOCK AND RECORD, AS INDICATED BY WORD       JJJ0913
*     CURPTR OF THE PTREE.                                               JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THE PTREE MUST BE LOCATABLE AND PROPERLY SET UP, AND FIELD CURPTR  JJJ0913
*     MUST POINT TO A VALID WORD IN THE PTREE.                           JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     SEE THE EXIT CONDITIONS OF ROUTINES SEBL$AA AND LOCR$AA, AS THIS   JJJ0913
*     IS JUST A CALL TO ONE ROUTINE AND THEN THE OTHER.                  JJJ0913
*     THE CALL TO SEBL$AA IS DONE WITH A NON-ZERO RECALL PARAMETER, SO   JJJ0913
*     THERE IS NO QUESTION, BARRING ERRORS, OF NOT COMPLETING.           JJJ0913
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     SEBL$AA - TO LOCATE AND READ IN THE CURRENT BLOCK.                 JJJ0913
*     LOCR$AA - TO LOCATE THE CURRENT RECORD.                            JJJ0913
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
 #                                                                       JJJ0913
                             #START OF CURR$AA CODE#                     JJJ0916
          SEBL$AA (CURPTR , 1) ;                                         JJJ0916
                                                                         JJJ0916
          LOCR$AA (PTCUREC[CURPTR]) ;                                    JJJ0916
          END                                                            SAAM3
CONTROL EJECT;                                                           JJJ0913
PROC DABL$AA ( (N) , RECALL );                                           JJJ0913
          BEGIN                                                          JJJ0913
                                                                         ID0913 
 #                                                                       JJJ0913
* *   DABL$AA - LOCATE AND MAKE CURRENT A DATA BLOCK      PAGE  1        JJJ0916
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC DABL$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO ACT LIKE SEBL$AA, WITH A COUPLE OF DIFFERENCES --               JJJ0913
*       1. THE FIRST PARAMETER SPECIFIES THE PRU NUMBER OF THE BLOCK,    JJJ0913
*        NOT THE PTREE LEVEL AT WHICH TO FIND THE BLOCK NUMBER           JJJ0913
*        OR ADDRESS.                                                     JJJ0913
*       2. THE BLOCK IS ASSUMED TO BE A DATA BLOCK, NOT AN INDEX BLOCK.  JJJ0913
*        IT COULD BE A DATA BLOCK IN AN I-S OR AN A-K FILE. IF THE BLOCK JJJ0913
*        IS AN INDEX BLOCK, DABL$AA WILL NOT DO ANY REAL HARM, BUT WILL  JJJ0913
*        PROBABLY WASTE TIME.                                            JJJ0913
*       3. BESIDES LOCATING THE GIVEN BLOCK, DABL$AA WILL DO SOME        JJJ0913
*        READ-AHEAD AND WRITE-BEHIND.                                    JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THERE ARE TWO PARAMETERS, PASSED IN THE NORMAL SYMPL WAY.          JJJ0913
*       1. THE PRU NUMBER OF THE WANTED BLOCK.                           JJJ0913
*       2. A RECALL PARAMETER. IF ANY READING HAS TO BE DONE, IT WILL    JJJ0913
*        BE DONE WITHOUT RECALL IF THIS PARAMETER IS 0, OR WITH RECALL   JJJ0913
*        IF NON-ZERO. IF THE PARAMETER IS 0, THE CALLER MUST LOOK AT     JJJ0913
*        PTBLKIN[CURPTR] AFTERWARDS. THIS WILL BE 0 IF INCOMPLETE, OR    JJJ0913
*        1 IF COMPLETE.                                                  JJJ0913
*                                                                        JJJ0913
*     CURPTR MUST BE CORRECT. IT POINTS TO THE WORD OF THE PTREE IN      JJJ0913
*     WHICH THE PRU NUMBER OR ADDRESS OF THE BLOCK WILL BE INSERTED.     JJJ0913
*                                                                        JJJ0913
*     IF THE WANTED BLOCK IS ALREADY IN CORE, OR IS ALREADY NAMED IN     JJJ0913
*     THE PTREE WORD CURPTR POINTS TO, NO HARM IS DONE.                  JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     IF THE INCOMING RECALL PARAMETER WAS NON-ZERO, THE WANTED BLOCK    JJJ0913
*     SHOULD BE IN CORE, ITS ADDRESS SHOULD BE IN PTCURBADR[CURPTR],     JJJ0913
*     AND PTBLKIN[CURPTR] SHOULD BE 1.                                   JJJ0913
*                                                                        JJJ0913
*     IF THE INCOMING RECALL PARAMETER WAS 0, IT MAY BE THUS, OR         JJJ0913
*     PTBLKIN[CURPTR] MAY BE 0, WITH PTCURBLK[CURPTR] = N , THE          JJJ0913
*     PRU NUMBER THAT IS THE FIRST INCOMING PARAMETER.                   JJJ0913
*                                                                        JJJ0913
*     IF THE CURRENT PTREE WORD PREVIOUSLY CONTAINED THE ADDRESS OF      JJJ0913
*     SOME OTHER DATA BLOCK,IN CORE, IT WILL HAVE BEEN MOVED TO THE      JJJ0913
*     TAIL OF THE KICK-OUT CHAIN. AS A GENERAL THING, WE LET A DATA      JJJ0913
*     BLOCK DIE QUICKLY ONCE IT CEASES TO BE CURRENT.                    JJJ0913
*                                                                        JJJ0913
*     IN ADDITION, IF THE BLOCK MOVED TO THE TAIL OF THE KICK-OUT        JJJ0913
*     CHAIN HAS BEEN ALTERED, WE CALL IOWR$AA TO BEGIN WRITING IT        JJJ0913
*     WITHOUT RECALL (WRITE-BEHIND). BUT NOT IF FALPBLNO[0] AND          CY210
*     FALPRCNO[0] POINT TO THE LAST RECORD OF THIS BLOCK, BECAUSE THAT   CY210
*     SUGGESTS THAT MORE RECORDS MAY BE ADDED TO THE END OF THE          CY210
*     CURRENT BLOCK BEFORE WE ARE FINALLY THROUGH WITH IT.               CY210
*     FLAG BLWTN IS SET TO SHOW THAT A WRITE-BEHIND HAS BEEN AT LEAST 
*     ATTEMPTED ON THE BLOCK. BUT THE WRITE-BEHIND IS NOT ATTEMPTED HERE
*     IF THIS FLAG IS ALREADY SET. I.E. THE FLAG IS A DEVICE TO 
*     PREVENT A BLOCK FROM BEING THE OBJECT OF A WRITE-BEHIND MORE
*     THAN ONCE, WITHOUT A READ OF THE BLOCK INTERVENING. 
*                                                                        CY210
*     IN ADDITION, A COUNT IS KEPT IN FWDCNT OF HOW MANY CONSECUTIVE     CY210
*     TIMES DABL$AA HAS, IN THIS FILE, MADE A TRANSITION FROM ONE        CY210
*     BLOCK TO ITS LOGICAL SUCCESSOR. THE COUNT IS INCREASED, UP TO      CY210
*     A MAXIMUM OF THREE, WHENEVER DABL$AA MAKES SUCH A TRANSITION,      CY210
*     BUT ZEROED WHENEVER DABL$AA MAKES A DIFFERENT TRANSITION, OR       CY210
*     WHEN A BLOCK SPLIT TAKES PLACE. IF THE COUNT IS 3 WHEN DABL$AA     CY210
*     GOES TO THE NEW BLOCK, AND THE NEW BLOCK IS NOT THE LAST IN THE    CY210
*     FILE CHAIN, AND THE INCOMING RECALL PARAMETER IS NOT ZERO, AND     CY210
*     NO WRITE-BEHIND HAS JUST BEEN INITIATED, WE CALL LOCB$AA TO        CY210
*     START READING THE SUCCESSOR TO THE NEW BLOCK (READ-AHEAD. NO USE   CY210
*     TRYING THIS IF WRITE-BEHIND IS GOING ON, AS THEY USE THE SAME      CY210
*     FET.)                                                              CY210
*                                                                        JJJ0913
*     IN ANY CASE, SEBL$AA HAS BEEN CALLED FOR THE NEW BLOCK, AND IF     JJJ0913
*     PTBLKIN[CURPTR]=1, THEN P<BLOK$AA>, BLOCLWA, PTCURBADR[CURPTR],    JJJ0913
*     BLPTRADR[0] HAVE BEEN SET AS DESCRIBED FOR SEBL$AA.                CY210
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE DETECTED IN THIS ROUTINE.                                     JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     AGE - TO MOVE A DATA BLOCK THAT IS CEASING TO BE CURRENT,          CY210
*       OR IS BEING ((READ AHEAD)), TO THE TAIL OF THE                   CY210
*       KICK-OUT CHAIN.                                                  CY210
*           THE FORMER, BECAUSE WHEN WE LEAVE A BLOCK WE ARE NOT         CY210
*       LIKELY TO WANT IT AGAIN SOON, UNLESS IMMEDIATELY AFTER,          CY210
*       AT WHICH TIME THE ((AGE)) PROCESS WILL NOT YET HAVE              CY210
*       CAUSED IT TO DISAPPEAR FROM CORE.                                CY210
*           THE LATTER, BECAUSE A ((READ AHEAD)) BLOCK IS ONLY           CY210
*       POSSIBLY GOING TO BE USEFUL, AND SHOULD NOT BE ALLOWED           CY210
*       TO SHOULDER AN INDEX BLOCK OUT OF CORE.                          CY210
*     IOWR$AA - TO DO A WRITE-BEHIND.                                    JJJ0913
*     SEBL$AA - TO LOCATE THE WANTED BLOCK, AND READ IT IN IF NECESSARY. JJJ0913
*     LOCB$AA - TO DO A READ-AHEAD.                                      JJJ0913
*     FIXX$AA - IN CASE OF READ-AHEAD, TO FIX THE PRIMARILY WANTED BLOCK JJJ0913
*       WHILE SPACE FOR THE READ-AHEAD IS OBTAINED.                      JJJ0913
*     UNFX$AA - TO UNDO FIXX$AA, ONCE THE READ-AHEAD HAS BEGUN.          JJJ0913
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
 #                                                                       JJJ0913
CONTROL EJECT;               #START OF DABL$AA CODE#                     JJJ0913
          ITEM N;            #PRU OF WANTED BLOCK#                       JJJ0913
          ITEM RECALL;       #0 = I/O WITHOUT RECALL#                    JJJ0913
          ITEM X;            #LOCAL TEMP#                                JJJ0913
          ITEM XQ;           #LOCAL TEMP#                               014310
          ITEM XR;           #LOCAL TEMP#                               014320
                                                                         JJJ0913
                                                                         JJJ0913
          XR = 0 ;                                                      014500
          X = -1 ;                                                       SAAM3
          IF PTBLKIN[CURPTR] NQ 0                                        SAAM3
            THEN BEGIN                                                   SAAM3
              P<BLOK$AA> = PTCURBADR[CURPTR] ;                           SAAM3
              XQ = BLOCKID[0] ;                                         014700
              IF N EQ XQ THEN GOTO DATABRIK ;                           014800
              IF INDEXFLAG EQ 0                                          SAAM3
                THEN BEGIN                                               SAAM3
                  AGE ;                                                  SAAM3
                  IF ORG EQ FO"IS"                                      014910
                    THEN X = FWD ;                                      014920
                    ELSE X = BLOCKID[0] + FSBLKSIZ[0] ;                 014930
                  IF BLALTFLG[0] NQ 0 AND BLWTN[0] EQ 0 AND 
                   ( BLOCKID[0] NQ FALPBLNO[0] OR RC NQ FALPRCNO[0] )    JJJ1116
                    THEN BEGIN                                          015200
                      IOWR$AA ( 0 ) ; #WRITE BEHIND#                    015300
                      BLWTN[0] = 1 ;
                      XR = 1 ;                                          015400
                    END                                                 015500
                END                                                      SAAM3
            END                                                          SAAM3
            ELSE XQ = PTCURBLK[CURPTR] ;                                015700
          PTCURBLK[CURPTR] = N LAN ( 2**24-1 ) ;
          IF XQ NQ N                                                    015900
            THEN BEGIN                                                  016000
              IF X EQ N                                                 016100
                THEN BEGIN                                              016200
                  FWDCNT = FWDCNT + 1 ;                                 016300
                  IF FWDCNT GR 3 THEN FWDCNT = 3 ;                      016400
                END                                                     016500
                ELSE FWDCNT = 0 ;                                       016600
            END                                                         016700
       DATABRIK: SEBL$AA ( CURPTR , RECALL ) ;                           SAAM3
          IF XQ NQ N AND FWDCNT EQ 3 AND RECALL NQ 0                    016900
           AND FWD NQ 0 AND XR EQ 0                                     017000
            THEN BEGIN # READ AHEAD WITHOUT RECALL #                     SAAM3
              X = P<BLOK$AA> ;                                           SAAM3
              IF BLFKOPTR[0] NQ 0                                        SAAM3
                THEN BEGIN                                               SAAM3
                  FIXX$AA ( P<BLOK$AA> , 2 ) ;                           SAAM3
                  X = -X ;                                               SAAM3
                END                                                      SAAM3
              LOCB$AA ( FWD , 0 ) ;                                      SAAM3
              IF P<BLOK$AA> GR 0 THEN AGE ;                              GAG1129
              IF X LS 0                                                  SAAM3
                THEN BEGIN                                               SAAM3
                  X = -X ;                                               SAAM3
                  UNFX$AA ( 2 ) ;                                        SAAM3
                END                                                      SAAM3
              P<BLOK$AA> = X ;                                           SAAM3
            END                                                          SAAM3
          END                                                            SAAM3
CONTROL EJECT ; 
  
PROC EXRP$AA; 
          BEGIN 
 #                                                                       CY210
* *   EXRP$AA -- DEAL WITH A BLOCK READ ERROR             PAGE 1         CY210
* *   A.F.R.BROWN                                                        CY210
* 1DC EXRP$AA                                                            CY210
*                                                                        CY210
* DC  FUNCTION                                                           CY210
*                                                                        CY210
*     WHEN A PARITY, LENGTH, OR CHECKSUM ERROR IS FOUND AFTER A          CY210
*     BLOCK READ, TO DECIDE WHICH ERROR MESSAGE TO ISSUE, AND            CY210
*     WHETHER FATAL OR NOT.                                              CY210
*                                                                        CY210
* DC  ENTRY CONDITIONS                                                   CY210
*                                                                        CY210
*     P<BLOK$AA> CONTAINS THE NEGATIVE OF THE FWA OF THE BLOCK.          CY210
*     BLCODSTAT[0] CONTAINS, IN PRINCIPLE, THE FET CODE AND STATUS       CY210
*       AS IT STOOD WHEN THE BLOCK FINISHED BEING READ. HOWEVER,         CY210
*       IF ALL WAS WELL EXCEPT A BAD CHECKSUM, THIS FIELD CONTAINS       CY210
*       37776 OCTAL. THIS IS THE ONLY CASE WE GIVE A SPECIAL             CY210
*       MESSAGE TO. OTHERWISE IT IS JUST SOME KIND OF BAD READ,          CY210
*       WHETHER PARITY, LENGTH ERROR, OR SOMETHING ELSE.                 CY210
*     FSMODFLG[0] IS 0 UNLESS A MODIFICATION OF THE FILE WAS IN          CY210
*       PROGRESS WHEN THE READ ERROR WAS DISCOVERED.                     CY210
*                                                                        CY210
* DC  EXIT CONDITIONS                                                    CY210
*                                                                        CY210
*     IN EFFECT, WE DONT EXIT FROM THIS SUBROUTINE BUT BRANCH            CY210
*     STRAIGHT TO EXIT$AA TO ABANDON THIS FILE ACTION, AFTER             CY210
*     THE ERROR MESSAGE ROUTINE HAS BEEN CALLED. IF FSMODFLG[0]          CY210
*     WAS 1 ON ENTRY, MSGF$AA HAS BEEN CALLED AND SET THE                CY210
*     FATAL ERROR FLAGS.                                                 CY210
*                                                                        CY210
* DC  CALLED ROUTINES                                                    CY210
*                                                                        CY210
*     MSGF$AA -- TO ISSUE THE MESSAGE AND SET THE FATAL ERROR            CY210
*       FLAG IF FSMODFLG[0] IS 1.                                        CY210
*     MSGZ$AA -- TO ISSUE THE MESSAGE AND COUNT A NON-FATAL ERROR,       CY210
*       IF FSMODFLG[0] IS 0.                                             CY210
*                                                                        CY210
* DC  NON-LOCAL VARIABLES                                                CY210
*                                                                        CY210
*     ENUM AS SCRATCH.                                                   CY210
*                                                                        CY210
 #                                                                       CY210
          P<BLOK$AA> = -(P<BLOK$AA>) ;
          IF BLCODSTAT[0] EQ O"37776" 
          THEN
              BEGIN 
              ENUM = EC147 ; #CHECKSUM# 
              END 
          ELSE
              BEGIN 
              ENUM = EC135 ; #READ PARITY#
              END 
          P<BLOK$AA> = -(P<BLOK$AA>) ;
          IF ( FTFSTT[0] NQ 0 ) AND FSMODFLG[FTFSTT[0]-P<FSTT$AA>]
          THEN
              BEGIN 
              MSGF$AA ( ENUM ) ;
              END 
          ELSE
              BEGIN 
              MSGZ$AA ( ENUM ) ;
              END 
          GOTO EXIT$AA ;
          END 
CONTROL EJECT;
     PROC FILP$AA ( N ) ; BEGIN ITEM N ;                                 AFB0517
 #                                                                       CY211
* *   FILP$AA (ALIAS FILPOS) - SET FTFP AND FAFP          PAGE  1        AM2A077
* *   A.F.R.BROWN                                                        CY211
* 1DC FILP$AA                                                            CY211
*                                                                        CY211
* DC  FUNCTION                                                           CY211
*                                                                        CY211
*     TO SET FTFP[0] AND FAFP[0] TO SOME VALUE. FTFP IS THE ONE THE      CY211
*     USER SEES, IN THE FIT. AS AN INTERNAL PROTECTION, WE PUT THE       CY211
*     SAME VALUE IN FAFP, IN THE FIAT, WHICH THE USER IS LESS LIKELY     CY211
*     TO DISTURB, AND RELY INTERNALLY ON FAFP RATHER THAN FTFP.          CY211
*                                                                        CY211
*     ALSO TO SET FAALTPOS[0], IN THE FIAT, TO 0, INDICATING THAT        CY211
*     THE LAST PERSON TO ALTER THE PTREE SET IT TO REFLECT A             CY211
*     POSITION OF THE GETNEXT OR SEEK TYPE, RATHER THAN TO A POSITION OF CY211
*     THE UPDATE TYPE. AN UPDATE IS SUPPOSED TO LEAVE THE GETNEXT-       CY211
*     TYPE POSITION LOGICALLY UNCHANGED.                                 CY211
*                                                                        CY211
*     ALSO, PROVIDED THE VALUE TO BE STORED AT FTFP IS NOT 0             CY211
*     (WHICH INDICATES AN INCOMPLETE SEEK) TO DO TWO THINGS --           CY211
*     (1) SET FASKLAST[0] IN THE FIAT TO 0, INDICATING THAT THE          CY211
*     LAST PERSON TO ALTER THE PTREE DID NOT SET IT TO REFLECT           CY211
*     A SEEK POSITION, WHICH WOULD BE NO USE TO A FOLLOWING              CY211
*     GETNEXT.                                                           CY211
*     (2) SAVE THE PRIMARY KEY VALUE OF THE CURRENT RECORD               CY211
*     IN THE FIAT AREA TO WHICH FAPKY3ADR[0] POINTS. BUT NOT             CY211
*     IF AT EOI, FOR OBVIOUS REASONS, NOR IF GETNEXT-TYPE                CY211
*     POSITION IS CURRENTLY BY AN ALTERNATE KEY (MIP SAVES               CY211
*     THE PRIMARY KEY VALUES DIFFERENTLY) OR IF THE FILE                 CY211
*     IS EMPTY, FOR OBVIOUS REASONS. OR IF THE CURRENT FILE 
*     IS DA AND THE CURRENT OPERATION IS GET OR REWIND. DA GET
*     IS NOT CONSIDERED TO ESTABLISH A POSITION, AND DA REWIND
*     ESTABLISHES A POSITION WITHOUT ACTUALLY LOOKING AT THE
*     FIRST RECORD IN THE FILE. 
*                                                                        CY211
* DC  ENTRY CONDITIONS                                                   CY211
*                                                                        CY211
*     THERE IS ONE PARAMETER, PASSED IN THE NORMAL WAY, WHICH IS         CY211
*     THE VALUE TO BE STORED IN FTFP[0] AND FAFP[0]. THIS HAS ONE        CY211
*     OF THE VALUES FPNULL=0, BOI=1, EOK=10B, EOR=20B, EOI=100B,         CY211
*     AND FPRWMT=77B.                                                    CY211
*                                                                        CY211
*     P<FIT$AA> AND P<FIAT$AA> POINT TO THE CURRENT FIT AND FIAT.        CY211
*     P<FINF$AA> POINTS TO THE FINF OF THE CURRENT FILE OR SUBFILE.      CY211
*                                                                        CY211
*     FIELD RECCNT OF THE FINF CONTAINS THE COUNT OF RECORDS IN          CY211
*     THE CURRENT FILE OR SUBFILE.                                       CY211
*                                                                        CY211
*     FAPOSKEY1[0] IN THE FIAT IS 0 IF ANY EXISTING GETNEXT-TYPE         CY211
*     POSITION IN THE MAIN FILE IS BY PRIMARY KEY, OR NOT 0 IF           CY211
*     BY ALTERNATE KEY.                                                  CY211
*                                                                        CY211
* DC  EXIT CONDITIONS                                                    CY211
*                                                                        CY211
*     THE ((FUNCTIONS)) DESCRIBED ABOVE HAVE BEEN CARRIED OUT.           CY211
*                                                                        CY211
* DC  ERROR CONDITIONS                                                   CY211
*                                                                        CY211
*     NONE                                                               CY211
*                                                                        CY211
* DC  CALLED ROUTINES                                                    CY211
*                                                                        CY211
*     SPKY$AA - TO SAVE THE PRIMARY KEY VALUE.                           CY211
*                                                                        CY211
* DC  NON-LOCAL VARIABLES                                                CY211
*                                                                        CY211
*     NONE                                                               CY211
*                                                                        CY211
 #                                                                       CY211
          FAFP[0] = N ;                                                  AFB0517
          FTFP[0] = N ;                                                  AFB0517
          FAALTPOS[0] = 0 ;                                              AFB0517
          IF N NQ 0                                                      AM2A022
            THEN BEGIN                                                   AM2A022
              FASKLAST[0] = 0 ;                                          AFB0517
              IF N NQ EOI AND FAPOSKEY1[0] EQ 0 AND RECCNT NQ 0          AFB0517
               AND ( ORG EQ FO"IS" OR 
               ( FTCOP[0] NQ OP"GET" AND FTCOP[0] NQ OP"REW" )) 
                THEN SPKY$AA ( FAPKY3ADR[0] ) ;                          AFB0517
            END                                                          AFB0517
          END                                                            AFB0517
CONTROL EJECT;                                                           ID0913 
PROC FIXX$AA ( N , (K) );                                                ID0913 
          BEGIN                                                          ID0913 
                                                                         ID0913 
 #                                                                       ID0913 
* *   FIXX$AA - REMOVE A BLOCK TEMPORARILY FROM THE K-O CHAIN    PAGE 1  ID0913 
* *   A.F.R.BROWN                                                        ID0913 
* 1DC FIXX$AA                                                            ID0913 
*                                                                        ID0913 
* DC  FUNCTION                                                           ID0913 
*                                                                        ID0913 
*     TO REMOVE A BLOCK OF A FILE, NOW IN CORE, TEMPORARILY FROM THE     ID0913 
*     KICK-OUT CHAIN SO THAT IT WILL STAY AT ITS POSITION IN CORE        ID0913 
*     UNTIL FURTHER NOTICE, AND TO SAVE ITS ADDRESS IN ARRAY FIXHOLD.    ID0913 
*                                                                        ID0913 
* DC  ENTRY CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     THERE ARE TWO PARAMETERS, PASSED IN THE NORMAL SYMPL WAY.          ID0913 
*                                                                        ID0913 
*     1. THE FWA OF THE BLOCK PARCEL. THE BLOCK MUST NOW BE IN THE       ID0913 
*         KICK-OUT CHAIN, I.E. ITS BLFKOPTR[0] MUST BE NON-ZERO.         ID0913 
*     2. A NUMBER BETWEEN 0 AND 3, DESIGNATING THE WORD IN THE FIXHOLD   ID0913 
*         ARRAY WHERE THE BLOCK PARCEL ADDRESS IS TO BE STORED. THIS     ID0913 
*         WORD MUST CONTAIN 0 AT THE MOMENT.                             ID0913 
*                                                                        ID0913 
* DC  EXIT CONDITIONS                                                    ID0913 
*                                                                        ID0913 
*     THE BLOCK HAS BEEN DETACHED FROM THE KICK-OUT CHAIN, AND ITS       ID0913 
*     FWA HAS BEEN STORED IN THE SPECIFIED FIXHOLD WORD.                 ID0913 
*                                                                        ID0913 
* DC  ERROR CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     FATAL ERROR, IMPLYING SOMETHING WRONG WITH OUR LOGIC, IF THE       ID0913 
*     FIXHOLD WORD SPECIFIED BY THE SECOND PARAMETER IS NOT 0 WHEN       ID0913 
*     FIXX$AA IS ENTERED.                                                ID0913 
*                                                                        ID0913 
* DC  CALLED ROUTINES                                                    ID0913 
*                                                                        ID0913 
*     UNCH$AA - TO REMOVE THE BLOCK FROM THE KICK-OUT CHAIN.             ID0913 
*                                                                        ID0913 
* DC  NON-LOCAL VARIABLES                                                ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
 #                                                                       ID0913 
          ITEM N;            #FWA OF BLOCK#                              ID0913 
          ITEM K;            #WHICH FIXHOLD ENTRY#                       ID0913 
                                                                         ID0913 
                             #START OF FIXX$AA CODE#                     ID0913 
          IF FIXHOLD[K] NQ 0
          THEN
              BEGIN 
              IMPOSSIBLE(FIXBZY); 
              END 
          FIXHOLD[K] = N ;                                               SAAM3
          UNCH$AA ( N ) ;                                                SAAM3
          END                                                            SAAM3
CONTROL EJECT;                                                           JJJ1109
PROC FLSH$AA (LISTHD);                                                   JJJ1109
      BEGIN                                                              JJJ1109
 #                                                                       JJJ1109
* *   FLSH$AA - FLUSH ALL ALTERED BLOCKS         PAGE  1                 JJJ1109
* *   JJ JANIK                                   DATE  76/09/23          JJJ1109
* DC  NAME                                                               JJJ1109
*                                                                        JJJ1109
* C   FLSH$AA                                                            JJJ1109
*                                                                        JJJ1109
* DC  FUNCTION                                                           JJJ1109
*                                                                        JJJ1109
*     TO FLUSH ALL ALTERED BLOCKS FOR A LIST OF FILES (INCLUDING FSTT).  JJJ1109
*                                                                        JJJ1109
* DC  ENTRY CONDITIONS                                                   JJJ1109
*                                                                        JJJ1109
*     FORMAL PARAMETER LISTHD IS THE ADDRESS OF A LIST OF FIT WORDS      JJJ1109
*     WHICH IS TERMINATED BY A ZERO WORD.  EACH ENTRY HAS THE LFN IN     JJJ1109
*     THE FIRST 42 BITS AND THE FIT ADDR IN THE LOWER 18.  IF THE HIGH   JJJ1109
*     ORDER BIT OF AN ENTRY IS 1, THE ENTRY IS IGNORED.                  JJJ1109
* 
*     IF THE FIRST ENTRY POINTS TO A FIT IN WHICH BIT FTNOFF IS 1,
*     THEN THE WRITING OUT OF FSTT-S IS SKIPPED FOR THE ENTIRE
*     LIST. THIS IS FOR THE CONVENIENCE OF A PRODUCT THAT WANTS TO
*     FLUSH A FILE AFTER EVERY UPDATE, BUT FOR PERFORMANCE REASONS
*     WANTS TO LEAVE THE FSTT UNFLUSHED IN MOST CASES. IT SETS UP 
*     A LIST WITH A SINGLE POINTER TO THE RELEVANT FIT, SETS THE
*     BIT IN THE FIT, CALLS FLSH$AA, THEN RESETS THE BIT. 
*                                                                        JJJ1109
* DC  EXIT CONDITIONS                                                    JJJ1109
*                                                                        JJJ1109
*     ALL ALTERED BLOCKS FOR THE FILES SPECIFIED HAVE BEEN WRITTEN AND   JJJ1109
*     THE FILES PROPERLY EXTENDED.                                       JJJ1109
*                                                                        JJJ1109
* DC  CALLED ROUTINES                                                    JJJ1109
*                                                                        JJJ1109
*     EXTNDF - EXTEND A PERMANENT FILE IF NECESSARY.                     JJJ1109
*     FLSBLK - FLUSH BLOCKS FOR A FILE                                   JJJ1109
*     FLSFSTT - FLUSH FSTT FOR A FILE.                                   JJJ1109
*     SFLIST - SCAN FIT LIST AND APPLY A PROCEDURE TO EACH FILE IN THE   JJJ1109
*              LIST WHICH IS TO BE FLUSHED.                              JJJ1109
*                                                                        JJJ1109
* DC  DESCRIPTION                                                        JJJ1109
*                                                                        JJJ1109
*     SAVE FSTT AND FIT ADDRESSES.                                       JJJ1109
*     CALL SFLIST WITH FSLBLK TO WRITE BLOCKS FOR ALL FILES IN LIST.     JJJ1109
*     CALL SFLIST WITH FLSFSTT TO WRITE FSTTS FOR ALL FILES IN LIST.     JJJ1109
*     CALL SFLIST WITH EXTNDF TO EXTEND ALL PERMANENT FILES IN LIST      JJJ1109
*     WHICH NEED EXTENDED.                                               JJJ1109
*     RESTORE FSTT AND FIT ADDRESSES.                                    JJJ1109
 #                                                                       JJJ1109
CONTROL EJECT;                                                           JJJ1109
      ARRAY EXSTATUS S(1);   #USED IN EXTEND CALL#                       JJJ1109
          BEGIN                                                          JJJ1109
          ITEM EXSTATWD I(0,0,60);  #USED TO REFER TO WHOLE WORD#        JJJ1109
          ITEM EXSTATLFN U(0,0,42);  #USED FOR LFN FOR INPUT TO EXTEND#  JJJ1109
          END                                                            JJJ1109
                                                                         JJJ1109
      BASED ARRAY FFITLIST [0:0] S(1);                                   JJJ1109
          BEGIN                                                          JJJ1109
          ITEM FFITIGNR B(0,0,1); #SET IF FIT IS TO BE IGNORED#          JJJ1109
          ITEM FFITNAME U(0,0,42); #LFN OF THE FILE#                     JJJ1109
          ITEM FFITADDR I(0,42,18); #FIT ADDRESS#                        JJJ1109
          END                                                            JJJ1109
                                                                         JJJ1109
      ITEM ACTF;             #LAST ACTIVE FET#                           JJJ1109
      ITEM I1;               #INDUCTION VARIABLE#                        JJJ1109
      ITEM LISTHD;           #FORMAL PARAMETER#                          JJJ1109
                                                                         JJJ1109
                                                                         JJJ1109
      FLSHFLG = 1 ; 
      P<FFITLIST> = LISTHD;                                              JJJ1109
      SFLIST (FLSBLK);       #FLUSH ALL BLOCKS#                          JJJ1109
                                                                         JJJ1109
      IF (FFITADDR[0] GR 0) AND 
              (FFITIGNR[0] OR (FELNG[FFITADDR[0]-P<FET$AA>] LS 9) 
              OR (FTNOFF[FFITADDR[0]-P<FIT$AA>] EQ 0))
      THEN
          BEGIN 
          SFLIST(FLSFSTT);
          END 
                                                                         JJJ1109
      IF FWIFLG EQ 0   #IF NOT FLUSH DUE TO FORCE WRITE#                 CY209
      THEN                                                               CY209
          BEGIN                                                          CY209
          EXSTATWD[0]=0;     #ENSURE ZERO-FILLED LFN#                    CY209
          SFLIST(EXTNDF);    #EXTEND FILE#                               CY209
          END                                                            CY209
                                                                         JJJ1109
      FLSHFLG = 0 ; 
      RETURN;                                                            JJJ1109
CONTROL EJECT;                                                           JJJ1109
PROC EXTNDF;                                                             JJJ1109
          BEGIN                                                          JJJ1109
 #                                                                       JJJ1109
* DC1 NAME                                                               JJJ1109
*                                                                        JJJ1109
* C   EXTNDF                                                             JJJ1109
*                                                                        JJJ1109
* DC  FUNCTION                                                           JJJ1109
*                                                                        JJJ1109
*     TO EXTEND A FILE IF IT IS PERMANENT AND NEEDS TO BE EXTENDED.      JJJ1109
*                                                                        JJJ1109
* DC  ENTRY CONDITIONS                                                   JJJ1109
*                                                                        JJJ1109
*     FSTT$AA POINTS TO THE FSTT OF THE FILE.                            JJJ1109
*     FET$AA POINTS TO THE BUZY FET OF THE FILE.                         JJJ1109
*                                                                        JJJ1109
* DC  EXIT CONDITIONS                                                    JJJ1109
*                                                                        JJJ1109
*     THE FILE HAS BEEN EXTENDED AND THE NEEDS-EXTENDED-FLAG IN THE FSTT JJJ1109
*     HAS BEEN CLEARED.                                                  JJJ1109
*                                                                        JJJ1109
* DC  ERROR CONDITIONS                                                   JJJ1109
*                                                                        JJJ1109
* C   NONE                                                               JJJ1109
*                                                                        JJJ1109
* DC  CALLED ROUTINES                                                    JJJ1109
*                                                                        JJJ1109
*     CRA1$AA - CALLED TO CLOSE AND OPEN THE FILE AND TO DO THE EXTEND.  JJJ1109
*                                                                        JJJ1109
* DC  DESCRIPTION                                                        JJJ1109
*                                                                        JJJ1109
*     DO NOTHING IF FILE DOESNT NEED EXTENDED OR IS NOT PERMANENT.       JJJ1109
 #                                                                       JJJ1109
                                                                         JJJ1109
                                                                         JJJ1109
          IF FSEXTFLG[0]     #AND FILE IS PERMANENT#                     JJJ1109
          THEN                                                           JJJ1109
              BEGIN                                                      JJJ1109
 #                                                                       JJJ1109
*     CLEAR RANDOM BIT, CLOSE FILE, MOVE LFN TO STATUS WORD, AND CALL    JJJ1109
*     PFE TO EXTEND THE FILE.  OPEN THE FILE, SET THE RANDOM BIT AND     JJJ1109
*     CLEAR THE EXTEND-NEEDED FLAG.                                      JJJ1109
 #                                                                       JJJ1109
              FESRB[0] = 0;                                              JJJ1109
              CRA1$AA (DCIO,P<FET$AA>,DRCL,CIOCLS);                      JJJ1109
                                                                         JJJ1109
              EXSTATLFN[0] = FELFN;                                      JJJ1109
              CRA1$AA (DPFE,LOC(EXSTATUS),DRCL,DXTND);                   JJJ1109
                                                                         JJJ1109
              CRA1$AA (DCIO,P<FET$AA>,DRCL,CIOOPN);                      JJJ1109
                                                                         JJJ1109
              FESRB[0] =1;                                               JJJ1109
              FEFCSE = 1; 
              FSEXTFLG[0] = FALSE;                                       JJJ1109
              END                                                        JJJ1109
                                                                         JJJ1109
          RETURN;                                                        JJJ1109
                                                                         JJJ1109
          END  #OF EXTNDF#                                               JJJ1109
CONTROL EJECT;                                                           JJJ1109
PROC FLSBLK;                                                             JJJ1109
          BEGIN                                                          JJJ1109
 #                                                                       JJJ1109
* DC1 NAME                                                               JJJ1109
*                                                                        JJJ1109
* C   FLSBLK                                                             JJJ1109
*                                                                        JJJ1109
* DC  FUNCTION                                                           JJJ1109
*                                                                        JJJ1109
*     TO CAUSE AN ALTERED BLOCK FOR A FILE TO BE WRITTEN WITHOUT RECALL  JJJ1109
*     IF THE FET IS NOT BUZY.                                            JJJ1109
*                                                                        JJJ1109
* DC  ENTRY CONDITIONS                                                   JJJ1109
*                                                                        JJJ1109
*     FSTT$AA POINTS TO THE FSTT OF THE FILE.                            JJJ1109
*     FET$AA POINTS TO THE BUZY FET OF THE FILE.                         JJJ1109
*     FSRUINFLG IF SET WILL PREVENT WRITING.
*                                                                        JJJ1109
* DC  EXIT CONDITIONS                                                    JJJ1109
*                                                                        JJJ1109
*     ACTF = P<FET$AA> IF FET WAS BUZY OR IF I/O INITIATED FOR A BLOCK.  JJJ1109
*     LAST BLOCK IS WRITTEN WITH RECALL ON FIRST CALL FOR A FILE.        JJJ1109
*                                                                        JJJ1109
* DC  ERROR CONDITIONS                                                   JJJ1109
*                                                                        JJJ1109
*     WRITE ERRORS WILL CAUSE BLOCK TO BE WRITTEN AT EOI AND SUBSTITUTE  JJJ1109
*     BLOCK NUMBER TO BE ENTERED IN FSBADBLK.                            JJJ1109
*                                                                        JJJ1109
* DC  CALLED ROUTINES                                                    JJJ1109
*                                                                        JJJ1109
*     IOWR$AA - WRITE AN ALTERED BLOCK                                   JJJ1109
*                                                                        JJJ1109
* DC  DESCRIPTION                                                        JJJ1109
*                                                                        JJJ1109
*     IF I/O IN PROGRESS SET ACTF TO BUZY FET.  RETURN.                  JJJ1109
 #                                                                       JJJ1109
CONTROL EJECT;               #START OF FLSBLK CODE#                      JJJ1109
          IF FSRUINFLG[0] 
          THEN
              BEGIN 
              RETURN ;
              END 
          IF FECMPLT[0] EQ 0                                             JJJ1109
          THEN                                                           JJJ1109
              BEGIN                                                      JJJ1109
              ACTF = P<FET$AA>;                                          JJJ1109
              END                                                        JJJ1109
          ELSE                                                           JJJ1109
              BEGIN                                                      JJJ1109
 #                                                                       JJJ1109
*     ENSURE THAT LAST BLOCK IS WRITTEN AND/OR THAT I/O IS COMPLETE.     JJJ1109
*     SCAN BLOCKS FOR FILE TILL END OR UNTIL ALTERED BLOCK FOUND.        JJJ1109
 #                                                                       JJJ1109
              FOR IX = IX WHILE FSUNWR1[0] NQ 0 AND NOT FSRUINFLG[0]
              DO
                  BEGIN 
                  P<BLOK$AA> = FSUNWR1[0] ; 
                  IOWR$AA ( 1 ) ; 
                  END 
                                                                         JJJ1109
              P<BLOK$AA> = P<FSTT$AA>;                                   JJJ1109
              FOR IX = BLKFPTR[0] - DOFFBFCHN WHILE IX NQ P<FSTT$AA>     JJJ1109
                  DO                                                     JJJ1109
                  BEGIN                                                  JJJ1109
                  P<BLOK$AA> = IX;                                       JJJ1109
                  IF BLWIP[0] NQ 0                                       JJJ1118
                  THEN                                                   JJJ1118
                      BEGIN                                              JJJ1118
                      IOWR$AA (1);  #HANDLE ANY WRITE ERRORS#            JJJ1118
                      END                                                JJJ1118
                  IF BLALTFLG[0] NQ 0                                    JJJ1109
                  THEN                                                   JJJ1109
                      BEGIN                                              JJJ1109
 #                                                                       JJJ1109
*     ALTERED BLOCK FOUND.  INITIATE I/O WITHOUT RECALL AND TERMINATE    JJJ1109
*     THE SCAN.                                                          JJJ1109
 #                                                                       JJJ1109
                      IF BLCIP NQ 0 AND BLMIPBLK EQ 0 
                             AND INDEXFLAG EQ 0 
                      THEN
                          BEGIN 
                          FSRUINFLG[0] = TRUE ; 
                          BLALTFLG[0] = 0 ; 
                          GOTO FLSBLKA ;
                      END 
                      IOWR$AA (0);                                       JJJ1109
                                                                         JJJ1109
                      ACTF = P<FET$AA>;                                  JJJ1109
                      IX = P<FSTT$AA>;  #CAUSES FOR LOOP TO TERMINATE#   JJJ1109
                      END                                                JJJ1109
                  ELSE                                                   JJJ1109
                      BEGIN                                              JJJ1109
     FLSBLKA: 
                      IX = BLKFPTR[0] - DOFFBFCHN;                       JJJ1109
                      END                                                JJJ1109
                                                                         JJJ1109
                  END  #OF FOR LOOP#                                     JJJ1109
              END                                                        JJJ1109
                                                                         JJJ1109
          RETURN;                                                        JJJ1109
                                                                         JJJ1109
          END  #OF FLSBLK#                                               JJJ1109
CONTROL EJECT;                                                           JJJ1109
PROC FLSFSTT;                                                            JJJ1109
          BEGIN                                                          JJJ1109
 #                                                                       JJJ1109
* DC1 NAME                                                               JJJ1109
*                                                                        JJJ1109
* C   FLSFSTT                                                            JJJ1109
*                                                                        JJJ1109
* DC  FUNCTION                                                           JJJ1109
*                                                                        JJJ1109
*     TO REWRITE A FILES FSTT,IF PERMITTED, AFTER MAKING IT LOOK LIKE A  JJJ1109
*     CLOSE IS BEING DONE.                                               JJJ1109
*                                                                        JJJ1109
* DC  ENTRY CONDITIONS                                                   JJJ1109
*                                                                        JJJ1109
*     FSTT$AA POINTS TO THE FSTT OF THE FILE                             JJJ1109
*     FET$AA POINTS TO THE BUZY FET OF THE FILE                          JJJ1109
*     FSRUFSTT = 1 IF THE FSTT IS NOT TO BE FLUSHED.
*                                                                        JJJ1109
* DC  EXIT CONDITIONS                                                    JJJ1109
*                                                                        JJJ1109
*     FSTT FIELDS HAVE BEEN SET TO INDICATE FILE SUCCESSFULLY CLOSED.    JJJ1109
*     FSTT WRITE HAS BEEN INITIATED WITHOUT RECALL OR A PREVIOUSLY       JJJ1109
*     INITIATED WRITE HAS BEEN COMPLETED PROPERLY.                       JJJ1109
*                                                                        JJJ1109
* DC  ERROR CONDITIONS                                                   JJJ1109
*                                                                        JJJ1109
*     IF THE WRITE OF THE FSTT FAILS, A FATAL ERROR MESSAGE IS ISSUED ON JJJ1109
*     THE FIT IN FIT$AA.                                                 JJJ1109
*                                                                        JJJ1109
* DC  CALLED ROUTINES                                                    JJJ1109
*                                                                        JJJ1109
*     WTIO$AA - MAKE SURE I/O IS DONE                                    JJJ1109
*     IOWR$AA - INITIATE WRITE OF FSTT                                   CIM0201
*                                                                        JJJ1109
* DC  DESCRIPTIOM                                                        JJJ1109
*                                                                        JJJ1109
*     IF WRITE IN PROGRESS ON FSTT, CALL IOWR$AA WITH RECALL TO HANDLE   JJJ1118
*     ANY ERRORS WHICH MAY HAVE OCCURRED.                                JJJ1118
 #                                                                       JJJ1109
CONTROL EJECT;               #START OF FLSFSTT CODE#                     JJJ1109
          IF FSRUFSTT[0] NQ 0 
          THEN
              BEGIN 
              RETURN ;
              END 
          FS2BLOX[0] = 0 ;                                              003500
          P<BLOK$AA> = P<FSTT$AA>;                                       JJJ1118
          IF BLWIP[0] NQ 0                                               JJJ1118
          THEN                                                           JJJ1118
              BEGIN                                                      JJJ1118
              IOWR$AA (1);   #HANDLE ANY WRITE ERRORS ON THE BLOCK#      JJJ1118
              END                                                        JJJ1109
          ELSE                                                           JJJ1109
              BEGIN                                                      JJJ1109
 #                                                                       JJJ1109
*     IF NOT PERMITTED TO WRITE ON FILE,RETURN.                          JJJ1109
*     ELSE CLEAR FILE NOT PROPERLY CLOSED FLAG, SET LAST CLOSED DATE AND JJJ1109
*     TIME TO NOW.  CALL IOWR$AA TO INITIATE I/O.  RETURN.               JJJ1109
 #                                                                       JJJ1109
              IF FSOPENFLG[0] AND FTMER[0] EQ 7                          GAG0919
              THEN                                                       JJJ1109
                  BEGIN  #PERMISSION REQUIRED IS: MODIFY, EXTEND, READ#  GAG0919
                  FSOPENFLG[0] = FALSE;                                  VBG1115
                  FSALTFLG[0] = 0;
                  SYSTIME ( LOC(FSTERMTIM[0]) );                         VBG1115
                  SYSDATE ( LOC(FSTERMDAT[0]) );                         VBG1115
                                                                         VBG1115
                  IOWR$AA ( -1 ) ;
                                                                         VBG1115
                  ACTF = FSBZFET[0];                                     VBG1115
                  END                                                    JJJ1109
              END                                                        JJJ1109
                                                                         JJJ1109
          RETURN;                                                        JJJ1109
                                                                         JJJ1109
          END  #OF FLSFSTT#                                              JJJ1109
CONTROL EJECT;                                                           JJJ1109
PROC SFLIST (FLSPROC);                                                   JJJ1109
          BEGIN                                                          JJJ1109
 #                                                                       JJJ1109
* DC  NAME                                                               JJJ1109
*                                                                        JJJ1109
* C   SFLIST (FLSPROC)                                                   JJJ1109
*                                                                        JJJ1109
* DC  FUNCTION                                                           JJJ1109
*                                                                        JJJ1109
*     TO SCAN A FIT LIST AND APPLY A PROCEDURE TO ALL FILES AND          JJJ1109
*     ASSOCIATED MIP FILES ON THE LIST IF APPLICABLE.                    JJJ1109
*                                                                        JJJ1109
* DC  ENTRY CONDITIONS                                                   JJJ1109
*                                                                        JJJ1109
*     FFITLST POINTS TO THE FIRST WORD OF THE FIT LIST.                  JJJ1109
*     FLSPROC IS A PROC PASSED AS A FORMAL PARAMETER WHICH IS TO BE      JJJ1109
*     APPLIED TO EACH FILE.  IT MUST SET ACTF NON-ZERO IF SCAN IS TO     JJJ1109
*     GO THROUGH THE LIST MORE THAN ONCE.                                JJJ1109
*                                                                        AM2A099
*     IF THERE IS A MIP FILE, IT HAS BEEN POSITIONED AT LEVEL 1 IF       AM2A099
*     NECESSARY, TO FORCE THE COPYING OF ALTERED SUB-FILE-HEADERS        AM2A099
*     FROM THE FIAT TO THE RECORDS IN WHICH THEY BELONG, IN BLOCKS.      AM2A099
*     AND FAALTPOS HAS BEEN SET TO 1 TO FORCE SEEKS, GETNEXTS, OR        AM2A099
*     GETNEXTS WITHOUT RECALL TO BEGIN AGAIN FROM KEY VALUES,            AM2A099
*     BECAUSE THIS CHANGE IN LEVEL MAY MAKE IT UNSAFE FOR THEM           AM2A099
*     TO RELY ON POSITION ACCORDING TO PTREE ETC.                        AM2A099
*                                                                        JJJ1109
* DC  EXIT CONDITIONS                                                    JJJ1109
*                                                                        JJJ1109
*     PROC HAS BEEN APPLIED TO ALL FILES TILL NOTHING FURTHER NEED BE    JJJ1109
*     DONE.                                                              JJJ1109
*                                                                        JJJ1109
* DC  ERROR CONDITIONS                                                   JJJ1109
*                                                                        JJJ1109
*     NONE                                                               JJJ1109
*                                                                        JJJ1109
* DC  DESCRIPTION                                                        JJJ1109
*                                                                        JJJ1109
 #                                                                       JJJ1109
                                                                         JJJ1109
          FPRC FLSPROC;      #PROC TO BE APPLIED TO FILES IN LIST#       JJJ1109
                                                                         JJJ1109
                                                                         JJJ1109
 #                                                                       JJJ1109
*     CLEAR ACTF.  STEP THRU FITLIST TILL END (0 WORD).                  JJJ1109
 #                                                                       JJJ1109
                                                                         JJJ1109
LOOPLIST: ACTF = 0;                                                      JJJ1109
          FOR I1 = 0 STEP 1 WHILE FFITNAME[I1] NQ 0                      JJJ1109
              DO                                                         JJJ1109
              BEGIN                                                      JJJ1109
 #                                                                       JJJ1109
*     IF FILE IS TO BE IGNORED, PASS IT BY.                              JJJ1109
*     ELSE SET UP FIT$AA.                                                JJJ1109
*     IF FIT IS FOR AN ACTIVE DATA FILE, SET FSTT$AA AND FET$AA.         JJJ1109
*     CALL FLSPROC.  SWITCH TO MIP FSTT AND FET IF ONE EXISTS AND        JJJ1109
*     CALL FLSPROC.                                                      JJJ1109
 #                                                                       JJJ1109
              IF NOT FFITIGNR[I1]  #IS THIS FILE TO BE FLUSHED#          JJJ1109
              THEN                                                       JJJ1109
                  BEGIN                                                  JJJ1109
                  P<FIT$AA> = FFITADDR[I1];                              JJJ1109
                 IF FTLEN[0] EQ FITLNG     #IT IS AN FIT#                AM2A091
                 AND FTFSTT[0] NQ 0        #AND THIS IS AAM2.0 FILE#     AM2A091
                 AND FTFO[0] GQ FO"IS"     #AND IT IS NOT BAM#           AM2A091
                  THEN                                                   JJJ1109
                      BEGIN                                              JJJ1109
                      P<FSTT$AA> = FTFSTT[0];                            JJJ1109
                      IF REPVFLG NQ 0 AND FSLGX NQ 0
                      THEN
                          BEGIN 
                          TEST;  #IGNORE LOGGED FILES ON REPRIEVE#
                          END 
                      P<FET$AA> = FSBZFET[0];                            JJJ1109
                      FLSPROC;  #PERFORM ACTION ON DATA FILE#            JJJ1109
                      IF FSMIPWORD[0] NQ 0 AND FSMIPFSTT[0] NQ 0         JJJ1109
                      THEN                                               JJJ1109
                          BEGIN                                          JJJ1109
                          P<FIAT$AA> = FTFIAT;  #SET UP FOR LEVL$MP #    JJJ0519
                          FAALTPOS[0] = 1 ;                              AM2A099
                          STMD$AA (16);                                  JJJ0519
                          IF CURLEV NQ 1                                 JJJ0519
                          THEN                                           JJJ0519
                              BEGIN                                      JJJ0519
                              LEVL$MP (1);                               JJJ0519
                              END                                        JJJ0519
                          P<FET$AA> = FSBZFET[0];                        JJJ1109
                          FLSPROC;  #PERFORM ACTION ON MIP FILE#         JJJ1109
                          END                                            JJJ1109
                      END                                                JJJ1109
                  END #FOR THIS FILE THIS TIME AROUND#                   JJJ1109
              END  #OF FOR LOOP SEARCHING FIT LIST#                      JJJ1109
 #                                                                       JJJ1109
*     WHEN DONE WITH LOOP, CHECK ACTF.  IF NON-ZERO, WAIT ON IT AND      JJJ1109
*     JUMP BACK TO SCAN LOOP.  ELSE RETURN.                              JJJ1109
 #                                                                       JJJ1109
          IF ACTF NQ 0                                                   JJJ1109
          THEN                                                           JJJ1109
              BEGIN                                                      JJJ1109
              P<FET$AA> = ACTF;                                          JJJ1109
              CRA1$AA (DRCL,P<FET$AA>);                                  JJJ1109
              FSRCLCNT = FSRCLCNT + 1;  # UDPATE RECALL CNT  #
              GOTO LOOPLIST;                                             JJJ1109
                                                                         JJJ1109
              END                                                        JJJ1109
                                                                         JJJ1109
          RETURN;                                                        JJJ1109
                                                                         JJJ1109
          END  #OF SFLIST#                                               JJJ1109
      END  #OF FLSH$AA#                                                  JJJ1109
CONTROL EJECT;                                                           JJJ0913
PROC FRLR$AA;                                                            JJJ0913
          BEGIN                                                          JJJ0913
                                                                         ID0913 
 #                                                                       JJJ0913
* *   FRLR$AA - SET THE FIRST-RECORD AND LAST-RECORD FLAGS      PAGE 1   JJJ0913
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC FRLR$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO SET THE QFR AND QLR FLAGS IN THE PTREE TO 1 IF NECESSARY.       JJJ0913
*     THEY ARE EXPECTED TO BE 0 WHEN FRLR$AA IS CALLED -- THIS ROUTINE   JJJ0913
*     WILL NOT ZERO THEM IF THEY ARE 1 BUT SHOULD NOT BE.                JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THE CURRENT BLOCK AND RECORD, AS DESIGNATED BY THE CURRENT WORD    JJJ0913
*     OF THE PTREE, MUST BE IN CORE.                                     JJJ0913
*                                                                        JJJ0913
*     THE QFR AND QLR FLAGS IN THE PTREE MUST BE 0. THE QEI FLAG WILL    JJJ0913
*     NOT BE TOUCHED, BUT IT IS HARD TO IMAGINE WHY IT WOULD BE ALLOWED  JJJ0913
*     TO BE 1 AT THE TIME OF CALLING FRLR$AA.                            JJJ0913
*                                                                        JJJ0913
*     FOR THE RESULT TO MAKE SENSE, THE CURRENT RECORD NUMBER MUST NOT   JJJ0913
*     BE 0, AND THE CURRENT RECORD MUST BE A LIVE ONE.                   JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     IF WE ARE ON THE FIRST LIVE RECORD OF THE FIRST DATA BLOCK IN      JJJ0913
*     THE FILE OR SUBFILE, QFR = 1 .                                     JJJ0913
*                                                                        JJJ0913
*     IF WE ARE ON THE LAST RECORD OF THE LAST BLOCK IN THE FILE OR      JJJ0913
*     SUBFILE, QLR = 1 .                                                 JJJ0913
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     BCK1$AA - TO SEE IF THE CURRENT RECORD IS THE FIRST LIVE ONE IN    JJJ0913
*       THE CURRENT BLOCK.                                               JJJ0913
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     BACKREC IS USED BY BCK1$AA TO RETURN THE RESULT.                   CY210
*                                                                        JJJ0913
 #                                                                       JJJ0913
                                                                         JJJ0913
                             #START OF FRLR$AA CODE#                     ID0913 
          IF FWD EQ 0 AND PTCUREC[CURPTR] EQ RC THEN QLR = 1 ;           SAAM3
          IF BLOCKID[0] EQ FIRDAT                                        SAAM3
            THEN BEGIN                                                   SAAM3
              BCK1$AA ;                                                  SAAM3
              IF BACKREC EQ 0   THEN QFR = 1;                            SAAM3MO
            END                                                          SAAM3
          END                                                            SAAM3
CONTROL EJECT;                                                           SAAM3MO
PROC GOFI$AA ((WEND)) ;                                                  SAAM3MO
          BEGIN                                                          SAAM3MO
                                                                         ID0913 
 #                                                                       JJJ0913
* *   GOFI$AA - GO TO ONE END OR OTHER OF A FILE OR SUBFILE     PAGE  1  JJJ0916
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC GOFI$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO POSITION US AT THE FIRST  RECORD, OR AT THE LAST RECORD OF      JJJ0913
*     THE CURRENT FILE, OR CURRENT SUBFILE IF THE CURRENT FILE IS MIP.   JJJ0913
*     IF AT THE LAST RECORD, THE QEI FLAG OF THE PTREE IS SET TO         JJJ0913
*     INDICATE AN EOI POSITION, RATHER THAN LAST RECORD.                 JJJ0913
*                                                                        JJJ0913
*     USUALLY CALLED BY DEFS ((GOSTARTFILE)) AND ((GOENDFILE)).          JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THERE IS ONE PARAMETER, PASSED IN THE NORMAL SYMPL WAY.            JJJ0913
*     THIS IS 0 FOR BEGINNING OF FILE, OR 1 FOR END OF FILE              JJJ0913
*                                                                        JJJ0913
*     THE CURRENT FILE MUST HAVE BEEN OPENED ETC.                        JJJ0913
*     IF NOT A MIP FILE, P<PTRE$AA> POINTS TO ITS PTREE.                 JJJ0913
*     IF A MIP FILE, P<PTRE$AA> POINTS TO THE PTREE OF ONE OF ITS        JJJ0913
*     SUBFILES.                                                          JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     1. IF THE FILE IS EMPTY --                                         JJJ0913
*       QFR = 0 , QLR = 0 , QEI = 1.                                     JJJ0913
*       THE FIRST WORD OF THE PTREE INDICATES RECORD 0 OF THE BLOCK      JJJ0913
*       NAMED IN THE FSTT AS PRIMARY INDEX BLOCK. IF THAT NUMBER         JJJ0913
*       IN THE FSTT IS NOT 0, SEBL$AA HAS BEEN CALLED TO LOCATE THE      JJJ0913
*       BLOCK.                                                           JJJ0913
*     2. OTHERWISE, FOR BEGINNING OF FILE --                             JJJ0913
*       QFR = 1 , QEI = 0 , QLR = 0 UNLESS JUST ONE RECORD IN THE FILE.  JJJ0913
*       WE ARE POSITIONED ON THE FIRST LIVE RECORD OF THE FIRST DATA     JJJ0913
*       BLOCK OF THE FILE.                                               JJJ0913
*     3. OTHERWISE, FOR END OF FILE --                                   JJJ0913
*       QFR = 0 , QLR = 0 , QEI = 1.                                     JJJ0913
*       WE ARE POSITIONED ON THE LAST RECORD OF THE LAST DATA BLOCK      JJJ0913
*       OF THE FILE.                                                     JJJ0913
*                                                                        JJJ0913
*     FOR A NON-EMPTY FILE, THE RECORD WE ARE POSITIONED ON IS IN CORE   JJJ0913
*     AND RECFWA, RECLWA, AND RECLG LOCATE IT. HOWEVER, IN AN INDEXED    JJJ0913
*     FILE OR SUBFILE, ONLY THE PTREE WORD FOR THE DATA BLOCK LEVEL IS   JJJ0913
*     PROPERLY SET UP. THE BLOCK NUMBER FIELD OF THE TOP PTREE WORD      JJJ0913
*     WILL HAVE BEEN ZEROED, INDICATING THAT THE WORDS OF THE PTREE      JJJ0913
*     CORRESPONDING TO INDEX BLOCK LEVELS CANNOT BE USED.                JJJ0913
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     SEBL$AA - TO LOCATE THE PRIMARY INDEX BLOCK, IN THE CASE WHEN IT   JJJ0913
*       EXISTS EVEN THOUGH THE FILE RECORD COUNT IS 0.                   JJJ0913
*     DABL$AA - TO LOCATE THE FIRST OR LAST DATA BLOCK OF THE FILE       JJJ0913
*       OR SUBFILE, WHEN THE RECORD COUNT IS NOT 0.                      JJJ0913
*     STPF$AA - TO LOCATE THE FIRST LIVE RECORD OF THE BLOCK, BY         JJJ0913
*       STEPPING FORWARD FROM ((RECORD 0)).                              JJJ0913
*     SETR$AA - TO LOCATE THE LAST RECORD OF THE BLOCK.                  JJJ0913
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     RNO - AT EXIT TIME, WILL CONTAIN THE SAME RECORD NUMBER AS         JJJ0913
*       PTCUREC[CURPTR].                                                 JJJ0913
*                                                                        JJJ0913
 #                                                                       JJJ0913
          ITEM WEND;         #FORMAL PARAM, WHICH END#                   SAAM3MO
          ITEM BN;           #USED TO STORE BLOCK NUM#                   SAAM3MO
                                                                         SAAM3MO
                             #START OF GOFI$AA CODE#                     ID0913 
          QLR = 0 ;                                                      SAAM3
          IF RECCNT EQ 0                                                 SAAM3
            THEN BEGIN                                                   SAAM3
              RNO = 0 ;                                                  SAAM3
              PTCURBLK[0] = PRBK LAN ( 2**24-1 ) ;
              PTCUREC[0] = 0 ;                                           SAAM3
              QFR = 0 ;                                                  SAAM3
              QEI = 1 ;                                                  SAAM3
              IF PRBK NQ 0 THEN SEBL$AA ( 0, 1 ) ;                       SAAM3
              RETURN ;                                                   SAAM3
            END                                                          SAAM3
            ELSE BEGIN                                                   SAAM3
              QFR = 1 - WEND;                                            SAAM3MO
              QEI = WEND;                                                SAAM3MO
            END                                                          SAAM3
          IF RECCNT EQ 1 THEN QLR = QFR ;                                SAAM3
          CURPTR = NLEV ;                                                SAAM3
          PTCUREC = 0 ;                                                  CREATEM
          IF WEND EQ 0                                                   SAAM3MO
            THEN BN = FIRDAT;                                            SAAM3MO
                                                                         SAAM3MO
            ELSE BN = LASTBNO;                                           SAAM3MO
          DABL$AA (BN , 1);                                              SAAM3MO
          IF WEND EQ 0                                                   SAAM3MO
            THEN BEGIN                                                   SAAM3
              PTCUREC[CURPTR] = 0 ;                                      SAAM3
              STPF$AA ;                                                  SAAM3
            END                                                          SAAM3
            ELSE SETR$AA ( RC ) ;                                        SAAM3
          END                                                            SAAM3
CONTROL EJECT;                                                           JJJ0913
PROC HAWK$AA (N);                                                        JJJ0913
          BEGIN                                                          JJJ0913
                                                                         ID0913 
 #                                                                       JJJ0913
* *   HAWK$AA - TO LOOK AT A SPECIFIED BLOCK IN CORE       PAGE  1       JJJ0916
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC HAWK$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO SET P<BLOK$AA> TO THE ADDRESS PASSED AS PARAMETER,              JJJ0913
*     WHICH IS ASSUMED TO BE THE FWA OF A BLOCK PARCEL IN CORE,          JJJ0913
*     AND TO SET BLOCLWA TO WHAT MUST BE THE LWA+1 OF THAT BLOCK,        JJJ0913
*     AS WELL AS TEMPOS AND TEMPLOFF. SEE THE NOTES TO LKEY$AA.          CY210
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THERE IS ONE PARAMETER, PASSED IN THE USUAL SYMPL WAY.             JJJ0913
*     THIS IS AN ADDRESS TO BE STORED IN P<BLOK$AA>. IT MUST BE THE FWA  JJJ0913
*     OF A PARCEL CONTAINING A BLOCK.                                    JJJ0913
*                                                                        JJJ0913
*     P<FSTT$AA> MUST CONTAIN THE FWA OF THE FSTT OF THE FILE TO WHICH   JJJ0913
*     THE BLOCK BELONGS.                                                 JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     NOTHING HAS BEEN CHANGED EXCEPT THAT P<BLOK$AA> AND BLOCLWA        JJJ0913
*     AND TEMPOS AND TEMPLOFF HAVE BEEN SET BY LKEY$AA.                  CY210
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     LKEY$AA , TO DO THE REAL WORK.                                     CY210
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     BLOCLWA, TEMPOS, TEMPLOFF, SET BY LKEY$AA .                        CY210
*                                                                        JJJ0913
 #                                                                       JJJ0913
          ITEM N;            #BLOCK FWA#                                 JJJ0913
                                                                         JJJ0913
                                                                         JJJ0913
          P<BLOK$AA> = N ;                                               SAAM3
          LKEY$AA ; 
          END                                                            SAAM3
CONTROL EJECT;
PROC IMPR$AA;                #IMPOSSIBLE ERROR# 
          BEGIN 
          FSRUINFLG[0] = TRUE ; 
          MSCF$AA(EC507,IMPERR);  #ISSUE FATAL ERROR# 
          GOTO EXIT$AA; 
          END 
CONTROL EJECT;                                                           ID0913 
PROC INCH$AA ( (N) , (M) );                                              ID0913 
          BEGIN                                                          ID0913 
                                                                         ID0913 
 #                                                                       ID0913 
* *   INCH$AA - INSERT A WORD IN A DOUBLY-LINKED CHAIN         PAGE 1    ID0913 
* *   A.F.R.BROWN                                                        ID0913 
* 1DC INCH$AA                                                            ID0913 
*                                                                        ID0913 
* DC  FUNCTION                                                           ID0913 
*                                                                        ID0913 
*     TO INSERT A GIVEN WORD, WHICH IS NOT ALREADY A MEMBER OF A CHAIN,  ID0913 
*     INTO A FORWARD-AND-BACKWARD LINKED CHAIN, IMMEDIATELY AFTER SOME   ID0913 
*     OTHER WORD. THE IDENTITY OF THE CHAIN IS DETERMINED BY THIS OTHER  ID0913 
*     WORD, BECAUSE A WORD CAN BELONG TO ONLY ONE CHAIN AT A TIME.       ID0913 
*                                                                        ID0913 
* DC  ENTRY CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     THERE ARE TWO PARAMETERS, PASSED IN THE NORMAL SYMPL WAY.          ID0913 
*     1. THE ADDRESS OF THE WORD TO BE INSERTED IN THE CHAIN. BITS 0-17  ID0913 
*         OF THIS WORD MUST BE 0, TO SHOW IT IS NOT ALREADY IN A CHAIN.  ID0913 
*     2. THE ADDRESS OF ANOTHER WORD, WHICH IS ALREADY IN A CHAIN,       ID0913 
*         NEXT AFTER WHICH IN THAT CHAIN IS WHERE THE FIRST WORD IS TO   ID0913 
*         BE LINKED IN.                                                  ID0913 
*                                                                        ID0913 
*     BITS 0-17 OF A WORD IN A CHAIN CONTAIN THE ADDRESS OF THE          ID0913 
*     SUCCESSOR WORD IN THE CHAIN, WHILE BITS 18-35 CONTAIN THE ADDRESS  ID0913 
*     OF THE PREDECESSOR WORD. THE CHAIN IS CIRCULAR, AND IS CONSIDERED  ID0913 
*     TO BEGIN AT A STABLE WORD SOMEWHERE THAT MUST NEVER BE DELINKED.   ID0913 
*     WHEN THE CHAIN IS EMPTY, APART FROM THE STABLE WORD, THE TWO       ID0913 
*     POINTERS IN THAT WORD MERELY POINT TO ITSELF.                      ID0913 
*                                                                        ID0913 
* DC  EXIT CONDITIONS                                                    ID0913 
*                                                                        ID0913 
*     THE NEW WORD HAS BEEN LINKED INTO THE CHAIN.                       ID0913 
*                                                                        ID0913 
* DC  ERROR CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     FATAL ERROR, IMPLYING A FAULT IN OUR LOGIC, IF BITS 0-17           ID0913 
*     OF THE NEW WORD ARE NOT 0 AT ENTRY TIME, INDICATING THAT IT IS     ID0913 
*     ALREADY IN A CHAIN.                                                ID0913 
*                                                                        ID0913 
* DC  CALLED ROUTINES                                                    ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
* DC  NON-LOCAL VARIABLES                                                ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
 #                                                                       ID0913 
          ITEM N;            #ADDR OF WORD TO BE INSERTED#               ID0913 
          ITEM M;            #ADDR OF WORD IN CHAIN#                     ID0913 
                                                                         ID0913 
                             #START OF INCH$AA CODE#                     ID0913 
          IF B<42,18>W[N] NQ 0
          THEN
              BEGIN 
              IMPOSSIBLE(CHNERR); 
              END 
          T1 = B<42,18>W[M];                                             ID0913 
          B<42,18>W[M] = N;                                              ID0913 
          B<42,18>W[N] = T1;                                             ID0913 
          B<24,18>W[N] = M;                                              ID0913 
          B<24,18>W[T1] = N;                                             ID0913 
          END                                                            ID0913 
CONTROL EJECT ;                                                          JJJ1116
PROC IOWRITE ( RECALL ) ;                                                JJJ1116
          BEGIN                                                          JJJ1116
                                                                         JJJ1116
 #                                                                       JJJ1116
* *   IOWRITE - WRITE A BLOCK (REWRITER AND/OR WRITER)     PAGE 1        JJJ1116
* *   A.F.R.BROWN                                                        JJJ1116
* 1DC IOWRITE                                                            JJJ1116
*                                                                        JJJ1116
* DC  FUNCTION                                                           JJJ1116
*                                                                        JJJ1116
*     TO ACT AS A MIDDLEMAN BETWEEN IOWR$AA AND CRA1$AA. IOWR$AA IS      JJJ1116
*     RESPONSIBLE FOR STARTING OR COMPLETING BLOCK WRITES, AT EOI OR     JJJ1116
*     NOT, AND DOING REPAIRS IF POSSIBLE, WHICH THEY USUALLY SHOULD      JJJ1116
*     BE. CRA1$AA SETS UP AND ISSUES CIO REQUESTS. FOR A NEW BLOCK       JJJ1116
*     AT EOI, EVEN WITH NO ERRORS, IT MAY TAKE TWO CRA1$AA CALLS.        JJJ1116
*     SUCH A CALL OR PAIR OF CALLS MAY OCCUR AT THREE PLACES, WITH       JJJ1116
*     A SLIGHT DIFFERENCE BETWEEN THEM, IN IOWR$AA -- ONCE FOR           JJJ1116
*     WRITING A BLOCK IN ITS CORRECT POSITION IN THE FILE,               JJJ1116
*     ONCE FOR WRITING A NEW BLOCK IN ITS CORRECT POSITION AT            JJJ1116
*     EOI, AS AN EMERGENCY PRELIMINARY TO REWRITING A BADLY-             JJJ1116
*     WRITTEN BLOCK, AND ONCE FOR REWRITING AT EOI A BADLY-WRITTEN       JJJ1116
*     BLOCK THAT HAS JUST FAILED TO BE WRITTEN PROPERLY IN ITS           JJJ1116
*     OWN POSITION. THE FIRST CASE MAY OR MAY NOT BE DONE WITH           JJJ1116
*     RECALL, AND IT ALLOWS AN ATTEMPT TO REPAIR A BAD WRITE.            JJJ1116
*     THE SECOND AND THIRD CASES MUST BE WITH RECALL, AND NO             JJJ1116
*     REPAIR IS ALLOWED FOR. SO WE SET UP THIS ROUTINE IOWRITE TO        JJJ1116
*     MAKE THE ONE OR TWO CRA1$AA CALLS, AS NECESSARY, AND LET           JJJ1116
*     IOWR$AA EVALUATE THE RESULT EACH TIME.                             JJJ1116
*                                                                        JJJ1116
* DC  ENTRY CONDITIONS                                                   JJJ1116
*                                                                        JJJ1116
*     ESSENTIALLY THE SAME AS FOR IOWR$AA.                               JJJ1116
*                                                                        JJJ1116
* DC  EXIT CONDITIONS                                                    JJJ1116
*                                                                        JJJ1116
*     THE WRITE HAS BEEN INITIATED BY A CALL TO CRA1$AA, WITH OR         JJJ1116
*     WITHOUT RECALL ACCORDING AS THE INCOMING PARAMETER WAS NONZERO     JJJ1116
*     OR ZERO, BUT NORMALLY WTIO$AA HAS NOT BEEN CALLED TO CHECK         JJJ1116
*     FOR COMPLETION.                                                    JJJ1116
*                                                                        JJJ1116
*     BLWIP[0] HAS BEEN SET TO 1.                                        JJJ1116
*     BLCODSTAT[0] HAS BEEN SET TO 0.                                    JJJ1116
*     BLALTFLG[0] HAS BEEN SET TO 0.                                     JJJ1116
*                                                                        JJJ1116
*     IF THE WRITE IS AT LOGICAL EOI, CORRESPONDING TO FSNXTPRU[0],      JJJ1116
*     THE FSUNWR1[0] WILL HAVE BEEN POINTING TO THE BLOCK IMAGE.
*     FSUNWR2[0] HAS BEEN COPIED INTO FSUNWR1[0], AND FSUNWR2[0]
*     HAS BEEN SET TO 0 AFTERWARD. FSNXTPRU[0] HAS BEEN INCREASED 
*     BY THE NUMBER OF PRUS IN A BLOCK OF THIS FILE. FSUNWR1[0] 
*     WILL NOW POINT TO THE FIRST UNWRITTEN BLOCK IMAGE, IF THERE 
*     WERE PREVIOUSLY A FIRST AND A SECOND, OR ELSE WILL CONTAIN
*     ZERO, INDICATING NO UNWRITTEN BLOCK IMAGES. 
*                                                                        JJJ1116
*     FURTHERMORE IF AT LOGICAL EOI, WE DO CALL WTIO$AA TO WAIT FOR      JJJ1116
*     COMPLETION IN ORDER TO SIMPLIFY OUR RECORD-KEEPING.                JJJ1116
*     IF A REWRITER WAS ATTEMPTED, IT MAY HAVE BEEN HALTED BY MEETING    JJJ1116
*     PHYSICAL EOI. THEN WE HAVE TO DO A WRITER TO COMPLETE THE          JJJ1116
*     BLOCK. FOR THIS SECOND WRITE ACTION, WE DO NOT CALL WTIO$AA        JJJ1116
*     BEFORE EXITING, SO IT BECOMES THE LOGICAL EQUIVALENT OF THE        JJJ1116
*     NORMAL SINGLE WRITE ACTION. WHEN THIS HAPPENS, WE SET FLAG         JJJ1116
*     FSEXTFLG[0] IN THE FSTT, SO THAT UNTIL THE NEXT CLOSE ALL          JJJ1116
*     WRITES AT LOGICAL EOI WILL BE DONE BY A WRITER, AND IOWRITE        JJJ1116
*     WILL NOT MEET THE ANOMALOUS CASE.                                  JJJ1116
*                                                                        JJJ1116
*                                                                        JJJ1116
* DC  ERROR CONDITIONS                                                   JJJ1116
*                                                                        JJJ1116
*     FATAL ERROR IF MFET$AA STORES A 0 AS PRU NUMBER IN THE FET.        JJJ1116
*     THIS MUST MEAN THAT THE BLOCK ALREADY APPEARS IN THE FSBADBLK      JJJ1116
*     TABLE, WITH 0 ON THE RIGHT SIDE OF THE ENTRY, MARKING IT AS        JJJ1116
*     AN UNREADABLE BLOCK. HOW IS IT THAT WE HAVE THE IMAGE OF AN        JJJ1116
*     UNREADABLE BLOCK IN CORE.                                          JJJ1116
*                                                                        JJJ1116
* DC  CALLED ROUTINES                                                    JJJ1116
*                                                                        JJJ1116
*     MFET$AA -- TO SET UP THE FET AND CONSULT TABLE FSBADBLK.           JJJ1116
*     CRA1$AA -- TO SET UP AND ISSUE A CIO CALL.                         JJJ1116
*     WTIO$AA -- TO WAIT AND CHECK FOR COMPLETION, IF AT EOI.            JJJ1116
*     CKSM$AA - TO CALCULATE THE CHECKSUM OF THE BLOCK.                  CY210
*     LOG$AA -- TO DO SECOND-PHASE LOGGING (MAKING SURE AN               CY210
*       EARLIER IMAGE OF THE BLOCK HAS BEEN COMPLETELY WRITTEN           CY210
*       TO THE LOG FILE) IF THERE IS TWO-PHASE LOGGING.                  CY210
*                                                                        JJJ1116
* DC  NON-LOCAL VARIABLES                                                JJJ1116
*                                                                        JJJ1116
*     NONE                                                               JJJ1116
*                                                                        JJJ1116
 #                                                                       JJJ1116
                                                                         JJJ1116
                           # START OF IOWRITE CODE #                     JJJ1116
          ITEM RECALL ;         # INCOMING PARAMETER #                   JJJ1116
          ITEM PRUNUM ;         # LOCAL HOLDER FOR REAL PRU NUMBER#      JJJ1116
          ITEM X ;              # LOCAL HOLDER FOR CIO FUNCTION #        JJJ1116
          ITEM XX;           #SOMETHING FOR CIO TO PLAY WITH ON A WRITE# JJJ0503
                                                                         JJJ1116
              MFET$AA ;                                                  SAAM3
              PRUNUM = FEPRUNO[0] ;                                      JJJ1116
              IF PRUNUM EQ 0
              THEN
                  BEGIN 
                  IMPOSSIBLE(IOPRU0); 
                  END 
              IF FSEXTFLG AND PRUNUM EQ FSNXTPRU[0]                      JJJ1116
              THEN                                                       SAAM3
                BEGIN                                                    SAAM3
                X=CIOWRR;    #WRITER#                                    SAAM3
                  FSWRITCNT = FSWRITCNT + 1;  #UPDATE WRITE COUNT#
                FEPRUNO = LOC(XX);                                       JJJ0503
                END                                                      SAAM3
              ELSE                                                       SAAM3
                BEGIN                                                    SAAM3
                X=CIORWR;    #REWRITER#                                  SAAM3
                  FSRWRCNT = FSRWRCNT + 1;    # UPDATE REWRITE COUNT #
                END                                                      SAAM3
              IF FSDFLG[0] NQ 0  #IS DEFERRED LOGGING IN EFFECT#         VBG1109
              THEN                                                       VBG1109
                  BEGIN                                                  VBG1109
                  LOG$AA(1);     #COMPLETE LOGGING FOR THIS BLOCK#       VBG1109
                  END                                                    VBG1109
              IF FSCKSUMFLG OR BLOCKID[0] EQ 1
              THEN
                BEGIN 
                BLCHKSUM[0] = CKSM$AA;
                END 
              CRA1$AA (DCIO, P<FET$AA>, RECALL, X);                      SAAM3MO
              BLWIP[0] = 1 ;                                             SAAM3
              BLALTFLG[0] = 0 ;                                          SAAM3
              BLCODSTAT[0] = 0 ;                                         SAAM3
              IF FSNXTPRU[0] EQ PRUNUM                                   JJJ1116
                THEN BEGIN                                               SAAM3
                  IF FSALTFLG[0] EQ 0 THEN LGFS$AA; 
                  FSNXTPRU[0]=FSNXTPRU[0]+(BLKLNG[0]+2)/64;              VBG0922
                  IF FSUNWR1[0] EQ P<BLOK$AA> 
                    THEN BEGIN
                      FSUNWR1[0] = FSUNWR2[0] ; 
                      FSUNWR2[0] = 0 ;
                    END 
                  IF RECALL LQ 0 AND FSEXTFLG[0] THEN RETURN ;          018100
                  WTIO$AA ;                                              SAAM3
                  IF FEOUT[0] NQ FEIN[0] AND BLCODSTAT[0] EQ O"1235"     RPN0104
                    AND NOT FSEXTFLG[0]                                  SAAM3
                      THEN BEGIN                                         SAAM3
                        FSEXTFLG = TRUE ;                                JJJ1116
                        FEPRUNO = LOC(XX);                               JJJ0503
                        FSWRITCNT = FSWRITCNT + 1;
                        CRA1$AA (DCIO,P<FET$AA>,RECALL,CIOWRR);          JJJ0503
                             #RESTORE BLKLNG WHICH WAS CLOBBERED BY #    JJJ0503
                             #WTIO$AA WHEN REWRITE NOT COMPLETED#        JJJ0503
                        BLKLNG[0] = FELIMIT[0] - FEFIRST[0] - 1 ; 
                        BLCODSTAT[0] = 0 ;                               SAAM3
                      END                                                SAAM3
                END                                                      SAAM3
          END                                                            SAAM3
CONTROL EJECT;                                                           JJJ0916
PROC IOWR$AA (RECALL);                                                   JJJ0916
          BEGIN                                                          JJJ0916
                                                                         JJJ0907
 #                                                                       JJJ0907
* *   IOWR$AA - WRITE A BLOCK (USUALLY)          PAGE  1                 AM2A077
* *   A.F.R.BROWN                                                        JJJ0907
* 1DC     IOWR$AA                                                        JJJ0907
*                                                                        JJJ0907
* DC      FUNCTION                                                       JJJ0907
*                                                                        JJJ0907
*         TO INITIATE OR TERMINATE THE WRITING OF A BLOCK,               JJJ0907
*         OR BOTH, OR OCCASIONALLY NEITHER IF THE FET IS ALREADY         JJJ0907
*         BUSY AND THE CALL TO IOWR$AA IS WITHOUT RECALL                 JJJ0907
*                                                                        JJJ0907
* DC      ENTRY CONDITIONS                                               JJJ0907
*                                                                        JJJ0907
*         1 PARAMETER IN STANDARD LIST, ((RECALL)).                      JJJ0907
*         IF THIS IS NON-ZERO IT MEANS THE BLOCK MUST AT LEAST BEGIN TO  CY210
*         BE WRITTEN BEFORE RETURNING, AND IF WE MUST FIRST              CY210
*         WAIT FOR COMPLETION OF AN EARLIER OPERATION ON THE SAME        JJJ0907
*         FILE, SO BE IT.                                                JJJ0907
*         IF THE PARAMETER IS GREATER THAN 0, THE BLOCK MUST BE          CY210
*         COMPLETELY WRITTEN BEFORE RETURNING. IF LESS THAN 0, IT IS     CY210
*         ENOUGH TO INITIATE A WRITE WITHOUT RECALL.                     CY210
*         IF THE PARAMETER IS 0, THIS PROC NEED ONLY INITIATE            JJJ0907
*         A WRITE-WITHOUT-RECALL, AND IT NEED NOT EVEN DO THAT IF THE    JJJ0907
*         BLOCK IS ALREADY IN WRITE-IN-PROGRESS STATUS, OR IF            JJJ0907
*         THE FET IS ALREADY BUSY.                                       JJJ0907
*                                                                        JJJ0907
*         P<BLOK$AA> MUST BE ALREADY SET TO POINT TO THE BLOCK,          JJJ0907
*         AND ALL OTHER NECESSARY INFORMATION WILL BE OBTAINED FROM      JJJ0907
*         THE BLOCK FRAME.                                               JJJ0907
* 
*         IF FSRUINFLG[0] IS NOT ZERO, THERE HAS ALREADY BEEN A FATAL 
*         ERROR ON THIS FILE, SO NO MORE PHYSICAL WRITING SHOULD
*         BE DONE. INSTEAD, JUST CLEAR BLALTFLG[0] SO THAT THE SPACE CAN
*         BE RELEASED. EXCEPT ON THE FSTT (BLOCKID=1) --
*         ITS WRITING IS FORBIDDEN ONLY BY FSRUFSTT, WHICH IS 
*         CHECKED FOR BEFORE CALLING IOWR$AA .
*                                                                        JJJ0907
* DC      EXIT CONDITIONS                                                JJJ0907
*                                                                        JJJ0907
*         1. WRITSTRT IS SET TO 1 IF A WRITE HAS BEEN INITIATED OR       JJJ0209
*         COMPLETED, OR IF THE BLOCK ALREADY HAS ITS WRITE-IN-PROGRESS   JJJ0907
*         FLAG SET.                                                      JJJ0907
*         OTHERWISE WRITSTRT IS SET TO 0, I.E. WHEN THE RECALL PARAMETER JJJ0209
*         IS 0 ON ENTRY, THE FET IS ALREADY BUSY, AND THIS BLOCK IS NOT  JJJ0907
*         WHAT IT IS BUSY WITH.                                          JJJ0907
*         2. P<FET$AA> WILL HAVE BEEN PRESERVED AND RESTORED.            CY210
*         3. P<FSTT$AA> WILL HAVE BEEN PRESERVED AND RESTORED.           JJJ0907
*         THIS IS BECAUSE WHILE WORKING ON ONE FILE, WE OFTEN            JJJ0907
*         HAVE TO CALL IOWR$AA TO WRITE ON ANOTHER FILE, IN ORDER        JJJ0907
*         TO MAKE ROOM FOR ANOTHER BLOCK. P<FSTT$AA> IN SUCH A CASE      JJJ0907
*         DEFINES THE FILE IN THE FOREGROUND OF ATTENTION.               JJJ0907
*         4. FLAG BLWIP IS SET TO 1 WHEN A WRITE IS INITIATED,           JJJ0907
*         AND TO 0 WHEN A WRITE IS TERMINATED BY CALLING WTIO$AA.        JJJ0907
*         5. WHEN A WRITE IS TERMINATED, BLCODSTAT IS SET TO 0           JJJ0907
*         6. IF THE WRITE IS OF A NEW BLOCK AT THE PHYSICAL END OF       JJJ0907
*         THE FILE, FSNXTPRU IN THE FSTT (PRU NUMBER AT PHYSICAL         JJJ0907
*         EOI, NEGLECTING POSSIBLE GARBAGE AT END) IS INCREASED BY       JJJ0907
*         FSBLKSIZ (NUMBER OF PRU-S IN A BLOCK).                         JJJ0907
*         ALSO FSUNWR2[0] IS COPIED INTO FSUNWR1[0] AND THEN ZEROED.
*         THIS SHOWS THAT THERE IS ONE FEWER BLOCK THAN BEFORE, WAITING 
*         TO BE WRITTEN TO DISK, I.E. 0 OR 1 INSTEAD OF 1 OR 2. 
*         IF NOW 1, FSUNWR1[0] POINTS TO IT, OR IF 0, FSUNWR1[0]=0. 
*         7. IF WRITING AT PHYSICAL EOI IS KNOWN TO HAVE TAKEN PLACE,    JJJ0907
*         FLAG FSEXTFLG IS SET IN THE FSTT. THIS SHOWS THAT THE          JJJ0907
*         FILE MAY HAVE TO BE EXTENDED AT CLOSE TIME, AND ALSO THAT      JJJ0907
*         WRITING AT LOGICAL EOI CAN HEREAFTER BE DONE WITH WRITER       JJJ0907
*         RATHER THAN REWRITER.                                          JJJ0907
*                                                                        JJJ0907
* DC      ERROR CONDITIONS                                               JJJ0907
*                                                                        JJJ0907
*         1. FATAL ERROR IF READ-IN-PROGRESS FLAG IS FOUND TO BE SET     JJJ0907
*         FOR THE BLOCK -- THIS IS A GROSS LOGIC FAULT.                  JJJ0907
*                                                                        JJJ1116
*     2. FATAL ERROR IF WE CHECK WRITE COMPLETION AND FIND THAT THE      JJJ1116
*     RIGHT NUMBER OF WORDS WAS NOT WRITTEN, ON A BLOCK THAT EXTENDED    JJJ1116
*     THE FILE AT EOI (AFTER DOING A WRITER IF NECESSARY.)               JJJ1116
*                                                                        JJJ1116
*     3. OTHERWISE, IF WE CHECK WRITE COMPLETION AND FIND THAT THE       JJJ1116
*     RIGHT NUMBER OF WORDS WAS NOT WRITTEN, OR THAT THE FET STATUS      JJJ1116
*     WAS NOT OCTAL 25 OR 225, WE TRY TO REWRITE THE BLOCK AT THE        JJJ1116
*     NEXT AVAILABLE POSITION, AT EOI, AND TO PUT AN ENTRY INTO          JJJ1116
*     THE FSTT TABLE AT FSBADBLK, GIVING THE SUPPOSED PRU NUMBER         JJJ1116
*     IN THE LEFT HALF, AND THE ACTUAL NEW PRU NUMBER IN THE RIGHT       JJJ1116
*     HALF. THE BLOCK WILL STILL BE ((KNOWN)) EVERYWHERE BY ITS          JJJ1116
*     SUPPOSED PRU NUMBER, BUT MFET$AA, WHEN PREPARING AN FET TO         JJJ1116
*     READ OR REWRITE THE BLOCK, WILL SCAN TABLE FSBADBLK AND MAKE       JJJ1116
*     THE SUBSTITUTION IN THE FET IF NECESSARY AT THE LAST MINUTE.       JJJ1116
*                                                                        JJJ1116
*     3A. IF THERE IS ALREADY A BLOCK IN CORE, WAITING TO BE WRITTEN     JJJ1116
*     FOR THE FIRST TIME AT EOI, THIS IS DONE BEFORE STEP 3. ABOVE.      JJJ1116
*     IF THIS BLOCK WAITING TO BE WRITTEN FOR THE FIRST TIME HAS TO      JJJ1116
*     BE WRITTEN FOR THIS REASON, AND THE WRITE GIVES AN ERROR, IT       JJJ1116
*     IS A FATAL ERROR BECAUSE IT IS TOO COMPLICATED TO HAVE TWO         JJJ1116
*     BAD BLOCKS IN HAND AT ONCE, BOTH NEEDING TO BE WRITTEN OUT AT      JJJ1116
*     SUBSTITUTE POSITIONS.                                              JJJ1116
*                                                                        JJJ1116
*     3B. IF A BLOCK ALREADY APPEARS IN TABLE FSBADBLK, AND NOW GIVES    JJJ1116
*     US A WRITE TROUBLE AT ITS NEW LOCATION, WHERE IT MUST HAVE BEEN    JJJ1116
*     SUCCESSFULLY WRITTEN AT SOME TIME IN THE PAST, WE SET THE RIGHT    JJJ1116
*     HALF OF THE FSBADBLK WORD TO 0, INDICATING THAT THE BLOCK CAN      JJJ1116
*     NO LONGER BE READ CORRECTLY. THE COPY STILL IN CORE CAN BE USED    JJJ1116
*     AS LONG AS IT HAPPENS TO SURVIVE, BUT WE ABANDON THE EFFORT TO     JJJ1116
*     HAVE A CORRECT COPY ON DISK.                                       JJJ1116
*                                                                        CY210
*     3C. IF THE BLOCK IS THE FSTT, FATAL ERROR.                         CY210
*                                                                        CY210
*     3D. IF FSRUINFLG[0] = 1, WE MUST BE FLUSHING A RUINED FILE,        CY210
*     SO DO NOTHING FURTHER ABOUT WRITING THIS BLOCK.                    CY210
*                                                                        CY210
*     THUS EITHER WE OVERCOME A BAD WRITE BY USING A DIFFERENT BLOCK     CY210
*     FURTHER DOWN THE FILE, OR WE HAVE TO TREAT IT AS A FATAL ERROR.    CY210
*     IF A FATAL ERROR, CALL WTERR. IF WE ARE ALREADY FLUSHING, 
*     WTERR WILL RETURN NORMALLY AND WE GO TO IOWRAX TO EXIT IOWR$AA. 
*     IF NOT FLUSHING, WTERR WILL NOT RETURN, BUT WILL CALL 
*     FLSH$AA AND THEN BRANCH TO EXIT$AA. 
*                                                                        JJJ0907
*     IN ANY FATAL ERROR CASE, WE CALL MSGF$AA AND THEN EXIT TO EXIT$AA 
*     IF THE CURRENT VALUE IN FSTT$AA, WHICH DEFINES THE FILE IDENTITY, 
*     THE SAME AS EITHER OF THE POSSIBLE FSTT POINTERS IN THE FIT, I.E. 
*     IF THE FILE WITH THE FATAL ERROR BELONGS TO THE CURRENT OPERATION.
*     OTHERWISE THE ERROR NUMBER IS JUST STORED IN THE FSFTERR WORD OF
*     THE CURRENT FSTT, AND ALSO OF ITS PARTNER FSTT, IF IT IS ONE OF A 
*     DATA FILE / MIP FILE PAIR.
* 
* DC      CALLED ROUTINES                                                JJJ0907
*                                                                        JJJ0907
*         WTIO$AA - TO WAIT FOR COMPLETION ON THIS WRITE, OR             JJJ0907
*            A PRECEDING ONE.                                            JJJ0907
*     CHECKWRT -- TO CHECK THE GOODNESS OF A WRITE.                      JJJ1116
*     SCANBAD -- TO FIND AN EMPTY SLOT IN TABLE FSBADBLK TO RECORD       JJJ1116
*       A BAD BLOCK, AND WHERE ITS GOOD COPY IS.                         JJJ1116
*     IOWRITE -- TO DO AN ORDINARY WRITE OR A REWRITE OF A BLOCK THAT    JJJ1116
*       COULDNT BE WRITTEN AT ITS PROPER POSITION.                       JJJ1116
*     WTERR - TO ISSUE ERROR MESSAGES.
*                                                                        JJJ0907
* DC      NON-LOCAL VARIABLES                                            JJJ0907
*                                                                        JJJ0907
*         WRITSTRT -- SET 0 OR 1 AS EXPLAINED ABOVE.                     JJJ0209
*         BBLKORD IS USED SCANBAD TO PASS BACK A RESULT.                 CY210
*                                                                        JJJ0907
 #                                                                       JJJ0907
                                                                         JJJ0907
CONTROL EJECT;               #START OF IOWR$AA CODE#                     JJJ0916
          ITEM RECALL;       #0 = I/O WITHOUT RECALL#                    JJJ0916
          ITEM FFF , FF2;    #FSTT AND FET ADDR#                         JJJ0131
          ITEM X , GGG , HHH ;      #LOCAL TEMP#                         JJJ1116
                                                                         JJJ0916
                                                                         JJJ0916
          IF RECALL EQ 0
              AND P<BLOK$AA> EQ FSUNWR2[BLFSTTADR[0]-P<FSTT$AA>]
            THEN BEGIN
              WRITSTRT = 0 ;
              RETURN ;
            END 
          FFF = P<FSTT$AA> ;                                             SAAM3
          FF2 = P<FET$AA>;                                               JJJ0131
          P<FSTT$AA> = BLFSTTADR[0] ;                                    SAAM3
          P<FET$AA> = FSBZFET[0] ;                                       SAAM3
          IF FSRUINFLG[0] AND BLOCKID[0] NQ 1 
          THEN
              BEGIN 
              BLALTFLG[0] = 0 ; 
              GOTO IOWRAX ; 
              END 
          WRITSTRT = 1;      #ASSUME WE CAN DO SOMETHING#                JJJ0209
          IF BLRIP NQ 0 
          THEN
              BEGIN 
              IMPOSSIBLE(ALTRIP);  #*** IMPOSSIBLE ***# 
              END 
          IF BLWIP[0] EQ 0                                               SAAM3
            THEN BEGIN                                                   SAAM3
              IF FECMPLT[0] EQ 0 AND RECALL EQ 0                         SAAM3
                THEN BEGIN                                               SAAM3
                  WRITSTRT = 0;                                          JJJ0209
                  GOTO IOWRAX ;                                          SAAM3
                END                                                      SAAM3
              IF FEFCSE[0] NQ 1                                          JJJ0216
              THEN                                                       JJJ0216
                  BEGIN                                                  JJJ0216
                  WTIO$AA ;                                              JJJ0216
                  END                                                    JJJ0216
              IF P<BLOK$AA> EQ FSUNWR2[0] THEN WRATEOI ;
              IOWRITE ( RECALL ) ;                                       JJJ1116
            END                                                          JJJ1116
            ELSE IF BLCODSTAT[0] NQ 0 THEN GOTO IOWRAB ;                 JJJ1116
          IF RECALL LQ 0 THEN GOTO IOWRAX ; 
          WTIO$AA ;                                                      JJJ1116
 IOWRAB:  
          X = CHECKWRT ;
          IF X NQ 0 
            THEN BEGIN                                                   JJJ1116
              WTIO$AA ;                                                  JJJ1116
              IF X LAN O"37000" EQ O"10000" 
                THEN BEGIN
                  ENUM = EC720 ; #DEVICE CAPACITY EXCEEDED# 
                  GOTO IOWRB ;
                END 
              IF BLPRUFAKE[0] NQ 0                                       JJJ1116
                THEN BEGIN                                               JJJ1116
                  SCANBAD ( BLOCKID[0] ) ;                               JJJ1116
                  IF BBLKORD GQ 0 
                  THEN
                      BEGIN 
                      B<30,30>FSBADBLK[BBLKORD] = 0;
                      END 
                  ENUM = EC136 ;
                  GOTO IOWRB ;
                END                                                      JJJ1116
              IF FSRUINFLG[0] 
              THEN
                  BEGIN 
                  GOTO IOWRAX ; 
                  END 
              IF BLOCKID[0] EQ 1
              THEN
                  BEGIN 
                  FSRUINFLG[0] = TRUE ; 
                  FSRUFSTT[0] = 1 ; 
                  MSGF$AA ( EC136 ) ; #BAD WRITE ON FSTT# 
                  IF FLSHFLG EQ 0 
                  THEN
                      BEGIN 
                      GOTO EXIT$AA ;
                      END 
                  ELSE
                      BEGIN 
                      GOTO IOWRAX ; 
                      END 
                  END 
              SCANBAD ( 0 ) ; 
              IF BBLKORD LS 0 
              THEN
                  BEGIN 
                  ENUM = EC136 ; #FSBADBLK FULL#
 IOWRB: 
                  WTERR ( ENUM ) ;
                  GOTO IOWRAX ; 
                  END 
              IF BLXTEND[0] NQ 0                                        017900
                AND BLKLNG[0] NQ ( 64*FSBLKSIZ[0] - 2 )                  JJJ1116
                  THEN BEGIN
                    ENUM = EC136 ; #BAD WRITE AT EOI# 
 IOWRC: 
                    WTERRB ( ENUM ) ; 
                    GOTO IOWRAX ; 
                  END 
              B<0,30>FSBADBLK[BBLKORD] = BLOCKID[0];
              BLPRUFAKE[0] = 1 ;                                         JJJ1116
              FOR HHH = BBLKORD WHILE FSUNWR1[0] NQ 0 DO WRATEOI ;
              BBLKORD = HHH ; 
              B<30,30>FSBADBLK[BBLKORD] = FSNXTPRU[0];
              IF FWD EQ FSNXTPRU[0] THEN FWD = FSNXTPRU[0]+FSBLKSIZ[0] ; JJJ1116
                #FWD MIGHT HAVE BEEN SET IN ADVANCE BY SPLT$IS#          JJJ1116
              IOWRITE ( 1 ) ;                                            JJJ1116
              WTIO$AA ;                                                  JJJ1116
              IF CHECKWRT NQ 0
              THEN
                  BEGIN 
                  ENUM = EC136 ; #BAD WRITE OF SUBSTITUTE BLOCK#
                  GOTO IOWRC ;
                  END 
            END                                                          JJJ1116
                                                                         JJJ1116
       IOWRAX: P<FSTT$AA> = FFF ;                                        JJJ1116
          P<FET$AA> = FF2;                                               JJJ0131
          END                                                            JJJ1116
                                                                         AFB0204
CONTROL EJECT;
PROC LGFS$AA; 
          BEGIN 
  
          ITEM TBLK;
  
          IF FSLGX[0] NQ 0
            THEN BEGIN
              TBLK = P<BLOK$AA>;
              P<BLOK$AA> = P<FSTT$AA>;
              BLCHKSUM = CKSM$AA; 
              LOG$AA (0); 
              P<BLOK$AA> = TBLK;
            END 
          FSALTFLG[0] = 1;
          END 
CONTROL EJECT;
PROC LKEY$AA;                                                            CY210
          BEGIN                                                          CY210
 #                                                                       CY210
* *   LKEY$AA -- SET BLOCLWA, TEMPOS, AND TEMPLOFF        PAGE 1         CY210
* *   A.F.R.BROWN                                                        CY210
* 1DC LKEY$AA                                                            CY210
*                                                                        CY210
* DC  FUNCTION                                                           CY210
*                                                                        CY210
*     TO SET BLOCLWA, TEMPOS, AND TEMPLOFF FOR THE CURRENT BLOCK,        CY210
*     NORMALLY JUST AFTER P<BLOK$AA> HAS BEEN SET.                       CY210
*                                                                        CY210
* DC  ENTRY CONDITIONS                                                   CY210
*                                                                        CY210
*     P<BLOK$AA> IS THE FWA OF THE BLOCK.                                CY210
*     BLKLNG[0], ALIAS BLKLG, IS A FIELD IN THE BLOCK PREFIX AND         CY210
*       CONTAINS THE LENGTH OF THE BLOCK PROPER (I.E. THE LENGTH         CY210
*       OF THE BLOCK ON DISK) IN WORDS. THEREFORE THE BLOCK MUST         CY210
*       ALREADY HAVE BEEN FULLY READ AND ITS READING CHECKED.            CY210
*     TOMPLEFF AND TOMPES GIVE THE DISTANCE IN WORDS AND CHARACTERS      CY210
*       BETWEEN THE START OF ANY RECORD IN A DATA BLOCK OF THIS FILE,    CY210
*       AND THE START OF THE KEY. (IF THERE IS COMPRESSION IN THIS       CY210
*       FILE, BOTH OF THESE ARE 0).                                      CY210
*                                                                        CY210
* DC  EXIT CONDITIONS                                                    CY210
*                                                                        CY210
*     BLOCLWA IS THE LWA+1 OF THE BLOCK.                                 CY210
*                                                                        CY210
*     TEMPLOFF AND TEMPOS GIVE THE DISTANCE IN WORDS AND CHARACTERS      CY210
*       BETWEEN THE START OF ANY RECORD IN THIS BLOCK, AND THE START     CY210
*       OF THE KEY.                                                      CY210
*                                                                        CY210
* DC  ERROR CONDITIONS                                                   CY210
*                                                                        CY210
*     NONE                                                               CY210
*                                                                        CY210
* DC  CALLED ROUTINES                                                    CY210
*                                                                        CY210
*     NONE                                                               CY210
*                                                                        CY210
 #                                                                       CY210
          BLOCLWA = P<BLOK$AA> + BLKLG + DBLKFRAME ;
          IF INDEXFLAG EQ 0 
            THEN BEGIN
              TEMPOS = TOMPES ; 
              TEMPLOFF = TOMPLEFF ; 
            END 
            ELSE BEGIN
              TEMPOS = 0 ;
              TEMPLOFF = 0 ;
            END 
          END                                                            SAAM3
CONTROL EJECT;                                                           JJJ0209
PROC LOCB$AA (PRU , RR);                                                 JJJ0209
          BEGIN                                                          JJJ0209
 #                                                                       JJJ0209
* *   LOCB$AA - LOCATE A BLOCK IMAGE BY PRU NUMBER            PAGE 1     JJJ0209
* *   A.F.R.BROWN                                                        JJJ0209
* 1DC LOCB$AA                                                            JJJ0209
*                                                                        JJJ0209
* DC  FUNCTION                                                           JJJ0209
*                                                                        JJJ0209
*     TO FIND, IN CORE, THE PARCEL CONTAINING A BLOCK WITH A GIVEN       JJJ0209
*     STARTING PRU NUMBER, IN THE CURRENT FILE. TO READ IN THE BLOCK     JJJ0209
*     FROM DISK, IF NECESSARY, AND TO DO THE MEMORY MANAGEMENT           JJJ0209
*     REQUIRED TO MAKE SPACE FOR READING IT IN. ALSO, TO FIND SPACE      JJJ0209
*     FOR A BLOCK THAT DOES NOT YET EXIST ON DISK.                       JJJ0209
*                                                                        JJJ0209
* DC  ENTRY CONDITIONS                                                   JJJ0209
*                                                                        JJJ0209
*     THERE ARE TWO PARAMETERS, PASSED IN THE ORDINARY SYMPL WAY.        JJJ0209
*       1. A PRU NUMBER, OR 0. IF NOT 0, IT MUST BE THE PRU NUMBER       JJJ0209
*        AT THE BEGINNING OF SOME EXISTING BLOCK OF THE CURRENT FILE.    JJJ0209
*        IF THE NUMBER IS TOO LARGE FOR THE EXISTING FILE, THIS ERROR    JJJ0209
*        WILL BE CAUGHT. BUT IF, SAY, IT POINTS TO THE MIDDLE OF A       JJJ0209
*        BLOCK RATHER THAN THE BEGINNING, THE ERROR WILL NOT BE CAUGHT.  JJJ0209
*                                                                        JJJ0209
*        IF THE NUMBER IS 0, IT MEANS WE WANT A NEW PARCEL, OF THE       JJJ0209
*        RIGHT SIZE TO HOLD A BLOCK FROM THE CURRENT FILE, BUT NOTHING   JJJ0209
*        IS TO BE READ INTO IT.                                          JJJ0209
*                                                                        JJJ0209
*        BECAUSE AN ERRONEOUS PARAMETER IS OFTEN 0 BY ACCIDENT, A 0      JJJ0209
*        AS FIRST PARAMETER MUST BE CONFIRMED BY -1 AS THE SECOND        JJJ0209
*        PARAMETER. OTHERWISE AN ERROR.                                  JJJ0209
*                                                                        JJJ0209
*       2. THE SECOND PARAMETER, APART FROM THE CASE NOTED JUST ABOVE,   JJJ0209
*        IS A RECALL PARAMETER FOR WHEN THE BLOCK IS NOT ALREADY IN CORE JJJ0209
*        AND HAS TO BE READ FROM DISK. IF IT IS NOT 0, LOCB$AA WILL NOT  JJJ0209
*        NORMALLY EXIT UNTIL THE BLOCK HAS BEEN COMPLETELY READ.         JJJ0209
*        IF THE PARAMETER IS 0, THEN IF LOCB$AA FINDS THE BLOCK IS NOT   JJJ0209
*        ALREADY IN CORE, IT WILL (A) DO NOTHING AT ALL IF THE FET IS    JJJ0209
*        ALREADY BUSY, OR (B) START A READ WITHOUT RECALL, BUT NOT       JJJ0209
*        WAIT FOR COMPLETION.                                            JJJ0209
*                                                                        JJJ0209
*     P<FSTT$AA> MUST POINT TO THE FSTT OF THE CURRENT FILE.             JJJ0209
*                                                                        JJJ0209
* DC  EXIT CONDITIONS                                                    JJJ0209
*                                                                        JJJ0209
*     P<BLOK$AA> MAY BE GREATER THAN ZERO, ZERO, OR NEGATIVE.            JJJ0209
*                                                                        JJJ0209
*     WHEN IT IS 0, THE FIRST INCOMING PARAMETER MUST HAVE BEEN          JJJ0209
*     NON-ZERO, AND THE SECOND 0. THE WANTED BLOCK WAS NOT ALREADY       JJJ0209
*     IN CORE, AND THE FET THAT WOULD HAVE TO BE USED FOR READING        JJJ0209
*     IT WAS ALREADY BUSY, SO NOTHING WHATEVER HAS BEEN DONE.            JJJ0209
*                                                                        JJJ0209
*     WHEN IT IS GREATER THAN ZERO, IT CONTAINS THE ADDRESS OF THE       JJJ0209
*     BLOCK PARCEL. IF BOTH INCOMING PARAMETERS WERE NON-ZERO, THEN      JJJ0209
*     THE BLOCK WAS ALREADY IN THE PARCEL, OR HAS BEEN SUCCESSFULLY      JJJ0209
*     READ IN. IF THE FIRST PARAMETER WAS NON-ZERO BUT THE SECOND WAS    JJJ0209
*     ZERO, THE BLOCK MAY STILL BE A-READING. THIS CAN BE CHECKED        JJJ0209
*     BY LOOKING AT THE BLRIP[0] FLAG IN THE BLOCK FRAME -- IF IT IS     JJJ0209
*     0, THEN THE BLOCK IS IN ALL RIGHT. IF NON-ZERO, IT IS STILL        JJJ0209
*     COMING. BUT NORMALLY ANY ROUTINE THAT CALLS LOCB$AA WITH 0 RECALL  JJJ0209
*     JUST WANTS TO GET THE READ MOVING, AND IS NOT INTERESTED           JJJ0209
*     IN THE QUESTION OF COMPLETION.                                     JJJ0209
*                                                                        JJJ0209
*     WHEN IT IS NEGATIVE, IT IS THE BLOCK PARCEL ADDRESS WITH SIGN      JJJ0209
*     REVERSED. THE BLOCK HAS BEEN READ FROM DISK, BUT EITHER THERE      JJJ0209
*     WAS AN ERROR STATUS IN THE FET, OR THE CHECKSUM WAS BAD,           JJJ0209
*     OR THE LENGTH OF THE BLOCK WAS WRONG.                              JJJ0209
*                                                                        JJJ0209
*     THE FET CODE-AND-STATUS, IF IT WAS BAD, HAS BEEN COPIED INTO THE   JJJ0209
*     BLCODSTAT[0] FIELD OF THE BLOCK FRAME. IF IT WAS GOOD, THAT FIELD  JJJ0209
*     IS NOW 0. THE BLOCK LENGTH IN WORDS, AS READ, HAS BEEN INSERTED    JJJ0209
*     INTO THE BLKLNG[0] FIELD OF THE BLOCK FRAME. IF EITHER OF THOSE    JJJ0209
*     IS BAD, THEN THE CHECKSUM HAS NOT BEEN VERIFIED IN ANY CASE. BUT   JJJ0209
*     IF THEY ARE BOTH GOOD, NEGATIVE P<BLOK$AA> MUST MEAN               JJJ0209
*     A BAD CHECKSUM.                                                    JJJ0209
*                                                                        JJJ0209
*     AT ANY RATE, THE ROUTINE THAT CALLS LOCB$AA FOR A FILE BLOCK       JJJ0209
*     HAS TO BE PREPARED FOR A BAD READ. LOCB$AA DOES NOT TAKE ANY       JJJ0209
*     CORRECTIVE ACTION. THIS IS IN CONTRAST TO THE SITUATION IN         JJJ0209
*     WRITING, WHERE THE INNER WRITE ROUTINE TAKES CORRECTIVE ACTION.    JJJ0209
*     IN THEORY ONE CAN ALWAYS SOLVE A WRITE PROBLEM BY GOING SOMEWHERE  JJJ0209
*     ELSE ON THE DISK, BUT A READ PROBLEM CANNOT BE EVADED, AND         JJJ0209
*     DIFFERENT CALLERS WILL HAVE DIFFERENT WAYS OF FACING IT.           JJJ0209
*                                                                        JJJ0209
*     ALL THE FIELDS OF THE BLOCK FRAME HAVE BEEN CORRECTLY SET, OR      JJJ0209
*     LEFT UNCHANGED, AS APPROPRIATE.                                    JJJ0209
*                                                                        JJJ0209
* DC  ERROR CONDITIONS                                                   JJJ0209
*                                                                        JJJ0209
*     FATAL ERROR IF THE FIRST INCOMING PARAMETER IS 0 BUT THE           CY210
*     SECOND IS NOT -1. THIS COULD BE A FLAW IN OUR LOGIC, BUT IT        JJJ0209
*     COULD ALSO BE A SUPPOSED PRU NUMBER TAKEN FROM A SUPPOSED INDEX    JJJ0209
*     RECORD IN A BAD FILE.                                              JJJ0209
*                                                                        JJJ0209
*     THE SAME IF THE FIRST INCOMING PARAMETER IS TOO LARGE TO BE        JJJ0209
*     A PRU NUMBER IN THE FILE AS IT STANDS.                             JJJ0209
*                                                                        JJJ0209
*     FATAL ERROR, A FAULT IN OUR LOGIC, IF THE UBSFREE[0] FIELD OF      JJJ0209
*     THE FSTT IS NON-0, SHOWING THERE SHOULD BE A FREE BUFFER IN THE    JJJ0209
*     USER BUFFER SPACE, BUT A TOUR OF THE CHAIN OF PARCELS BELONGING    JJJ0209
*     TO THIS FILE DOES NOT FIND A FREE ONE.                             JJJ0209
*                                                                        JJJ0209
*     FATAL ERROR, ALSO A LOGIC FAULT, IF WE CALL RESP$AA TO RELEASE     JJJ0209
*     SOME SPACE BEFORE WE ASK FOR A NEW BLOCK PARCEL, AND RESP$AA       JJJ0209
*     CANNOT RELEASE ENOUGH.                                             JJJ0209
*                                                                        JJJ0209
* DC  CALLED ROUTINES                                                    JJJ0209
*                                                                        JJJ0209
*     RESP$AA - TO RELEASE SOME SPACE BEFORE ASKING CMM FOR MORE,        JJJ0209
*       BECAUSE WE TRY TO KEEP OUR CMM SPACE DEBT DOWN TO A TARGET.      JJJ0209
*       RESP$AA MAY JUST RE-ASSIGN AN EXISTING BLOCK OF THIS FILE.       CY210
*       P<BLOK$AA> IS ZEROED BEFORE CALLING RESP$AA. IF IT IS            CY210
*       NON-ZERO ON EXIT, IT IS THE FWA OF A RE-ASSIGNED BLOCK,          CY210
*       AND GCMM$AA NEED NOT BE CALLED.                                  CY210
*     GCMM$AA - TO ASK CMM FOR A NEW BLOCK PARCEL.                       JJJ0209
*     WTIO$AA - TO WAIT FOR COMPLETION, IF THE WANTED BLOCK IS IN        JJJ0209
*       COURSE OF BEING READ, AND THE SECOND INCOMING PARAMETER          JJJ0209
*       WAS NON-ZERO.                                                    JJJ0209
*     INCH$AA - TO LINK THE BLOCK AT THE HEAD OF THE KICKOUT CHAIN.      JJJ0209
*       EVEN A NON-CMM BLOCK GOES THERE, THOUGH IT NEVER REALLY          JJJ0209
*       GETS KICKED OUT IN THE SENSE OF RETURNED TO A GENERAL POOL.      JJJ0209
*       ALSO, FOR A NEW CMM BLOCK, TO LINK IT INTO THE CHAIN OF BLOCKS   JJJ0209
*       BELONGING TO THE SAME FILE.                                      JJJ0209
*     MFET$AA - TO SET THE FET POINTERS AND PRU NUMBER                   JJJ0209
*     CRA1$AA - TO CALL CIO FOR THE READ.                                JJJ0209
*     CKSM$AA - TO CHECKSUM A BLOCK.                                     JJJ0209
*     RJUV$AA - TO MOVE THE BLOCK TO THE HEAD OF THE KICK-OUT CHAIN,     JJJ0209
*       IF IT IS AN OLD BLOCK, AND EVEN IF IT WAS A NEW BLOCK JUST       JJJ0209
*       LINKED IN BY INCH$AA.                                            JJJ0209
*     BLOKINIT - FOR A NEW BLOCK PARCEL, TO INITIALIZE THE 3             CY210
*       WORDS OF BLOCK FRAME AT THE BEGINNING.                           CY210
*     MXPR$AA - TO REPORT WHAT IS THE HIGHEST POSSIBLE PRU NUMBER.
*                                                                        JJJ0209
* DC  NON-LOCAL VARIABLES                                                JJJ0209
*                                                                        JJJ0209
*     RUNTOTCM - A RUNNING TOTAL OF THE LENGTH IN WORDS OF ALL THE       JJJ0209
*       PARCELS WE CURRENTLY HAVE ON LOAN FROM CMM, EXCLUDING THOSE      JJJ0209
*       WE EXPECT TO KEEP FIRM UNTIL CLOSE TIME -- I.E. INCLUDING        JJJ0209
*       ALL THE CMM BLOCK PARCELS EXCEPT THOSE HOLDING FSTT-S.           JJJ0209
*     TARGET - A TARGET FIGURE, RECALCULATED EVERY TIME A FILE IS        JJJ0209
*       OPENED OR CLOSED, WHICH WE TRY TO KEEP RUNTOTCM FROM EXCEEDING.  JJJ0209
*     BFCHNHD - A WORD THAT ACTS AS THE FIXED POINT OF THE KICKOUT       JJJ0209
*       CHAIN. SEE THE COMMENTS ON INCH$AA AND UNCH$AA.                  JJJ0209
*     T1 - SCRATCH                                                       CY210
*                                                                        JJJ0209
 #                                                                       JJJ0209
CONTROL EJECT;                                                           JJJ0209
          ITEM PRU , RR;            #FORMALS#                            JJJ0209
          ITEM XX , YY;             #TEMPORARIES#                        JJJ0209
          IF PRU GQ MXPR$AA OR ( PRU EQ 0 AND RR NQ -1 )
          THEN
              BEGIN 
              FSRUINFLG[0] = TRUE ; 
              MSGF$AA ( EC547 ) ; #IMPOSSIBLE PRU NUMBER# 
              GOTO EXIT$AA ;
              END 
          P<FET$AA> = FSBZFET[0] ;                                       AFB0131
          IF PRU NQ 0                                                    SAAM3
            THEN BEGIN #IS IT ALREADY IN CORE#                           SAAM3
              P<BLOK$AA> = LOC(FSBCHNH[0]) - 1 ;                         SAAM3
              FOR XX = BLKFPTR[0]-1 WHILE XX NQ LOC(FSBCHNH[0])-1        SAAM3
                DO BEGIN                                                 SAAM3
                  P<BLOK$AA> = XX ;                                      SAAM3
                  XX = BLKFPTR[0] - 1 ;                                  SAAM3
                  IF BLOCKID[0] EQ PRU THEN GOTO LOCBAB ;                SAAM3
                END                                                      SAAM3
              IF RR EQ 0 AND FECMPLT[0] EQ 0                             SAAM3
                THEN BEGIN                                               SAAM3
       LOCBAG:    P<BLOK$AA> = 0 ; #NOTHING ACHIEVED#                    SAAM3
                  RETURN ;                                               SAAM3
                END                                                      SAAM3
            END                                                          SAAM3
          IF FSBUFFREE[0] NQ 0   #NOT ALREADY IN CORE#                   SAAM3MO
            THEN BEGIN                                                   SAAM3
LOCBAC:       FSBUFFREE[0] = FSBUFFREE[0] - 1;                           SAAM3MO
              P<BLOK$AA> = LOC(FSBCHNH[0]) - 1 ;                         SAAM3
              FOR XX = BLKFPTR[0]-1 WHILE XX NQ LOC(FSBCHNH[0])-1        SAAM3
                DO BEGIN                                                 SAAM3
                  P<BLOK$AA> = XX ;                                      SAAM3
                  XX = BLKFPTR[0] - 1 ;                                  SAAM3
                  IF BLUBSFLG[0] NQ 0 AND BLOCKID[0] EQ 0                SAAM3
                    THEN GOTO LOCBAD ;                                   SAAM3
                END                                                      SAAM3
              IMPOSSIBLE(UBSCNT); #UBS COUNT CLOBBERED# 
            END                                                          SAAM3
            ELSE BEGIN                                                   SAAM3
              XX = 64*FSBLKSIZ[0] - 2 + DBLKFRAME;  #BLOCK NEEDED#       JJJ0209
              YY = XX ;                                                  JJJ0309
              IF NOT NOCMM   #TERRIBLE ENGLISH, BUT ...#                 JJJ0309
              THEN           #TAKE THIS PATH IF CMM IS PRESENT#          JJJ0309
                  BEGIN                                                  JJJ0309
                  YY = YY + RUNTOTCM - TARGET;  # > 0 IF TARGET EXCEED#  JJJ0309
                  END                                                    JJJ0309
              P<BLOK$AA> = 0;                                            JJJ0508
              IF YY GR 0 AND RESP$AA (YY , P<FSTT$AA>) GR 0              JJJ0209
              THEN                                                       JJJ0209
                  BEGIN                                                  JJJ0209
                  IMPOSSIBLE(RTOTHI); 
                  END                                                    JJJ0209
              IF P<BLOK$AA> EQ 0                                         JJJ0508
              THEN                                                       JJJ0508
                BEGIN                                                    JJJ0508
                P<BLOK$AA> = GCMM$AA (XX); #GET NEW BLOCK#               JJJ0508
                BLOKINIT (P<FSTT$AA>);                                   JJJ0508
                BLKLNG = XX - DBLKFRAME;                                 JJJ0508
                END                                                      JJJ0508
            END                                                          SAAM3
                                                                         SAAM3
       LOCBAD: IF PRU EQ 0 THEN RETURN ;                                 SAAM3
          BLOCKID[0] = PRU ;                                             SAAM3
          IF FEFCSE[0] NQ 1                                              JJJ0216
          THEN                                                           JJJ0216
              BEGIN                                                      JJJ0216
              WTIO$AA ;                                                  JJJ0216
              END                                                        JJJ0216
          INCH$AA ( P<BLOK$AA> , LOC(BFCHNHD) ) ;                        SAAM3
          IF BLUBSFLG[0] EQ 0                                            SAAM3
            THEN INCH$AA ( LOC(BLKFPTR[0]) , LOC(FSBCHNH[0]) ) ;         SAAM3
          MFET$AA ;                                                      SAAM3
          IF FEPRUNO EQ 0 
          THEN
              BEGIN 
              IMPOSSIBLE(IOPRU0); 
              END 
          FEIN[0] = FEOUT[0] ;                                           SAAM3
          CRA1$AA ( DCIO , P<FET$AA> , RR , O"20" ) ; #READSKP# 
          FSREADCNT = FSREADCNT + 1 ;   # UPDATE CIO READ COUNT  #
          BLRIP[0] = 1 ;                                                 SAAM3
          BLCODSTAT[0] = 0 ;                                             SAAM3
                                                                         SAAM3
LOCBAB:                                                                  JJJ0111
          IF RR EQ 0                                                     JJJ0111
          THEN                                                           JJJ0111
              BEGIN                                                      JJJ0111
              T1 = FITSAV - P<FIT$AA>;                                   JJJ0111
              FTBZF[T1] = P<FET$AA>;                                     JJJ0111
              RETURN;                                                    JJJ0111
              END                                                        JJJ0111
          IF BLRIP[0] NQ 0                                               SAAM3
            THEN BEGIN                                                   SAAM3
              WTIO$AA ;                                                  SAAM3
            END                                                          SAAM3
            ELSE BEGIN                                                   SAAM3
              IF BLWIP[0] NQ 0 THEN GOTO LOCBAE ;                        SAAM3
            END                                                          SAAM3
          IF BLCODSTAT[0] EQ 0 THEN GOTO LOCBAE ;                        SAAM3
ENTRY PROC LOCB2 ;
          IF BLCODSTAT[0] EQ O"21" AND BLKLNG[0] EQ 64*FSBLKSIZ[0]-2     SAAM3
            THEN BEGIN                                                   SAAM3
              BLCODSTAT[0] = 0 ;                                         SAAM3
              IF FSCKSUMFLG[0] AND CKSM$AA NQ BLCHKSUM[0]                RPN0104
                THEN BEGIN                                               RPN0104
                  BLCODSTAT[0] = O"37776" ;                              RPN0104
                  GOTO LOCBAF ;                                          RPN0104
                END                                                      RPN0104
                ELSE                                                     RPN0104
      LOCBAE:     RJUV$AA ( P<BLOK$AA> ) ;                               RPN0104
            END                                                          RPN0104
            ELSE                                                         RPN0104
      LOCBAF:  P<BLOK$AA> = -(P<BLOK$AA>) ;  #ERROR#                     RPN0104
          END                                                            SAAM3
CONTROL EJECT;                                                           JJJ0913
          XREF PROC LOCR$AA ;                                            AFB0707
          CONTROL IFEQ 1,2 ; # LOCR$AA MOVED TO MISC$AA #                AFB0707
PROC LOCR$AA ( (N) );                                                    JJJ0913
          BEGIN                                                          JJJ0913
                                                                         ID0913 
 #                                                                       JJJ0913
* *   LOCR$AA - LOCATE A RECORD BY NUMBER IN THE CURRENT BLOCK  PAGE  1  JJJ0916
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC LOCR$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO LOCATE A RECORD IN THE CURRENT BLOCK, IDENTIFIED BY ITS         JJJ0913
*     NUMBER WITHIN THE BLOCK. IF THE NUMBER IS 0, AN IMAGINARY          JJJ0913
*     ZERO-LENGTH RECORD JUST BEFORE THE FIRST RECORD IS LOCATED --      JJJ0913
*     THIS IS ALLOWED FOR THE CONVENIENCE OF CERTAIN CALLING ROUTINES.   JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     ONE PARAMETER IS RECEIVED IN THE NORMAL SYMPL WAY. IT IS THE       JJJ0913
*     NUMBER OF THE WANTED RECORD WITHIN THE CURRENT BLOCK, AND MUST     JJJ0913
*     NOT BE GREATER THAN THE COUNT OF RECORDS IN THE BLOCK. HOWEVER,    JJJ0913
*     IT MAY BE 0. THE RECORD SO INDICATED MAY BE DEAD OR ALIVE.         JJJ0913
*                                                                        JJJ0913
*     THE CURRENT BLOCK MUST BE IN CORE.                                 JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     RECFWA IS SET TO THE FWA OF THE RECORD, OR TO THE FWA OF THE       JJJ0913
*       FIRST RECORD IN THE BLOCK IF THE RECORD NUMBER IS 0.             JJJ0913
*     RECLWA IS SET TO THE LWA+1 OF THE RECORD, OR TO THE FWA OF THE     JJJ0913
*       FIRST RECORD IN THE BLOCK IF THE RECORD NUMBER IS 0.             JJJ0913
*     RECLG IS SET TO THE LENGTH OF THE RECORD IN WORDS, OR 0 IF THE     JJJ0913
*       RECORD NUMBER IS 0.                                              JJJ0913
*     TEMPLOC IS THE ADDRESS AT WHICH THE KEY OF THE RECORD BEGINS       CY210
*       (THE CHARACTER POSITION AT WHICH IT BEGINS WAS SET IN            CY210
*       TEMPOS BY LKEY$AA.)                                              CY210
*     RECPTR, BITS 0-29 (RIGHT HALF) CONTAINS THE RECORD                 CY210
*       POINTER FOR THIS RECORD.                                         CY210
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE.                                                              JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     RPGET - TO FETCH A RECORD POINTER                                  JJJ0913
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     NONE EXCEPT RECFWA,RECLG,RECLWA,TEMPLOC,RECPTR.                    CY210
*                                                                        JJJ0913
 #                                                                       JJJ0913
          ITEM N;            #RECORD NUMBER#                             JJJ0913
                                                                         JJJ0913
                             #START OF LOCR$AA CODE#                     ID0913 
          RNO = N ;                                                      SAAM3
          IF N EQ 0                                                      SAAM3
            THEN BEGIN                                                   SAAM3
              RECFWA = BLOCFWA ;                                         SAAM3
              RECLWA = RECFWA ;                                          SAAM3
            END                                                          SAAM3
            ELSE BEGIN                                                   SAAM3
              RECFWA = LWAD$AA ( N-1 ) + BLOCFWA ;                       SAAM3
              IF UR EQ 0                                                 SAAM3
                THEN BEGIN                                               SAAM3
                  RPGT$AA ( N ) ;                                        SAAM3
                  RECLWA = LWAFIELD + BLOCFWA ;                          SAAM3
                END                                                      SAAM3
                ELSE BEGIN                                               SAAM3
                  IF INDEXFLAG NQ 0 AND BLOCKID[0] EQ PRBK               SAAM3
                    THEN RECPTR = INDXLNG ;                              SAAM3
                    ELSE RPGT$AA ( 1 ) ;                                 SAAM3
                  RECLWA = RECFWA + LWAFIELD ;                           SAAM3
                END                                                      SAAM3
            END                                                          SAAM3
          RECLNG = RECLWA - RECFWA;                                      JJJ0908
          TEMPLOC = RECFWA + TEMPLOFF ; 
          END                                                            SAAM3
          CONTROL ENDIF ;                                                AFB0707
CONTROL EJECT;                                                           JJJ1109
PROC LOG$AA (CALLNUM);                                                   JJJ1109
        BEGIN                                                            JJJ1109
 #                                                                       JJJ1109
* *   LOG$AA - FORMAT LOGGING PACKET             PAGE  1                 JJJ1109
* *   JJ JANIK                                   DATE  76/11/09          JJJ1109
* DC  NAME                                                               JJJ1109
* C   LOG$AA                                                             JJJ1109
*                                                                        JJJ1109
* DC  FUNCTION                                                           JJJ1109
*                                                                        JJJ1109
*     TO FORMAT THE LOG PACKET AND TRANSFER CONTROL TO THE LOGGING EXIT. JJJ1109
*                                                                        JJJ1109
* DC  ENTRY CONDITIONS                                                   JJJ1109
*                                                                        JJJ1109
*     CALLING SEQUENCE: LOG$AA (CALLNUM)                                 JJJ1109
*     WHERE CALLNUM IS 0 FOR THE FIRST CALL TO LOG$AA FOR A BLOCK AND    JJJ1109
*     1 FOR THE SECOND AND FINAL CALL                                    JJJ1109
*                                                                        JJJ1109
*     BLOK$AA POINTS TO THE START OF THE BLOCK FRAME OF THE BLOCK TO BE  JJJ1109
*     LOGGED                                                             JJJ1109
*                                                                        JJJ1109
* DC  EXIT CONDITIONS                                                    JJJ1109
*                                                                        JJJ1109
*     ALL ENTRY CONDITIONS ARE PRESERVED.                                JJJ1109
*                                                                        JJJ1109
* DC  CALLED ROUTINES                                                    JJJ1109
*                                                                        JJJ1109
*     OWN$AA - JUMP TO OWNCODE ROUTINE (FTLGX)                           JJJ1109
*                                                                        JJJ1109
* DC  DESCRIPTION                                                        JJJ1109
*                                                                        JJJ1109
 #                                                                       JJJ1109
        ITEM CALLNUM I;      # FORMAL PARAMETER, 0= 1ST CALL, 1= 2ND   # JJJ1109
 #                                                                       JJJ1109
*     THE LOGGING PACKET IS SET UP FROM INFORMATION IN THE FIT, FSTT,    JJJ1109
*     AND THE BLOCK.  THE LOGGING PACKET HAS THE FOLLOWING FORM:         JJJ1109
#                                                                        JJJ1109
        ARRAY LOGPKET P(2);  # LOGGING PACKET #                          JJJ1109
          BEGIN                                                          JJJ1109
          ITEM LPLFN     U(0,0,42);  # LFN THAT BLOCK BELONGS TO #       JJJ1109
          ITEM LPINDXFLG U(0,42,1);  # 0 IF DATA BLOCK, 1 IF MIP BLOCK # JJJ1109
          ITEM LP2CALL   U(0,43,1);  # 0 IF 1ST CALL, 1 IF 2ND CALL #    JJJ1109
          ITEM LPTWOBLX  U(0,44,1);  # 1 IF MORE THAN 1 BLOCK CHANGED#  003700
          ITEM LPBLKLNG  U(0,45,15); # LENGTH OF BLOCK IN WORDS #        JJJ1109
          ITEM LPPRUNUM  U(1,0,24);  # PRU NUMBER OF THE BLOCK #         JJJ1109
          ITEM LPFITADR  U(1,24,18); # ADDRESS OF DATA FILE FIT #        JJJ1109
          ITEM LPBLKFWA  U(1,42,18); # FWA OF BLOCK #                    JJJ1109
          END                                                            JJJ1109
##                                                                       JJJ1109
                                                                         JJJ1109
 #                                                                       JJJ1109
*     SET UP FIELDS IN PACKET WHICH DEPEND ON INFO IN THE BLOCK HEADER   JJJ1109
*     OR IN THE BLOCKS FSTT.  FSTT$AA IS SET TO THE FSTT OF THE BLOCKS   JJJ1109
*     FILE.                                                              JJJ1109
 #                                                                       JJJ1109
        LPBLKLNG[0] = BLKLNG[0];                                         JJJ1109
        LP2CALL[0] = CALLNUM;                                            JJJ1109
        LPINDXFLG[0] = BLMIPBLK[0];                                      JJJ1109
        T1 = P<FSTT$AA>;                                                 JJJ1109
        P<FSTT$AA> = BLFSTTADR[0];                                       JJJ1109
        LPLFN[0] = FELFN[FSBZFET[0] - P<FET$AA>];                        JJJ1109
        LPPRUNUM[0] = BLOCKID[0];                                        JJJ1109
        LPBLKFWA[0] = LOC(BLOK$AA)+DBLKFRAME;                            JJJ1109
 #                                                                       JJJ1109
*     IF DEALING WITH A MIP BLOCK, SET FSTT$AA TO DATA FILE FSTT.        JJJ1109
*     FSMIPFSTT WILL ALWAYS POINT TO THE DATA FILE FSTT FROM MIP FSTT    JJJ1109
*     IF THIS ROUTINE IS CALLED SINCE THE MIP FILE IS ALTERED ONLY WHEN  JJJ1109
*     THE DATA FILE IS ALTERED.                                          JJJ1109
 #                                                                       JJJ1109
        IF BLMIPBLK[0] NQ 0                                              JJJ1109
        THEN                 # BLOCK BELONGS TO A MIP FILE #             JJJ1109
            BEGIN                                                        JJJ1109
            P<FSTT$AA> = FSMIPFSTT[0];  #FSTT$AA NOW ON DATA FILE FSTT#  JJJ1109
            END                                                          JJJ1109
 #                                                                      003900
*     COPY FLAG FS2BLOX FROM THE FSTT TO LPTWOBLX. THIS WILL BE         004000
*     1 IF AN OPERATION THAT ALTERS MORE THAN ONE BLOCK IS IN           004100
*     PROGRESS. IT HAS NO SPECIAL SIGNIFICANCE UNLESS FTSFLG IN         004200
*     IS 1. THAT SHOULD BE A SIGNAL FROM THE USER THAT HE NEEDS         004300
*     SPECIAL LOGGING INFORMATION. IF SO, WHENEVER FS2BLOX TURNS        004400
*     FROM 0 TO 1, WE WRITE OUT THE FSTT. IF THE LOGGING EXIT IS        004500
*     SET, WHICH PRESUMABLY IT WOULD BE, WE CALL THE LOGGING            004600
*     ROUTINE WITH LPTWOBLX AND LP2CALL SET. THIS HAPPENS BEFORE        004700
*     ANY BLOCK IMAGE (EXCEPT THE FSTT) IS ACTUALLY ALTERED, SO         004800
*     THE USER, THROUGH HIS LOGGING ROUTINE, HAS THE OPPORTUNITY        004900
*     TO TAKE ANY PROTECTIVE ACTION THAT IS NECESSARY AT THE            005000
*     BEGINNING OF AN OPERATION THAT ALTERS MORE THAN ONE BLOCK.        005100
*     IN PARTICULAR, THE LOGGING ROUTINE SHOULD SET FTFWI TO 1          005200
*     IN THE FIT (FORCED WRITE INDICATOR) SO THAT ALL ALTERED           005300
*     BLOCKS WILL BE FLUSHED OUT AT THE END OF THE OPERATION,           005400
*     AND THE FSTT WILL HAVE FS2BLOX CLEARED TO 0 AND THEN BE           005500
*     FLUSHED OUT AS WELL. WHEN THE USER GETS CONTROL BACK FROM         005600
*     THE OPERATION AS A WHOLE, HE CAN RESET FTFWI TO 0.                005700
 #                                                                      005800
        LPTWOBLX[0] = FS2BLOX[0] ;                                      005900
                                                                         JJJ1109
 #                                                                       JJJ1109
*     SET LPFITADR TO DATA FILE FIT ADDRESS.                             JJJ1109
*     CALL OWN$AA TO ENTER USERS OWN-CODE LOGGING EXIT WITH THE PACKET   JJJ1109
*     AS A PARAMETER.                                                    JJJ1109
*     RETURN.                                                            JJJ1109
 #                                                                       JJJ1109
        LPFITADR[0] = FSFTCHN[0];                                        JJJ1109
        T2 = FSLGX[0];                                                   JJJ1109
        P<FSTT$AA> = T1;                                                 JJJ1109
        OWN$AA (T2 , LOGPKET);                                           JJJ1109
                                                                         JJJ1109
        RETURN;                                                          JJJ1109
                                                                         JJJ1109
        END                                                              JJJ1109
CONTROL EJECT;                                                           SAAM3MO
PROC MFET$AA;                                                            SAAM3MO
 #                                                                       CY211
* *   MFET$AA - SET UP THE FET TO READ OR WRITE THE CURRENT BLOCK        CY211
* *   A.F.R.BROWN                                                        CY211
* 1DC MFET$AA                                                            CY211
*                                                                        CY211
* DC  FUNCTION                                                           CY211
*                                                                        CY211
*     TO SET UP THE FOUR POINTERS AND THE PRU NUMBER IN THE CURRENT      CY211
*     FET, READY TO REWRITE-EOR THE CURRENT BLOCK. IF THE CALLER         CY211
*     WANTS TO READ RATHER THAN WRITE, HE MUST AFTERWARDS SET THE        CY211
*     IN POINTER = THE OUT POINTER.                                      CY211
*                                                                        CY211
* DC  ENTRY CONDITIONS                                                   CY211
*                                                                        CY211
*     P<FET$AA> POINTS TO THE PROPER FET.                                CY211
*     P<BLOK$AA> POINTS TO THE CURRENT BLOCK - REALLY TO THE FIRST       CY211
*       OF THE 3 ((FRAME)) WORDS THAT PRECEDE THE ACTUAL BLOCK IMAGE.    CY211
*     P<FSTT$AA> POINTS TO THE FSTT OF THE CURRENT FILE.                 CY211
*                                                                        CY211
* DC  EXIT CONDITIONS                                                    CY211
*                                                                        CY211
*     FIRST = OUT = THE FWA OF THE BLOCK IMAGE AREA.
*     IN = THE LWA+1 OF THE BLOCK IMIAGE AREA, WHICH IS CORRECT 
*       FOR A WRITE. BUT FOR A READ WE MUST SET IN=OUT AND USE
*       READSKP.
*     LIMIT = THE LWA+2 OF THE BLOCK IMAGE AREA. IF IT WERE 1 
*       LESS, IT WOULD MAKE THE BUFFER APPEAR EMPTY.
*     FEPRUNO, THE RIGHT HALF OF THE 7TH WORD OF THE FET, = THE          CY211
*       STARTING PRU NUMBER OF THE BLOCK, TAKEN FROM ITS FRAME.          CY211
*     FESRB, BIT 47 OF THE SECOND WORD OF THE FET, THE RANDOM FLAG, =1.  CY211
*                                                                        CY211
*     HOWEVER, IF THE FIRST FSBADBLK WORD OF THE FSTT IS NON-ZERO, THERE CY211
*     IS AT LEAST ONE BAD BLOCK IN THE FILE, THAT COULD NOT BE REWRITTEN CY211
*     AT ITS OWN PRU NUMBER AND HAD TO BE PUT SOMEWHERE ELSE. CALL       CY211
*     SUBROUTINE SCANBAD TO SEE IF THE LOGICAL PRU NUMBER OF THIS BLOCK  CY211
*     APPEARS IN THAT TABLE. ON RETURN BBLKORD IS NEGATIVE IF THERE WAS  CY211
*     NO MATCH, BUT OTHERWISE IT IS THE ORDINAL OF THE TABLE ENTRY FOR   CY211
*     THIS BLOCK, AND WE GET THE PHYSICAL PRU NUMBER FROM THE TABLE      CY211
*     ENTRY, SET FEPRUNO TO THAT INSTEAD OF THE LOGICAL PRU NUMBER,      CY211
*     AND SET THE BLPRUFAKE FLAG IN THE BLOCK FRAME TO 1.                CY211
*                                                                        CY211
* DC  ERROR CONDITIONS                                                   CY211
*                                                                        CY211
*     NONE                                                               CY211
*                                                                        CY211
* DC  CALLED ROUTINES                                                    CY211
*                                                                        CY211
*     SCANBAD - TO SCAN THE BAD BLOCK TABLE.                             CY211
*                                                                        CY211
* DC  NON-LOCAL VARIABLES                                                CY211
*                                                                        CY211
*     BBLKORD - THE RESULT VARIABLE SET BY SCANBAD.                      CY211
*                                                                        CY211
 #                                                                       CY211
          BEGIN                                                          SAAM3MO
                                                                         JJJ0916
                                                                         JJJ0916
          FEFIRST[0] = P<BLOK$AA> + DBLKFRAME ; 
          FEOUT[0] = P<BLOK$AA> + DBLKFRAME ; 
          FEIN[0] = P<BLOK$AA> + DBLKFRAME + BLKLNG[0] ;
          FELIMIT[0] = P<BLOK$AA> + DBLKFRAME + BLKLNG[0] + 1 ; 
          FEPRUNO[0] = BLOCKID[0] ;                                      SAAM3
          IF FSBADBLK[0] NQ 0                                            JJJ1116
            THEN BEGIN                                                   JJJ1116
              SCANBAD ( FEPRUNO[0] ) ;                                   JJJ1116
              IF BBLKORD GQ 0 
                THEN BEGIN                                               JJJ1116
                  FEPRUNO[0] = B<30,30>FSBADBLK[BBLKORD]; 
                  BLPRUFAKE[0] = 1 ;                                     JJJ1116
                END                                                      JJJ1116
            END                                                          JJJ1116
          FESRB[0] = 1 ;                                                 SAAM3
          END                                                            SAAM3
CONTROL EJECT;
PROC MSGD$AA(MESSNO,INSVAL); #DECIMAL INSERT ITEM#
 #
* *   MSGD$AA                                    PAGE  1
* *   VB GODDARD                                 DATE  76/08/24 
* DC  NAME
*     THERE ARE FIVE NAMED ENTRY POINTS IN THIS ROUTINE --               RPN1201
*     MSGD$AA - OUTPUT A MESSAGE WITH A DECIMAL INSERT. 
*     MSGO$AA - OUTPUT A MESSAGE WITH AN OCTAL INSERT.
*     MSGZ$AA - OUTPUT A MESSAGE WITH NO INSERTS. 
*     MSGF$AA - OUTPUT A FATAL ERROR MESSAGE WITH NO INSERTS. 
*     MSCF$AA - OUTPUT A FATAL ERROR MESSAGE WITH A CODED INSERT.        RPN1201
* DC  FUNCTION
*     OUTPUT A MESSAGE VIA ERROR PROCESSOR ER$SRM. THIS INTERFACE IS
*     NECESSARY TO REDUCE OVERALL FIELD LENGTH, SINCE THE PARAMETER LIST
*     FOR DIRECT CALLS TO ER$SRM IS LENGTHY. EACH CALL TO THIS INTERFACE
*     REQUIRES 1 OR 2 PARAMETERS, DEPENDING ON THE ENTRY POINT USED.
* DC  ENTRY CONDITIONS
*     1 OR 2 PARAMETERS:  
*          M - MESSAGE NUMBER, EITHER A NOTE OR ERROR CODE NUMBER.
*          I - INSERT ITEM. 
*     THE CALLS FOR THE FIVE PROCS ARE --                                RPN1201
*          MSGD$AA(M,I) 
*          MSGO$AA(M,I) 
*          MSGZ$AA(M) 
*          MSGF$AA(M) 
*          MSCF$AA(M,I)                                                  RPN1201
* DC  EXIT CONDITIONS 
*     THE MESSAGE IS PASSED ALONG TO ER$SRM.
*     FSFTERR IS SET TO 215B IF ENTRY IS THRU MSGF$AA OR MSCF$AA .
*     IF THE FIT IS LEFT WITH THE FATAL ERROR FLAG SET (EITHER BECAUSE
*       WE ENTERED THRU MSGF$AA OR MSCF$AA, OR BECAUSE THE TRIVIAL
*       ERROR LIMIT HAS JUST BEEN REACHED) THE FILE HAS BEEN FLUSHED. 
*       FSRUINFLG AND FSRUFSTT, IF SET BEFORE CALLING MSGF$AA OR
*       MSCF$AA, WILL LIMIT THE FLUSHING. 
* DC  ERROR CONDITIONS
*     NONE
* DC  CALLED ROUTINES 
*     ER$SRM - TO OUTPUT THE MESSAGE. 
*     DMPM$AA - IN CASE OF FATAL MESSAGE, TO DO A DUMP OF THE WHOLE 
*       FIELD LENGTH IF THE CM BIT OF THE FIT IS 1, AND THEN TO RESET 
*       THAT BIT TO 0. THE CM BIT IS IRRELEVANT TO AAM FILES
*       SO THIS USE OF IT DOES NOT CONFLICT WITH ANYTHING ELSE, AND 
*       IT OFFERS A WAY TO GET A MEANINGFUL DUMP OUT OF AN AAM FILE 
*       ABORT IN SPITE OF REPRIEVE. THE DMPM$AA ROUTINE IS IN PROGRAM 
*       CRA1$AA.
*     FLSH$AA - TO FLUSH THE FILE IF FATAL ERROR FLAG SET IN FIT. 
* DC  DESCRIPTION 
*     FOR MSGF$AA AND MSCF$AA, THE FATAL ERROR FLAG                      RPN1201
*     IN THE ER$SRM PARAMETER LIST IS                                    RPN1201
*     SET ON. FOR THE OTHER 3 ENTRY POINTS THE FATAL ERROR FLAG IS SET
*     OFF. FOR MSGF$AA AND MSGZ$AA THE INSERT FLAG IN THE ER$SRM
*     PARAMETER LIST IS SET OFF. FOR MSGD$AA AND MSGO$AA THE SECOND      RPN1201
*     PARAMETER IS CONVERTED FROM BINARY INTEGER TO DISPLAY CODE         RPN1201
*     DECIMAL OR OCTAL, 1 TO 10 DIGITS RIGHT JUSTIFIED WITH BLANK        RPN1201
*     FILL.                                                              RPN1201
*     IF THE FATAL FLAG IS ON AND THE MESSAGE NUMBER IS ONE OF
*     THOSE LISTED IN ARRAY BADFILE, FIT FLAG BFF IS SET AND FSFTERR
*     IN THE FSTT IS SET TO 215B. THE LATTER WILL CAUSE ANY OTHER 
*     FITS THAT MAY BE LINKED TO THIS FILE TO GET FATAL ERRORS BACK 
*     THE NEXT TIME THEY TRY TO ACCESS THE FILE.
 #
CONTROL EJECT;
      BEGIN 
      ITEM MESSNO;           #MESSAGE NUMBER# 
      ITEM INSVAL;           #INSERT VALUE# 
      ITEM FATAL;            #FATAL ERROR FLAG# 
      ITEM INSERT;           #MESSAGE INSERT PARAMETER# 
      ARRAY INS;             #INSERT LIST#
          BEGIN 
          ITEM EOL  B(0,00,01)=[TRUE];#END OF LIST FLAG#
          ITEM TYPE U(0,01,03)=[2] ; #CHARACTER#                         RPN1201
          ITEM MODE U(0,04,02); 
          ITEM VAL  U(0,12,48);       #INSERT ITEM# 
          ITEM DIS U(0,15,1);                                            CY209
          ITEM POS U(0,17,6); 
          ITEM LEN I(0,24,18);
          ITEM LOCA I(0,42,18); 
          END 
  
      ARRAY [0:1] S(1) ;
          BEGIN 
          ITEM TOILET I(0,0,60) = [0,0] ; 
          ITEM FLLFN U(0,0,42) ;
          ITEM FLFIT I(0,42,18) ; 
          END 
  
      ARRAY [0:9] S(1) ;
          BEGIN 
          ITEM BADFILE I(0,0,60) =
            [EC6,EC135,EC136,EC147,EC202,EC507,EC546,EC547,EC553,EC720];
          END 
  
      IX = 10 ;                                                          RPN1201
      GOTO MSCONV ;                                                      RPN1201
                                                                         RPN1201
ENTRY PROC MSGO$AA(MESSNO,INSVAL);  #OCTAL INSERT ITEM#                  RPN1201
      IX = 8 ;                                                           RPN1201
MSCONV:                                                                  RPN1201
      IX2 = "          " ;                                               RPN1201
      T1 = ABS(INSVAL) ;                                                 DABBLE 
      FOR T2 = 9 STEP -1 UNTIL 1                                         DABBLE 
      DO                                                                 RPN1201
          BEGIN                                                          RPN1201
          T3 = T1 / IX ;                                                 RPN1201
          C<T2,1>IX2 = "0" + T1 - IX * T3 ;                              RPN1201
          T1 = T3 ;                                                      RPN1201
          IF T1 EQ 0                                                     RPN1201
          THEN                                                           RPN1201
              BEGIN                                                      RPN1201
              GOTO MSGIVE ;                                              RPN1201
              END                                                        RPN1201
          END                                                            RPN1201
      T2 = 1 ;                                                           DABBLE 
MSGIVE:                                                                  DABBLE 
      IF INSVAL LS 0                                                     DABBLE 
      THEN                                                               DABBLE 
          BEGIN                                                          DABBLE 
          C<T2-1,1>IX2 = "-" ;                                           DABBLE 
          END                                                            DABBLE 
      FATAL = 0 ;                                                        RPN1201
      VAL[0] = LOC(IX2) ;                                                RPN1201
       #SETS DIS=POS=LEN=0,LOCA=LOC(IX2)#                                RPN1201
      GOTO MSCFA ;                                                       RPN1201
                                                                         RPN1201
ENTRY PROC MSCF$AA (MESSNO,INSVAL);  #FATAL ERROR, CODED/CONTAINED# 
          BEGIN 
          VAL = LOC(INSVAL) ;                                            RPN1201
           #SETS DIS=POS=LEN=0,LOCA=LOC(INSVAL) #                        RPN1201
          FATAL = 1;
          DMPM$AA ( P<FIT$AA> ) ; #FL DUMP IF CM BIT SET IN FIT#
MSCFA:                                                                   RPN1201
          INSERT = LOC(INS);
          MODE = 1;          #DIRECTED# 
          DIS = 1;                                                       CY209
          LEN = 1;                                                       CY209
          GOTO MSGOUT;
          END 
                                                                         RPN1201
ENTRY PROC MSGF$AA (MESSNO) ; #FATAL ERROR, NO INSERT#                   RPN1201
          BEGIN                                                          RPN1201
          FATAL = 1 ;                                                    RPN1201
          DMPM$AA ( P<FIT$AA> ) ; #FL DUMP IF CM BIT SET IN FIT#
          GOTO MSGOUTA ;                                                 RPN1201
          END                                                            RPN1201
                                                                         RPN1201
ENTRY PROC MSGZ$AA (MESSNO) ; #OUTPUT A MESSAGE WITH NO INSERT#          RPN1201
          BEGIN                                                          RPN1201
          FATAL = 0 ;                                                    RPN1201
MSGOUTA:                                                                 RPN1201
          INSERT = 0 ;                                                   RPN1201
          END                                                            RPN1201
                                                                         RPN1201
MSGOUT:                                                                  RPN1201
      ER$SRM ( FITSAV,MESSNO,FATAL,INSERT,1,0,0 ) ;                      RPN1201
      IF FATAL NQ 0 
      THEN
          BEGIN 
          FOR IX = 0 STEP 1 UNTIL 9 
          DO
              BEGIN 
              IF MESSNO EQ BADFILE[IX]
              THEN
                  BEGIN 
                  GOTO MSGOUTB ;
                  END 
              END 
          GOTO MSGOUTH ;
MSGOUTB:  
          FTBFF[0] = 1 ;
          IF FTFSTT[0] NQ 0 
          THEN
              BEGIN 
              P<FSTT$AA> = FTFSTT[0] ;
              FSFTERR[0] = EC215 ;
              END 
          IF FTMIPFS[0] NQ 0
          THEN
              BEGIN 
              P<FSTT$AA> = FTMIPFS[0] ; 
              FSFTERR[0] = EC215 ;
              END 
          END 
MSGOUTH:  
      IF FTFNF[0] NQ 0
      THEN
          BEGIN 
          FLFIT[0] = P<FIT$AA> ;
          FLLFN[0] = FTLFN[0] ; 
          FLSH$AA ( LOC(TOILET[0]) ) ;
          P<FIT$AA> = FLFIT[0] ;
          END 
      END 
CONTROL EJECT;                                                           JJJ0913
PROC RDRC$AA;                                                            ID0913 
          BEGIN                                                          JJJ0913
                                                                         ID0913 
 #                                                                       JJJ0913
* *   RDRC$AA - COPY THE CURRENT RECORD TO USER AREA         PAGE 1      JJJ0913
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC RDRC$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO COPY THE CURRENT RECORD TO THE USER AREA THAT FTWSA[0]          JJJ0913
*     POINTS TO, AND SET FTRL[0] TO THE RECORD LENGTH IN CHARACTERS.     JJJ0913
*     ALSO TO RETURN THE APPROPRIATE KEY, PRIMARY OR ALTERNATE, IF       CY210
*     THIS IS A GETNEXT OR A GET/START BY ((MAJOR KEY)), TO THE          CY210
*     USER AREA POINTED TO BY KA OR PKA IN THE FIT.                      CY210
*                                                                        CY210
*     IF THE OPERATION IS A START, HOWEVER, KEY(S) WILL BE RETURNED      CY210
*     AS FOR A GET OR GETNEXT, BUT THE RECORD IS NOT COPIED TO THE       CY210
*     WSA SPACE.                                                         CY210
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     RECFWA, RECLWA, AND RECLG CONTAIN THE FWA, LWA+1, AND LENGTH       JJJ0913
*     IN WORDS OF THE CURRENT RECORD.                                    JJJ0913
*                                                                        JJJ0913
*     OUTKEY CONTAINS THE NUMBER OF WORDS OF NON-EMBEDDED KEY THAT       JJJ0913
*     BEGIN EVERY RECORD IN THIS FILE.                                   JJJ0913
*                                                                        JJJ0913
*     RECPTR CONTAINS, IN ITS RIGHT HALF AS FETCHED BY RPGT$AA,          JJJ0913
*     THE RECORD POINTER FOR THE CURRENT RECORD, OR THE COMMON ONE       JJJ0913
*     FOR THE CURRENT BLOCK IF THE BLOCK HAS UNIFORM RECORDS.            JJJ0913
*                                                                        CY210
*     MKEYLNG, IF NOT ZERO, IS THE LENGTH OF A ((MAJOR KEY)) BY WHICH TH CY210
*       RECORD WAS FOUND, SOMETHING SHORTER THAN THE ENTIRE KEY, WHETHER CY210
*       PRIMARY OR ALTERNATE. IF IT IS NOT ZERO, RETURN THE KEY          CY210
*       TO THE CALLER IF KA IS SET, BECAUSE THE CALLER SUPPLIED A        CY210
*       PARTIAL KEY AND WANTS TO SEE THE ENTIRE KEY.                     CY210
*                                                                        CY210
*     KA IN THE FIT, IF NOT 0, INDICATES THAT ON A GETNEXT, THE KEY IS   CY210
*       TO BE RETURNED TO USER SPACE BEGINNING IN CHARACTER NUMBER KP    CY210
*       (FROM THE FIT) OF THE WORD AT ADDRESS KA. ALSO ON A GET OR       CY210
*       START, IF MKEYLNG IS NOT 0.                                      CY210
*       THE KEY CAN BE PRIMARY OR ALTERNATE, DEPENDING.                  CY210
*                                                                        CY210
*     PKA IN THE FIT, IF NOT 0, AND IF THE KEY IS ALTERNATE,             CY210
*       INDICATES THAT THE PRIMARY KEY OF THE SAME RECORD IS TO BE       CY210
*       RETURNED TO USER SPACE BEGINNING IN THE FIRST CHARACTER OF       CY210
*       THE WORD AT ADDRESS PKA.                                         CY210
*                                                                        CY210
*     FAPOSKEY1[0] IS 0 IF THIS OPERATION IS BY PRIMARY KEY, OR          CY210
*       NON-ZERO IF BY ALTERNATE KEY.                                    CY210
*     IF BY ALTERNATE KEY, AND PKA IS NOT 0, THE PRIMARY KEY VALUE       DABBLE 
*       HAS ALREADY BEEN RETURNED WHERE PKA POINTS.                      DABBLE 
*                                                                        CY210
*     FAPKY3ADR[0] CONTAINS THE FWA OF A STORAGE SPACE WHERE THE PRIMARY CY210
*       KEY VALUE FOR THE CURRENT RECORD HAS ALREADY BEEN STORED.        CY210
*     FAPKY2ADR[0], IF BY ALTERNATE KEY, CONTAINS THE FWA OF A           CY210
*       STORAGE SPACE WHERE THE KEY VALUE FOR THE CURRENT RECORD         CY210
*       HAS ALREADY BEEN SAVED.                                          CY210
*                                                                        CY210
*     IF BY ALTERNATE KEY, THEN THE LENGTH OF THE KEY MUST BE GIVEN      CY210
*       BY KL IN THE FIT, FOR A GET OR START. FOR A GETNEXT BY ALTERNATE CY210
*       KEY, THE LENGTH CAN BE FOUND IN FAPKRKL[0]. THE TYPE OF THE      CY210
*       ALTERNATE KEY CAN BE FOUND IN FAPKTYP[0].                        CY210
*                                                                        CY210
*     FTCOP[0] (THE COP FIELD OF THE FIT) CONTAINS A CODE INDICATING     CY210
*       WHETHER THIS IS A GET, GETNEXT, OR START.                        CY210
*                                                                        CY210
*     WSA IN THE FIT IS THE FWA OF THE AREA TO WHICH THE RECORD          CY210
*       IS TO BE COPIED, UNLESS THE OPERATION IS A START.                CY210
*                                                                        CY210
*     MRL IN THE FIT IS THE MAXIMUM LENGTH IN CHARACTERS OF              CY210
*       A RECORD THAT IS ALLOWED TO BE COPIED TO THIS AREA.              CY210
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        CY210
*     ONE OR TWO KEYS MAY HAVE BEEN RETURNED WHERE KA AND/OR PKA         CY210
*     POINT, AS DESCRIBED ABOVE UNDER ((ENTRY CONDITIONS)). IF           CY210
*     THE RECORD HAS ALSO BEEN RETURNED, AND THE RECORD AREA             CY210
*     OVERLAPS A KEY AREA, THE RECORD OVERWRITES THE KEY.                CY210
*                                                                        JJJ0913
*     THE RECORD, EXCLUDING NON-EMBEDDED KEY IF ANY, HAS BEEN COPIED     JJJ0913
*     TO THE AREA BEGINNING WITH THE FIRST CHARACTER OF THE WORD AT      JJJ0913
*     ADDRESS FTWSA[0]. IF SOME OF THE CHARACTERS AT THE END OF THE      CY210
*     LAST WORD WERE GARBAGE, THEY HAVE BEEN TRANSPORTED EVEN SO,        CY210
*     UNLESS THIS WOULD VIOLATE THE LIMIT OF MRL CHARACTERS.             CY210
*         (BUT NOT IF THE OPERATION IS A START.)                         CY210
*                                                                        JJJ0913
*     THE LENGTH OF THE RECORD IN CHARACTERS, EXCLUDING NON-EMBEDDED     JJJ0913
*     KEY IF ANY, AND EXCLUDING GARBAGE CHARACTERS AT THE END IF ANY,    JJJ0913
*     HAS BEEN STORE AT FTRL[0] IN THE FIT.                              JJJ0913
*         (BUT NOT IF THE OPERATION IS A START.)                         CY210
*                                                                        JJJ0913
*     THE XFER FLAG IN THE FIAT HAS BEEN SET TO 1, INDICATING THAT       JJJ0913
*     THE CURRENT RECORD HAS BEEN ((USED UP)) -- E.G. A GETNEXT          JJJ0913
*     OPERATION WOULD WANT TO GO TO THE NEXT RECORD IN THE FILE.         JJJ0913
*     IT WOULD BE SIMPLER TO CALL SKPF$AA AT THIS POINT AND ACTUALLY     JJJ0913
*     MAKE THE NEXT RECORD CURRENT, RATHER THAN KLUDGE AROUND WITH XFER. JJJ0913
*     BUT THAT WOULD TAKE TIME, AND IF WE ARE NOT ACTUALLY WORKING       JJJ0913
*     CONSECUTIVELY THROUGH THE FILE, IT WOULD BE A PURE WASTE.          JJJ0913
*          (BUT IF THE OPERATION IS A START, XFER IS LEFT 0.)            CY210
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NON-FATAL ERROR IF MRL IS LESS THAN RL. NONE OF THE RECORD         CY210
*     WILL BE COPIED TO THE WSA AREA, BUT ANY RETURNING OF KEY(S)        CY210
*     THAT WAS CALLED FOR WILL HAVE BEEN DONE.                           CY210
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     MOVW$AA - TO COPY THE RECORD, BY WORDS RATHER THAN CHARACTERS.     JJJ0913
*     REALKEY - TO DECOLLATE A RETURNED ALTERNATE KEY VALUE.             CY210
*     MOVC$AA - TO COPY KEY VALUES.                                      DABBLE 
*     SPRD$AA - TO DECOMPRESS THE RECORD.                                CY210
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     KRETWRD AND KRETPOS - FOR SCRATCH, AND AS PARAMETERS PASSED        CY210
*       TO RETPRKEY AND REALKEY                                          CY210
*                                                                        JJJ0913
 #                                                                       JJJ0913
                             #START OF RDRC$AA CODE#                     ID0913 
                                                                         AFB0517
          ITEM RLG , RFWA ;                                              AFB0528
                                                                         AFB0517
          IF FTRDB[0] EQ 0                                               DABBLE 
          THEN                                                           DABBLE 
              BEGIN                                                      DABBLE 
              MSEX(EC300) ; #NO READ PERMISSION#                         DABBLE 
              END                                                        DABBLE 
          KRETPOS = 0 ;                                                  AFB0517
          IF FAPOSKEY1[0] EQ 0                                           AFB0517
          THEN                                                           AFB0517
              BEGIN                                                      AFB0517
              KRETWRD = FTKA[0] ;                                        AFB0517
              IF KRETWRD NQ 0                                            AFB0517
               AND ( MKEYLNG NQ 0 OR FTCOP[0] EQ OP"GTN" )               AFB0517
                THEN BEGIN                                               AFB0517
                  KRETPOS = FTKP[0] ;                                    AFB0517
                  MOVC$AA(FAPKY3ADR[0],0,KRETWRD,KRETPOS,FSKEYSIZE[0]);  DABBLE 
                  REALKEY ( KRETWRD , KRETPOS , 1 ) ;                    DABBLE 
                END                                                      AFB0517
              END                                                        AFB0517
          ELSE                                                           AFB0517
              BEGIN                                                      AFB0517
              IF FTKA[0] NQ 0                                            AFB0517
              THEN
                  BEGIN      #IN THE FOLLOWING BLOCK KRETPOS CONTAINS#
                             #THE LENGTH OF THE KEY RATHER THAN POS#
                  IF FTCOP[0] EQ OP"GTN"                                 AFB0517
                    THEN KRETPOS = FAPKRKL[0] ;                          AFB0517
                    ELSE BEGIN                                           AFB0517
                      IF MKEYLNG NQ 0 THEN KRETPOS = FTKL[0] ;           AFB0517
                    END                                                  AFB0517
                  IF KRETPOS NQ 0                                        AFB0517
                  THEN                                                   AFB0517
                      BEGIN                                              AFB0517
                      MOVC$AA(FAPKY2ADR,0,FTKA,FTKP,KRETPOS);            AFB0517
                      IF FAPKTYP EQ 0      #**** CHANGE IT ***# 
                      THEN
                          BEGIN 
                          TRN1$IS(FTKA,FTKP,KRETPOS,
                              LOC(FSCODITAB[FTMIPFS[0]-P<FSTT$AA>])) ;
                          END 
                      END                                                AFB0517
                  END 
            END                                                          AFB0517
          IF FTCOP[0] NQ OP"STR"                                         AFB0517
            THEN BEGIN                                                   AFB0517
              IF FTWSA[0] EQ 0                                           DABBLE 
              THEN                                                       DABBLE 
                  BEGIN                                                  DABBLE 
                  MSEX(EC421) ;                                          DABBLE 
                  END                                                    DABBLE 
              KRETWRD = RECLNG - OUTKEY ;                                AFB0517
              RLG = 10 * KRETWRD - UCCFIELD ;                            AFB0528
              RFWA = RECFWA + OUTKEY ;                                   AFB0528
              IF FSCOMPACT[0] NQ 0 AND RPCMP NQ 0                        CY211
              THEN                                                       CY211
                  BEGIN                                                  CY211
                  RLG = SPRD$AA (RFWA , RLG) ;                           CY211
                  RFWA = CBUFAD ; 
                  KRETWRD = WLG(RLG) ;                                   AFB0528
                END                                                      AFB0528
              FTRL[0] = RLG ;                                            AFB0528
              KRETPOS = FTMRL[0] / 10 ;                                  AFB0517
              IF KRETPOS GQ KRETWRD                                      AFB0517
                THEN MOVW$AA ( RFWA , KRETWRD , FTWSA[0] ) ;             AFB0528
                ELSE BEGIN                                               AFB0517
                  IF FTMRL LS FTRL                                       JJJ0720
                  THEN       #WSA TOO SHORT,ISSUE MSG AND DONT MOVE #    JJJ0720
                      BEGIN                                              JJJ0720
                      MSEX(EC142) ;                                      DABBLE 
                      END                                                JJJ0720
                 MOVC$AA ( RFWA,0,FTWSA,0,FTRL );                        RPN1110
                END                                                      AFB0517
              REALKEY ( FTWSA[0]+FSKEYLOC[0] , FSKEYPOS[0] , 0 ) ;       AFB0517
              XFER = 1 ;                                                 AFB0517
            END                                                          AFB0517
          END                                                            SAAM3
CONTROL EJECT;
PROC REALKEY (A,B,C);                                                    CY210
          BEGIN                                                          CY210
 #                                                                       CY210
* *   REALKEY -- DECOLLATE A KEY VALUE                PAGE 1             CY210
* *   A.F.R.BROWN                                                        CY210
* 1DC REALKEY                                                            CY210
*                                                                        CY210
* DC  FUNCTION                                                           CY210
*                                                                        CY210
*     TO DECOLLATE A SYMBOLIC KEY VALUE, AFTER COPYING IT INTO A         CY210
*     USER SPACE, WHETHER AS AN EMBEDDED PART OF THE RECORD OR           CY210
*     AS A SEPARATE OBJECT REQUESTED BY THE USER.                        CY210
*                                                                        CY210
* DC  ENTRY CONDITIONS                                                   CY210
*                                                                        CY210
*     THREE PARAMETERS PASSED IN THE STANDARD WAY.                       CY210
*     (1) AND (2) THE FWA AND CHARACTER POSITION AT WHICH THE KEY        CY210
*       VALUE BEGINS.                                                    CY210
*     (3) A NON-ZERO IF THE KEY IS AN INDEPENDENT OBJECT, OR A ZERO      CY210
*       IF ONLY TO BE DECOLLATED AS PART OF THE RECORD. IN THE           CY210
*       LATTER CASE, THE KEY COULD BE NON-EMBEDDED AND THEREFORE         CY210
*       NO DECOLLATION WOULD BE REQUIRED.                                CY210
*                                                                        CY210
*     THE KEY TYPE HAS TO BE CHECKED -- IF NOT SYMBOLIC, NOTHING         CY210
*     IS TO BE DONE.                                                     CY210
*                                                                        CY210
*     IF FSKEYPOS[0] = 10 IN THE FSTT, THE KEY IS NONEMBEDDED.           CY210
*                                                                        CY210
* DC  EXIT CONDITIONS                                                    CY210
*                                                                        CY210
*     IF NECESSARY, THE KEY HAS BEEN DECOLLATED IN PLACE,                CY210
*     ACCORDING TO THE TABLE POINTED TO BY FSCODITAB[0] IN THE           CY210
*     FSTT.                                                              CY210
*                                                                        CY210
* DC  ERROR CONDITIONS                                                   CY210
*                                                                        CY210
*     NONE                                                               CY210
*                                                                        CY210
* DC  CALLED ROUTINES                                                    CY210
*                                                                        CY210
*     TRN1$IS, TO DO THE ACTUAL DECOLLATING.                             CY210
*                                                                        CY210
 #                                                                       CY210
          ITEM A,B,C;        #FORMAL PARAMETERS#                         CY210
          IF C EQ 0 AND FSKEYPOS[0] EQ 10 THEN RETURN ;                  AFB0517
          IF FSKEYTYPE[0] NQ KT"SYMBOLIC" THEN RETURN ;                  AFB0517
          TRN1$IS ( A , B , FSKEYSIZE[0] , LOC(FSCODITAB[0]) ) ;         AFB0517
          END                                                            AFB0517
CONTROL EJECT;                                                           ID0913 
PROC RJUV$AA ( N );                                                      ID0913 
          BEGIN                                                          ID0913 
                                                                         ID0913 
 #                                                                       ID0913 
* *   RJUV$AA - MOVE A BLOCK TO THE HEAD OF THE K-O CHAIN      PAGE 1    ID0913 
* *   A.F.R.BROWN                                                        ID0913 
* 1DC RJUV$AA                                                            ID0913 
*                                                                        ID0913 
* DC  FUNCTION                                                           ID0913 
*                                                                        ID0913 
*     TO MOVE A BLOCK FROM ITS PRESENT POSITION IN THE KICK-OUT CHAIN    ID0913 
*     TO THE HEAD OF THE CHAIN, IN ORDER TO MAKE IT LIVE LONGER IN CORE  ID0913 
*     BEFORE BEING KICKED OUT. BY AND LARGE, WE DO THIS FOR A BLOCK      ID0913 
*     WHENEVER WE HAVE REFERRED TO IT, AND WE DO IT FOR A PRIMARY INDEX  ID0913 
*     BLOCK WHENEVER WE REFER TO ANY INDEX BLOCK IN THE SAME FILE.       ID0913 
*                                                                        ID0913 
* DC  ENTRY CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     THERE IS ONE PARAMETER, PASSED IN THE NORMAL SYMPL WAY.            ID0913 
*     THIS IS THE ADDRESS OF THAT WORD IN THE BLOCK FRAME THAT IS        ID0913 
*     USED FOR LINKING INTO THE KICK-OUT CHAIN.                          ID0913 
*                                                                        ID0913 
*     IF BITS 0-17 OF THE WORD ARE 0, INDICATING THAT THE BLOCK IS NOT   ID0913 
*     IN FACT IN THE KICK-OUT CHAIN, RJUV$AA JUST DOES NOTHING, AND      ID0913 
*     DOES NOT EITHER COUNT THIS AS AN ERROR OR INSERT THE BLOCK AT      ID0913 
*     THE HEAD OF THE CHAIN.                                             ID0913 
*                                                                        ID0913 
* DC  EXIT CONDITIONS                                                    ID0913 
*                                                                        ID0913 
*     PROVIDED THE BLOCK WAS IN THE CHAIN TO START WITH, IT HAS BEEN     ID0913 
*     MOVED TO THE HEAD OF THE KICK-OUT CHAIN.                           ID0913 
*                                                                        ID0913 
* DC  ERROR CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
* DC  CALLED ROUTINES                                                    ID0913 
*                                                                        ID0913 
*     UNCH$AA - TO REMOVE THE BLOCK FROM ITS CURRENT POSITION.           ID0913 
*     INCH$AA - TO RE-CHAIN THE BLOCK AT THE HEAD OF THE CHAIN.          ID0913 
*                                                                        ID0913 
* DC  NON-LOCAL VARIABLES                                                ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
 #                                                                       ID0913 
          ITEM N;            #ADDR OF KO LINK WORD#                      ID0913 
                                                                         ID0913 
                             #START OF RJUV$AA CODE#                     ID0913 
          T1 = B<24,18>W[N];                                             ID0913 
          T2 = B<42,18>W[N] ;                                            RJC1005
          IF T2 NQ 0 AND T1 NQ LOC(BFCHNHD)                              RJC1005
          THEN                                                           ID0913 
            BEGIN                                                        ID0913 
              UNCH$AA ( N ) ;                                            SAAM3
              INCH$AA ( N , LOC(BFCHNHD) ) ;                             SAAM3
            END                                                          SAAM3
          END                                                            SAAM3
CONTROL EJECT;                                                           JJJ0913
          XREF PROC RPGT$AA ;                                            AFB0707
          CONTROL IFEQ 1,2 ; # RPGR$AA MOVED TO MISC$AA #                AFB0707
PROC RPGT$AA ( N );                                                      JJJ0913
          BEGIN                                                          JJJ0913
                                                                         ID0913 
 #                                                                       JJJ0913
* *   RPGT$AA - FETCH A RECORD POINTER FROM THE CURRENT BLOCK   PAGE 1   JJJ0913
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC RPGT$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO COPY INTO THE WORD AT RECPTR, THE RECORD POINTER SELECTED       JJJ0913
*     ACCORDING TO THE INCOMING PARAMETER, FROM THE CURRENT BLOCK.       JJJ0913
*     IF THE RECORDS ARE NOT COUNTED AS UNIFORM, THE PARAMETER WILL      JJJ0913
*     BE THE NUMBER OF THE CORRESPONDING RECORD IN THE BLOCK.            JJJ0913
*     IF UNIFORM, THERE IS ONLY ONE RECORD POINTER, AND THE INCOMING     JJJ0913
*     PARAMETER MUST BE 1 TO GET IT.                                     JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THERE IS ONE PARAMETER, PASSED IN THE USUAL SYMPL WAY.             JJJ0913
*     IF THE CURRENT BLOCK HAS UNIFORM RECORDS (UR FLAG = 1), THIS MUST  JJJ0913
*     BE 1, TO FETCH THE RECORD POINTER THAT SERVES FOR ALL RECORDS      JJJ0913
*     IN THE BLOCK.                                                      JJJ0913
*                                                                        JJJ0913
*     OTHERWISE, THE PARAMETER MUST BE THE NUMBER OF SOME RECORD,        JJJ0913
*     ALIVE OR DEAD, IN THE BLOCK. THUS THE NUMBER MUST NOT BE           JJJ0913
*     GREATER THAN THE COUNT OF RECORDS IN THE BLOCK.                    JJJ0913
*                                                                        JJJ0913
*     0 IS NOT ALLOWED.                                                  JJJ0913
*                                                                        JJJ0913
*     THE CURRENT BLOCK MUST BE IN CORE.                                 JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     THE WANTED RECORD POINTER IS IN THE RIGHT HALF OF THE WORD         JJJ0913
*     AT RECPTR. THE LEFT HALF OF THE SAME WORD IS 0.                    JJJ0913
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
 #                                                                       JJJ0913
          ITEM N;            #RECORD NUMBER#                             JJJ0913
                                                                         JJJ0913
                             #START OF RPGT$AA CODE#                     ID0913 
          RECPTR = RPFIELD(0,30,N) ;                                     SAAM3
          END                                                            SAAM3
          CONTROL ENDIF ;                                                AFB0707
CONTROL EJECT ;                                                          JJJ1116
PROC SCANBAD ( N ) ;                                                     JJJ1116
         BEGIN                                                           JJJ1116
                                                                         JJJ1116
 #                                                                       JJJ1116
* *   SCANBAD - SCAN THE LIST OF BAD BLOCKS IN THE FSTT    PAGE 1        JJJ1116
* *   A.F.R.BROWN                                                        JJJ1116
* 1DC SCANBAD                                                            JJJ1116
*                                                                        JJJ1116
* DC  FUNCTION                                                           JJJ1116
*                                                                        JJJ1116
*     TO SEARCH THE LIST OF BAD BLOCKS IN THE FSTT FOR EITHER            JJJ1116
*     A GIVEN BLOCK NUMBER OR AN EMPTY SLOT.                             JJJ1116
*                                                                        JJJ1116
* DC  ENTRY CONDITIONS                                                   JJJ1116
*                                                                        JJJ1116
*     THERE IS ONE PARAMETER, PASSED IN THE NORMAL SYMPL WAY.            JJJ1116
*     THIS IS EITHER 0, INDICATING AN EMPTY SLOT IS WANTED,              JJJ1116
*     OR THE PRU NUMBER OF SOME BLOCK IN THE CURRENT FILE,               JJJ1116
*     WHICH IS TO BE COMPARED WITH THE LEFT HALF OF EVERY                JJJ1116
*     WORD IN THE BAD BLOCKS LIST. (IF BLOCK 10 CANNOT BE                JJJ1116
*     WRITTEN SUCCESSFULLY, IT MAY BE REWRITTEN AT BLOCK                 JJJ1116
*     20, WHICH WAS PREVIOUSLY UNUSED. THEN A WORD IN THE                JJJ1116
*     BAD BLOCKS LIST WILL CONTAIN 10 IN THE LEFT HALF AND               JJJ1116
*     20 IN THE RIGHT HALF. THE BLOCK WILL CONTINUE TO BE                JJJ1116
*     IDENTIFIED AS 10, RIGHT UP TO THE MOMENT THAT MFET$AA              JJJ1116
*     STORES THE PRU NUMBER IN THE FET BEFORE READING OR                 JJJ1116
*     REWRITING. THEN MFET$AA SLIPS 20 INTO THE FET.)                    JJJ1116
*                                                                        JJJ1116
* DC  EXIT CONDITIONS                                                    JJJ1116
*                                                                        JJJ1116
*     BBLKORD, THE GLOBAL VARIABLE, IS NEGATIVE IF NO MATCH WAS          CY210
*       FOUND. OTHERWISE FSBADBLK[BBLKORD] IS THE MATCHING, 
*       OR FREE, WORD IN THE TABLE.                                      JJJ1116
*                                                                        JJJ1116
* DC  ERROR CONDITIONS                                                   JJJ1116
*                                                                        JJJ1116
*     NONE                                                               JJJ1116
*                                                                        JJJ1116
* DC  CALLED ROUTINES                                                    JJJ1116
*                                                                        JJJ1116
*     NONE                                                               JJJ1116
*                                                                        JJJ1116
* DC  NON-LOCAL VARIABLES                                                JJJ1116
*                                                                        JJJ1116
*     BBLKORD CONTAINS THE RESULT.
*                                                                        JJJ1116
 #                                                                       JJJ1116
                                                                         JJJ1116
        ITEM N ;                 # INCOMING PARAMETER #                  JJJ1116
                                 # START OF SCANBAD CODE #               JJJ1116
          BBLKORD = 0;
SCANBADA: 
          IF B<0,30>FSBADBLK[BBLKORD] EQ N   THEN  RETURN;
  
          BBLKORD = BBLKORD + 1;
          IF BBLKORD LQ 17   THEN  GOTO SCANBADA; 
  
          BBLKORD = -1; 
          END                                                            JJJ1116
                                                                         JJJ1116
CONTROL EJECT;                                                           JJJ0913
PROC SEBL$AA ( (N) , RECALL );                                           JJJ0913
          BEGIN                                                          JJJ0913
                                                                         ID0913 
 #                                                                       JJJ0913
* *   SEBL$AA - TO LOCATE THE BLOCK NAMED IN A GIVEN PTREE WORD  PAGE  1 JJJ0916
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC SEBL$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO LOCATE AND MAKE CURRENT THE BLOCK SPECIFIED IN A WORD OF THE    JJJ0913
*     CURRENT PTREE, THAT WORD BEING SPECIFIED BY THE FIRST INCOMING     JJJ0913
*     PARAMETER. THE BLOCK IS READ FROM DISK IF NECESSARY. HOWEVER, IF   JJJ0913
*     THE SECOND INCOMING PARAMETER IS 0, ANY SUCH READ IS DONE WITHOUT  JJJ0913
*     RECALL, AND SEBL$AA TERMINATES WITHOUT WAITING FOR IT TO BE        JJJ0913
*     COMPLETED.                                                         JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     TWO PARAMETERS ARE RECEIVED IN THE NORMAL SYMPL WAY.               JJJ0913
*     1. A NUMBER SPECIFYING THE WORD OF THE PTREE THAT WILL IN TURN     JJJ0913
*       SPECIFY THE WANTED BLOCK. 0 MEANS THE FIRST WORD OF THE          JJJ0913
*       PTREE, AS FOR THE PRIMARY INDEX BLOCK OF AN I-S FILE, AND        JJJ0913
*       SO ON DOWN.                                                      JJJ0913
*     2. A NUMBER THAT IS 0 IF ANY NECESSARY I-O IS TO BE DONE WITHOUT   JJJ0913
*       RECALL, OR NON-ZERO IF WITH RECALL. IF THIS NUMBER IS 0,         JJJ0913
*       SEBL$AA MAY NOT COMPLETE. THE CALLER CAN ASCERTAIN THIS BY       JJJ0913
*       CHECKING PTBLKIN[N], WHERE N IS THE FIRST OF THESE TWO           JJJ0913
*       PARAMETERS. IF THIS FLAG IS 0, SEBL$AA HAS NOT COMPLETED.        JJJ0913
*                                                                        JJJ0913
*     THE PTREE WORD SPECIFIED BY THE FIRST PARAMETER MUST BE            JJJ0913
*     CORRECTLY SET UP AS TO BLOCK NUMBER OR BLOCK ADDRESS.              CY210
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     SEBL$AA HAS COMPLETED IF PTBLKIN[N] IS 1, AS EXPLAINED ABOVE.      JJJ0913
*     THIS SHOULD CERTAINLY BE THE CASE IF THE SECOND INCOMING PARAMETER JJJ0913
*     WAS NON-ZERO, BUT MUST BE CHECKED OTHERWISE.                       JJJ0913
*                                                                        JJJ0913
*     P<BLOK$AA> = 0 IF IT DID NOT COMPLETE. OTHERWISE, IT CONTAINS      JJJ0913
*       THE FWA OF THE PARCEL CONTAINING THE BLOCK.                      JJJ0913
*                                                                        JJJ0913
*     THE REMAINING EXIT CONDITIONS ARE TRUE ONLY IF IT COMPLETED.       JJJ0913
*                                                                        JJJ0913
*     BLOCLWA CONTAINS THE LWA+1 OF THE BLOCK.                           JJJ0913
*                                                                        JJJ0913
*     PTCURBADR[N] IN THE PTREE WORD = P<BLOK$AA>                        JJJ0913
*                                                                        JJJ0913
*     BLPTRADR[0] IN THE BLOCK FRAME = THE ADDRESS OF THE PTREE WORD.    JJJ0913
*                                                                        JJJ0913
*     TEMPLOFF AND TEMPOS LOCATE THE PRIMARY KEY OF ANY RECORD IN THE    CY210
*       BLOCK, GIVING THE NUMBER OF WORDS AND CHARACTERS FROM THE        JJJ0913
*       BEGINNING OF ANY RECORD, AT WHICH THE KEY BEGINS.                JJJ0913
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     AN ERROR EXIT IS TAKEN WHEN ROUTINE LOCB$AA HAS SET                JJJ0913
*     P<BLOK$AA> NEGATIVE. THIS MEANS A PARITY ERROR OR CHECKSUM         JJJ0913
*     ERROR UPON READING IN THE BLOCK. IF WE KNOW WHAT TO DO,            JJJ0913
*     DO IT AND INVERT THE SIGN OF P<BLOK$AA>, THEN CONTINUE             JJJ0913
*     WITH SEBL$AA.                                                      JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     LOCB$AA - TO LOCATE THE BLOCK IN CORE, IF NECESSARY READING IT     JJJ0913
*       FROM DISK.                                                       JJJ0913
*     UNPTREE - IF THE BLOCK IS ALREADY IN CORE, BUT A WORD IN SOME      JJJ0913
*       OTHER PTREE POINTS TO IT, TO PUT THE PRU NUMBER INSTEAD OF       JJJ0913
*       THE BLOCK ADDRESS INTO THAT PTREE WORD, BEFORE MAKING THE        JJJ0913
*       CURRENT PTREE WORD POINT TO THE BLOCK. THE BLOCK FRAME CAN       JJJ0913
*       POINT TO ONLY ONE PTREE WORD, SO TO KEEP THE ACCOUNTING STRAIGHT JJJ0913
*       WE CAN ALLOW ONLY ONE PTREE WORD AT A TIME TO POINT TO THE       JJJ0913
*       BLOCK IMAGE.                                                     JJJ0913
*     RJUV$AA - TO MOVE THE BLOCK TO THE HEAD OF THE KICK-OUT CHAIN,     JJJ0913
*       IF IT WAS ALREADY IN CORE. THE GENERAL PRINCIPLE IS THAT EVERY   JJJ0913
*       REFERENCE TO A BLOCK SHOULD PROLONG ITS LIFE IN CORE.            JJJ0913
*     LKEY$AA - TO SET BLOCLWA, TEMPLOFF, AND TEMPOS AS DESCRIBED        CY210
*       UNDER ((EXIT CONDITIONS)) ABOVE.                                 CY210
*     EXRP$AA - TO ISSUE AN ERROR MESSAGE AND ABANDON THE OPERATION,     CY210
*       IF LOCB$AA RETURNS A BAD BLOCK READ.                             CY210
*     WTIO$AA - TO CLEAN UP AFTER THE READ OF THE BLOCK, IF THE CALL     CY210
*       TO SEBL$AA WAS WITHOUT RECALL, BUT LOCB$AA REPORTS THAT THE      CY210
*       READ OF THE BLOCK HAS ALREADY AT LEAST BEGUN, AND THE FET        CY210
*       SHOWS THAT IN FACT IT IS ALREADY COMPLETE.                       CY210
*     LOCB2 - TO CHECK FOR READ ERRORS. 
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     THE RESULT VARIABLES MENTIONED IN ((EXIT CONDITIONS)) ABOVE.       JJJ0913
*                                                                        JJJ0913
*     OUTKEY - THIS WAS SET BY STMD$AA.                                  JJJ0913
*                                                                        JJJ0913
 #                                                                       JJJ0913
CONTROL EJECT;               #START OF SEBL$AA CODE#                     JJJ0913
          ITEM N;            #PTREE WORD#                                JJJ0913
          ITEM RECALL;       #0 = I/O WITHOUT RECALL#                    JJJ0913
                                                                         JJJ0913
                                                                         JJJ0913
          IF PTBLKIN[N] EQ 0                                             SAAM3
            THEN BEGIN                                                   SAAM3
              LOCB$AA ( PTCURBLK[N] , RECALL ) ;                         SAAM3
              IF P<BLOK$AA> LS 0
              THEN
                  BEGIN 
                  EXRP$AA ; 
                  END 
              IF P<BLOK$AA> EQ 0 THEN RETURN ;                           SAAM3
              IF RECALL EQ 0                                             AFB0131
                THEN BEGIN                                               AFB0131
                  P<FET$AA> = FSBZFET[0] ;                               AFB0131
                  IF FECMPLT[0] NQ 0 THEN WTIO$AA ;                      AFB0131
                END                                                      AFB0131
              IF BLRIP[0] NQ 0 THEN RETURN ;                             RPN1209
              IF BLCODSTAT[0] NQ 0 AND BLWIP[0] EQ 0 THEN LOCB2 ; 
              IF P<BLOK$AA> LS 0 THEN EXRP$AA ; 
              PTCURBADR[N] = P<BLOK$AA> ;                                SAAM3
              PTBLKIN[N] = 1 ;                                           SAAM3
              IF BLPTRADR[0] NQ 0 AND BLPTRADR[0] NQ LOC(PTCURBADR[N])   SAAM3
                THEN UNPTREE ;                                           SAAM3
              BLPTRADR[0] = LOC(PTCURBADR[N]) ;                          SAAM3
            END                                                          SAAM3
            ELSE BEGIN                                                   SAAM3
              P<BLOK$AA> = PTCURBADR[N] ;                                SAAM3
              RJUV$AA ( P<BLOK$AA> ) ;                                   SAAM3
            END                                                          SAAM3
          LKEY$AA ; 
          END                                                            AFB0204
CONTROL EJECT;                                                           JJJ0913
PROC SETR$AA ( (N) );                                                    JJJ0913
          BEGIN                                                          JJJ0913
                                                                         ID0913 
 #                                                                       JJJ0913
* *   SETR$AA - MAKE A GIVEN RECORD CURRENT AND             PAGE  1      JJJ0916
* *             LOCATE IT BY NUMBER                                      JJJ0916
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC SETR$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO TAKE A GIVEN NUMBER, MAKE IT THE CURRENT RECORD NUMBER IN THE   JJJ0913
*     CURRENT BLOCK IN THE PTREE, AND LOCATE IT. THE NUMBER MAY ALSO BE  JJJ0913
*     0, IN WHICH CASE THE RECORD NUMBER IN THE PTREE IS SET TO 0, AND   JJJ0913
*     RECFWA, RECLWA, AND RECLG POINT TO AN IMAGINARY ZERO-LENGTH        JJJ0913
*     RECORD JUST AHEAD OF RECORD 1.                                     JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THERE IS ONE PARAMETER, PASSED IN THE NORMAL SYMPL WAY.            JJJ0913
*     THIS IS THE NUMBER OF THE WANTED RECORD WITHIN THE CURRENT BLOCK,  JJJ0913
*     AND SO MUST NOT BE GREATER THAN THE COUNT OF RECORDS IN THE BLOCK. JJJ0913
*     HOWEVER, IT MAY ALSO BE 0. THE RECORD IT IDENTIFIES MAY BE ALIVE   JJJ0913
*     OR DEAD.                                                           JJJ0913
*                                                                        JJJ0913
*     THE CURRENT BLOCK MUST BE IN CORE, AND THE CURRENT WORD OF THE     JJJ0913
*     PTREE MUST POINT TO IT.                                            JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     THE GIVEN NUMBER HAS BEEN INSERTED IN THE PTREE AS CURRENT         JJJ0913
*     RECORD NUMBER.                                                     JJJ0913
*                                                                        JJJ0913
*     RECFWA, RECLWA, AND RECLG HAVE BEEN SET AS DESCRIBED UNDER         JJJ0913
*     THE EXIT CONDITIONS OF LOCR$AA.                                    JJJ0913
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     LOCR$AA - DOES EVERYTHING EXCEPT THE SETTING OF THE CURRENT        JJJ0913
*       RECORD NUMBER IN THE PTREE.                                      JJJ0913
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
 #                                                                       JJJ0913
          ITEM N;            #RECORD NUMBER#                             JJJ0913
                                                                         JJJ0913
                             #START OF SETR$AA CODE#                     ID0913 
          PTCUREC[CURPTR] = N ;                                          SAAM3
          LOCR$AA ( N ) ;                                                SAAM3
          END                                                            SAAM3
CONTROL EJECT;                                                           JJJ0913
PROC SKPF$AA;                                                            JJJ0913
          BEGIN                                                          JJJ0913
                                                                         ID0913 
 #                                                                       JJJ0913
* *   SKPF$AA - SKIP FORWARD ONE RECORD                        PAGE 1    JJJ0913
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC SKPF$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO SKIP FORWARD ONE LIVE RECORD FROM THE CURRENT RECORD, IN        JJJ0913
*     AN I-S FILE, OR IN AN I-S OR FIFO SUBFILE OF A MIP FILE.
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THE CURRENT WORD OF THE PTREE MUST POINT TO A RECORD IN A BLOCK    JJJ0913
*     THAT IS IN CORE. HOWEVER, 0 WOULD BE ACCEPTABLE AS RECORD NUMBER   JJJ0913
*     IN THE PTREE WORD -- SKPF$AA WOULD THEN ACT JUST LIKE STPF$AA.     JJJ0913
*                                                                        JJJ0913
*     THE QFR, QLR, AND QEI FLAGS OF THE PTREE MUST BE CORRECTLY SET.    JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     IF FAIL IS NOT 0, WE WERE ALREADY AT EOI,  AND NOTHING             JJJ0913
*     HAS BEEN CHANGED.                                                  JJJ0913
*                                                                        JJJ0913
*     IF FAIL = 0 AND THE QEI FLAG IN THE PTREE IS 1, WE WERE ALREADY    JJJ0913
*     POSITIONED AT THE LAST RECORD, AND ARE NOW AT EOI.THE ONLY CHANGE  JJJ0913
*     HAS BEEN TO SET QLR=0 AND QEI=1. (ALSO TO SET QFR=0 IF THERE WAS   JJJ0913
*     JUST ONE LIVE RECORD.)                                             JJJ0913
*                                                                        JJJ0913
*     IF FAIL = 0 AND THE QEI FLAG = 0, WE HAVE MOVED TO THE NEXT        JJJ0913
*     LIVE RECORD, AND RECFWA, RECLWA, AND RECLG LOCATE THAT RECORD.     JJJ0913
*     THE QFR AND QLR FLAGS HAVE BEEN ADJUSTED.                          JJJ0913
* 
*     IF THE CURRENT FILE IS A FIFO SUB-FILE, AND WE HAVE STEPPED 
*     FROM ONE BLOCK TO THE NEXT, THE BLOCK NUMBER OF THE ONE WE
*     HAVE JUST LEFT IS SAVED IN THE SECOND WORD OF THE PTREE.
*     (A PTREE IS ALWAYS MORE THAN ONE WORD LONG, BUT IN A FIFO 
*     SUBFILE ONLY THE FIRST WORD OF THE PTREE IS EVER REALLY USED.)
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     STPF$AA - TO SKIP FORWARD ONE RECORD WITHIN THE BLOCK, IF POSSIBLE JJJ0913
*     STOV$AA - TO STEP INTO THE NEXT BLOCK, IN AN I-S OR FIFO (SUB)FILE JJJ0913
*     DABL$AA - TO LOCATE AND READ IN THE NEXT BLOCK, IN AN A-K FILE     JJJ0913
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     FAIL - SEE EXIT CONDITIONS ABOVE.                                  CY210
*                                                                        JJJ0913
 #                                                                       JJJ0913
CONTROL EJECT;            #START OF SKPF$AA CODE#                        ID0913 
          ITEM LBLNUM;       #LAST BLOCK NUMBER#                         ID0913 
          FAIL = QEI ;                                                   SAAM3
          IF FAIL NQ 0 THEN RETURN ;                                     SAAM3
          QFR = 0 ;                                                      SAAM3
          IF QLR NQ 0                                                    SAAM3
            THEN BEGIN                                                   SAAM3
              QEI = 1 ;                                                  SAAM3
              QLR = 0 ;                                                  SAAM3
            END                                                          SAAM3
            ELSE BEGIN                                                   SAAM3
              STPF$AA ;                                                  SAAM3
              IF FAIL NQ 0                                               SAAM3
                THEN BEGIN                                               SAAM3
                  IF ORG EQ FO"IS" OR ORG EQ FO"FIFO"                    SAAM3
                    THEN BEGIN #FWD MUSTNT BE 0#                         SAAM3
                      IF ORG EQ FO"FIFO"
                        THEN BEGIN
                          PTCURBLK[1] = BLOCKID[0] ; #USED IN VANB$IS#
                        END 
                      STOV$AA ;                                          SAAM3
                    END                                                  SAAM3
                END                                                      SAAM3
            END                                                          SAAM3
          END                                                            SAAM3
CONTROL EJECT;
PROC SPKY$AA (X);                                                        CY210
      BEGIN                                                              CY210
 #                                                                       CY210
* *   SPKY$AA -- SAVE A PRIMARY KEY VALUE                   PAGE 1       CY210
* *   A.F.R.BROWN                                                        CY210
* 1DC SPKY$AA                                                            CY210
*                                                                        CY210
* DC  FUNCTION                                                           CY210
*                                                                        CY210
*     TO SAVE A PRIMARY KEY VALUE AT A GIVEN POSITION.                   CY210
*                                                                        CY210
* DC  ENTRY CONDITIONS                                                   CY210
*                                                                        CY210
*     THERE IS ONE PARAMETER PASSED IN THE STANDARD WAY.                 CY210
*     IT IS THE FWA OF THE AREA WHERE THE PRIMARY KEY VALUE              CY210
*     IS TO BE SAVED, BEGINNING AT THE LEFTMOST CHARACTER.               CY210
*                                                                        CY210
*     THE RECORD MUST ALREADY BE LOCATED BY RECFWA, RECLG, AND           CY210
*     RECLWA, AND IF IT HAS AN EMBEDDED KEY, TEMPLOC AND                 CY210
*     TEMPOS MUST LOCATE ITS KEY BY ADDRESS AND CHARATER                 CY210
*     POSITION.                                                          CY210
*                                                                        CY210
*     KLENG, A FIELD OF THE FSTT (OR OF THE FINF, IF THIS                CY210
*     IS A SUBFILE OF A MIP FILE) IS THE KEY LENGTH IN                   CY210
*     CHARACTERS.                                                        CY210
*                                                                        CY210
*     IF THE KEY IS NON-EMBEDDED, OUTKEY IS ITS LENGTH IN                CY210
*     WHOLE OR PARTIAL WORDS (I.E. OUTKEY MUST =                         CY210
*     (KLENG+9)/10 ). OTHERWISE OUTKEY=0                                 CY210
*                                                                        CY210
* DC  EXIT CONDITIONS                                                    CY210
*                                                                        CY210
*     THE KEY HAS BEEN SAVED.                                            CY210
*                                                                        CY210
* DC  ERROR CONDITIONS                                                   CY210
*                                                                        CY210
*     NONE                                                               CY210
*                                                                        CY210
* DC  CALLED ROUTINES                                                    CY210
*                                                                        CY210
*     MOVW$AA - TO MOVE THE KEY WORD BY WORD, IF NONEMBEDDED, IN         CY210
*       WHICH CASE WE KNOW IT BEGINS ON A WORD BOUNDARY.                 CY210
*     MOVC$AA - TO MOVE IT AS A CHARACTER STRING, OTHERWISE.             CY210
*                                                                        CY210
* DC  NON-LOCAL VARIABLES                                                CY210
*                                                                        CY210
*     ONLY THOSE MENTIONED UNDER ((ENTRY CONDITIONS)) ABOVE.             CY210
*                                                                        CY210
 #                                                                       CY210
      ITEM X;                                                            CY210
          IF OUTKEY NQ 0                                                 AFB0517
            THEN MOVW$AA ( RECFWA , OUTKEY , X ) ;                       AFB0517
            ELSE MOVC$AA ( TEMPLOC , TEMPOS , X , 0 , KLENG ) ;          AFB0528
          END                                                            AFB0517
CONTROL EJECT;                                                           JJJ0913
PROC STMD$AA (MODE);                                                     JJJ0913
          BEGIN                                                          JJJ0913
                                                                         ID0913 
 #                                                                       JJJ0913
* *   STMD$AA - INITIALIZE ON THE DATA FILE OR THE MIP FILE     PAGE 1   JJJ0913
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC STMD$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO INITIALIZE CERTAIN VARIABLES AND POINTERS FOR THE CURRENT       JJJ0913
*     DATA FILE, OR THE CURRENT MIP FILE. WHEN ALTERNATING BETWEEN A     JJJ0913
*     DATA FILE AND ITS ASSOCIATED MIP FILE, THIS IS THE ROUTINE         JJJ0913
*     THAT MAKES THE SWITCH EITHER WAY.                                  JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THERE IS ONE PARAMETER, PASSED IN THE REGULAR SYMPL WAY.           JJJ0913
*     IF THIS IS 0, THE MAIN OR ONLY (DATA) FILE SPECIFIED BY THE        JJJ0913
*     CURRENT FIT IS THE ONE TO INITIALIZE ON.                           JJJ0913
*     IF THE PARAMETER IS NON-ZERO, THE MIP FILE SPECIFIED BY THE        JJJ0913
*     CURRENT FIT IS THE ONE TO INITIALIZE ON.                           JJJ0913
*                                                                        JJJ0913
*     P<FIT$AA> MUST CONTAIN THE FWA OF THE CURRENT FIT, AND THE         JJJ0913
*     FILE OR FILES MUST HAVE BEEN OPENED ALREADY.                       JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     THE INCOMING PARAMETER HAS BEEN COPIED INTO VARIABLE MIPMODE,      JJJ0913
*     AS A CONVENIENT INDICATION TO EVERYBODY OF WHAT KIND OF FILE       JJJ0913
*     WE ARE CURRENTLY WORKING ON.                                       JJJ0913
*                                                                        JJJ0913
*     OUTKEY HAS BEEN SET TO THE NUMBER OF WORDS OF NON-EMBEDDED KEY     JJJ0913
*     AT THE BEGINNING OF EVERY RECORD IN THE FILE.                      JJJ0913
*     NOTE THAT THIS MUST BE 0 FOR AN AK FILE, EVEN WHEN THE KEYS        FOOT 
*     ARE NONEMBEDDED, BECAUSE AN AK KEY IS INHERENT IN THE              FOOT 
*     RECORD POSITION AND SO WE DONT USE AN EXTRA WORD                   FOOT 
*     TO STORE IT.                                                       FOOT 
*                                                                        JJJ0913
*     P<FSTT$AA> , P<PTRE$AA> , AND P<FINF$AA> HAVE BEEN SET.            JJJ0913
*                                                                        CY210
*     SAMKLOC, SAMKPOS, AND SAMKLENG ARE COPIES OF KLOC, KPOS, AND       CY210
*       KLENG IN THE FSTT, WHICH GIVE THE POSITION AND LENGTH OF         CY210
*       THE KEY WITHIN EACH DATA RECORD OF THE FILE. HOWEVER, IF         CY210
*       THE KEY IS NON-EMBEDDED, KPOS AND KLOC CANNOT BE SO              CY210
*       INTERPRETED, AND SAMKLENG=0. ALSO, IF THE FILE HAS COMPRESSION   CY210
*       (FSCOMPACT[0] NOT 0) EVERY RECORD AS IT SITS IN THE FILE         CY210
*       WILL HAVE THE KEY AT THE BEGINNING REGARDLESS.                   CY210
*                                                                        CY210
*     TOMPLEFF AND TOMPES ARE COPIES OF KLOC AND KPOS UNLESS THE         CY210
*       KEY IS NON-EMBEDDED OR THERE IS COMPRESSION, IN WHICH            CY210
*       CASE THEY ARE BOTH 0. THUS THEY TELL DIRECTLY WHERE TO           CY210
*       FIND THE KEY IN A DATA RECORD.                                   CY210
*                                                                        CY210
*     KEYLNGW IS THE KEY LENGTH IN WORDS AND PARTIAL WORDS,              CY210
*       I.E. (KLENG+9)/10 .                                              CY210
*                                                                        CY210
*     CBUFAD AND CBUFSZ GIVE THE FWA AND THE LENGTH IN CHARACTERS        CY210
*       OF THE COMPRESSION BUFFER. IF CMM IS BEING USED, THIS IS         CY210
*       THE SAME FOR EVERY FILE, BUT IF NOT, THERE HAS TO BE A           CY210
*       SEPARATE ONE FOR EVERY FILE.                                     CY210
*                                                                        CY210
*                                                                        JJJ0913
*     INDXLNG HAS BEEN SET TO THE LENGTH IN WORDS THAT AN INDEX          JJJ0913
*     RECORD IN THE CURRENT FILE OR SUBFILE WOULD HAVE TO HAVE           JJJ0913
*     (IF IT IS NOT I-S, THIS IS UNNECESSARY BUT HARMLESS.)              JJJ0913
*                                                                        JJJ0913
*     IF MIP, WE ARE POSITIONED, AS TO P<PTRE$AA> AND P<FINF$AA>,        JJJ0913
*     ON THE RIGHT SUBFILE AT THE RIGHT LEVEL.                           JJJ0913
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     LEVL$MP - TO GET US TO THE RIGHT LEVEL OF THE POSSIBLE 3,          JJJ0913
*       IF MIP.                                                          JJJ0913
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
 #                                                                       JJJ0913
                             #START OF STMD$AA CODE#                     JJJ0916
          ITEM MODE;                                                     JJJ0913
                                                                         JJJ0913
                                                                         JJJ0913
          MIPMODE= MODE ;                                                SAAM3
          OUTKEY = 0 ;                                                   SAAM3
          IF MODE EQ 0                                                   SAAM3
            THEN BEGIN #NOT MIP#                                         SAAM3
              P<FSTT$AA> = FTFSTT[0] ;                                   SAAM3
              P<PTRE$AA> = FADPTRADR[0] ;                                SAAM3
              P<FINF$AA> = P<FSTT$AA> + DOFFSFIDS;                       SAAM3MO
              SAMKLOC = KLOC ;                                           AFB0528
              SAMKPOS = KPOS ;                                           AFB0528
              SAMKLENG = KLENG ;                                         AFB0528
              INDXLNG = WLG(SAMKLENG+4) ;                                AFB0528
              KEYLNGW = WLG(SAMKLENG) ;                                  AFB0528
              IF FSKEYPOS[0] GR 9                                        AFB0528
                THEN BEGIN                                               AFB0528
                  IF FSFILEORG[0] NQ FO"AK"                              FOOT 
                    THEN BEGIN                                           FOOT 
                      OUTKEY = KEYLNGW ;                                 FOOT 
                    END                                                  FOOT 
                  SAMKLENG = 0 ;                                         AFB0528
                END                                                      AFB0528
              IF NOCMM AND FSCOMPACT[0] NQ 0                             AFB0528
                THEN BEGIN                                               AFB0528
                  CBUFAD = FSCOMPBUF[0] ;                                AFB0528
                  CBUFSZ = 10 * WLG(FSMAXREC[0]+10) ;                    AFB0528
                END                                                      AFB0528
              IF OUTKEY NQ 0                                             CY211
                THEN BEGIN
                  TOMPES = 0 ;
                  TOMPLEFF = 0 ;
                END 
                ELSE BEGIN
                  TOMPES = SAMKPOS ;
                  TOMPLEFF = SAMKLOC ;
                END 
            END                                                          SAAM3
            ELSE BEGIN # MIP FILE #                                      SAAM3
              IF FTMIPFS EQ 0 
              THEN
                  BEGIN 
                  MSEX(EC203) ; #NO MIP FILE#                            DABBLE 
                  END 
              P<FSTT$AA> = FTMIPFS[0] ;                                  SAAM3
              P<MPAT$AA> = FAMPATADR;                                    JJJ0519
              IF CURLEV EQ 0 THEN CURLEV = 1 ;                           SAAM3
              LEVL$MP (CURLEV);                                          JJJ0916
            END                                                          SAAM3
          END                                                            SAAM3
CONTROL EJECT;                                                           JJJ0913
PROC STOV$AA;                                                            JJJ0913
          BEGIN                                                          JJJ0913
                                                                         ID0913 
 #                                                                       JJJ0913
* *   STOV$AA - STEP TO FIRST LIVE RECORD OF NEXT BLOCK        PAGE 1    JJJ0913
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC STOV$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO MAKE THE FIRST RECORD OF THE NEXT BLOCK CURRENT, IN             JJJ0913
*     THE FILE OR SUBFILE TO WHICH THE CURRENT PTREE POINTS.             JJJ0913
*                                                                        JJJ0913
*     IN CASE THE NEXT BLOCK IS EMPTY, WHICH MAY HAPPEN RIGHT AFTER      JJJ0913
*     A BLOCK SPLIT, STOV$AA POSITIONS US AT ((RECORD 0)) IN THAT        JJJ0913
*     BLOCK. SEE THE DESCRIPTION OF LOCR$AA FOR THE DETAILS OF THIS.     JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THE CURRENT BLOCK MUST BE IN CORE, AND MUST HAVE A NON-ZERO        JJJ0913
*     BLOCFWD[0] POINTER IN ITS HEADER -- I.E. IT MUST NOT BE THE        JJJ0913
*     LAST BLOCK IN ITS FILE OR SUBFILE.                                 JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     THE NEXT BLOCK IN THE FILE CHAIN IS NOW CURRENT AND IN CORE,       JJJ0913
*     AND ITS ADDRESS IS IN THE CURRENT WORD OF THE PTREE.               JJJ0913
*                                                                        JJJ0913
*     IF THIS BLOCK CONTAINS ANY RECORDS, THE NUMBER OF THE FIRST        JJJ0913
*     LIVE RECORD IS IN THE PTREE WORD, AND RECFWA, RECLWA, AND          JJJ0913
*     RECLG LOCATE THIS RECORD.                                          JJJ0913
*                                                                        JJJ0913
*     IF THE BLOCK IS EMPTY, THE RECORD NUMBER IN THE PTREE WORD         JJJ0913
*     IS 0, RECFWA AND RECLWA CONTAIN THE ADDRESS OF THE FIRST           JJJ0913
*     WORD OF RECORD SPACE IN THE BLOCK, AND RECLG = 0.                  JJJ0913
*     IF CURPTR NOT 0, PTCUREC[0] = 0 TO INDICATE THE PTREE IS NOT ALL   CY210
*     TRUE.                                                              JJJ1130
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     DABL$AA - TO LOCATE AND READ IN THE NEXT BLOCK, AND MAKE IT        JJJ0913
*       CURRENT IN THE PTREE.                                            JJJ0913
*     LOCR$AA - TO SET RECFWA, RECLWA, AND RECLG IF THE BLOCK IS EMPTY.  JJJ0913
*     STPF$AA - TO MAKE THE FIRST LIVE RECORD CURRENT, IF NOT EMPTY.     JJJ0913
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
 #                                                                       JJJ0913
                                                                         JJJ0913
                             #START OF STOV$AA CODE#                     ID0913 
          DABL$AA ( FWD , 1 ) ;                                          SAAM3
          IF CURPTR NQ 0                                                 JJJ1130
          THEN                                                           JJJ1130
              BEGIN                                                      JJJ1130
          PTCUREC = 0 ;                                                  CREATEM
              END                                                        JJJ1130
          PTCUREC[CURPTR] = 0 ;                                          SAAM3
          IF RC EQ 0                                                     SAAM3
            THEN LOCR$AA ( 0 ) ;                                         SAAM3
            ELSE STPF$AA ;                                               SAAM3
          END                                                            SAAM3
CONTROL EJECT;                                                           SAAM3MO
PROC STPF$AA;                                                            SAAM3MO
          BEGIN                                                          SAAM3MO
                                                                         ID0913 
 #                                                                       JJJ0913
* *   STPF$AA - STEP FORWARD ONE LIVE RECORD WITHIN THE BLOCK   PAGE  1  JJJ0916
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC STPF$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO MOVE FORWARD TO THE NEXT LIVE RECORD IN THE CURRENT BLOCK,      JJJ0913
*     AND ALTER THE PTREE ACCORDINGLY. IF DONE, SET FAIL=0. IF NOT,      JJJ0913
*     BECAUSE WE WERE ALREADY ON THE LAST RECORD OF THE BLOCK,           JJJ0913
*     LEAVE EVERYTHING ELSE UNCHANGED BUT SET FAIL=1.                    JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THE PTREE SHOWS A CERTAIN RECORD IN A CERTAIN BLOCK TO BE          JJJ0913
*     CURRENT, AND THE BLOCK MUST BE IN CORE.                            JJJ0913
*                                                                        JJJ0913
*     THE CURRENT RECORD MAY BE DEAD OR ALIVE.                           JJJ0913
*                                                                        JJJ0913
*     THE CURRENT RECORD NUMBER IS ALLOWED TO BE 0.                      JJJ0913
*     THIS IS SO THAT WE CAN LOCATE THE FIRST LIVE RECORD IN A BLOCK     JJJ0913
*     BY SETTING THE CURRENT RECORD NUMBER TO 0 AND THEN CALLING         JJJ0913
*     STPF$AA.                                                           JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     IF FAIL = 0, WE HAVE MOVED TO THE NEXT LIVE RECORD IN THE BLOCK,   JJJ0913
*     THE PTREE HAS BEEN ALTERED ACCORDINGLY, AND RECFWA, RECLWA, AND    JJJ0913
*     RECLG CONTAIN THE FWA, LWA+1, AND LENGTH IN WORDS OF THE RECORD.   JJJ0913
*                                                                        JJJ0913
*     IF THIS IS THE LAST RECORD IN THE FILE, THE QLR FLAG IN THE        JJJ0913
*     PTREE HAS BEEN SET TO 1.                                           JJJ0913
*                                                                        JJJ0913
*     HOWEVER, THE QFR FLAG IN THE PTREE WILL NOT HAVE BEEN ALTERED.     JJJ0913
*     THIS IS LEFT TO THE CALLING ROUTINE.                               JJJ0913
*                                                                        JJJ0913
*     IF FAIL IS NOT 0, NONE OF THE ABOVE HAS BEEN DONE. HOWEVER, WE     JJJ0913
*     THEN KNOW THAT WE WERE ALREADY, AND HAVE REMAINED, ON THE LAST     JJJ0913
*     RECORD OF THE BLOCK, WHICH IS NECESSARILY A LIVE ONE.              JJJ0913
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     UUCC$AA - TO FETCH THE UNUSED CHARACTER COUNT OF A GIVEN RECORD.   JJJ0913
*       THIS IS TO SEE IF THE RECORD IS DEAD -- SINCE A CHARACTER COUNT  JJJ0913
*       COULD NOT BE GREATER THAN 9, A VALUE OF 15 IN THIS FIELD OF THE  JJJ0913
*       RECORD POINTER IS USED TO DENOTE A DEAD RECORD (DELETED BUT NOT  JJJ0913
*       SQUEEZED OUT OF THE BLOCK).                                      JJJ0913
*     SETR$AA - TO DO ALL THE WORK OF MOVING TO THE NEXT RECORD, IF      JJJ0913
*       THERE IS A LIVE ONE TO MOVE TO.                                  JJJ0913
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     FAIL IS USED TO PASS THE RESULT BACK TO THE CALLER.                JJJ0913
*                                                                        JJJ0913
 #                                                                       JJJ0913
          ITEM TRC;          #TEMPORARY RECORD NUMBER#                   SAAM3MO
                                                                         JJJ0913
                             #START OF STPF$AA CODE#                     ID0913 
          FAIL = 1 ;                                                     SAAM3
          IF UR NQ 0                                                     SAAM3
          THEN                                                           SAAM3MO
            BEGIN                                                        SAAM3MO
            TRC = PTCUREC[CURPTR] + 1;                                   SAAM3MO
            IF TRC LQ RC    THEN FAIL = 0;                               SAAM3MO
                                                                         SAAM3MO
            END                                                          SAAM3MO
          ELSE                                                           SAAM3MO
            BEGIN                                                        SAAM3MO
            FOR TRC = PTCUREC[CURPTR]+1 STEP 1 UNTIL RC                  SAAM3MO
              DO                                                         SAAM3MO
              BEGIN                                                      SAAM3MO
              IF UUCC$AA ( TRC ) LS ALIEN                                AFB0801
              THEN                                                       SAAM3MO
                BEGIN                                                    SAAM3MO
                FAIL = 0;                                                SAAM3MO
                GOTO STEPFA;                                             SAAM3MO
                                                                         SAAM3MO
                END                                                      SAAM3MO
              END                                                        SAAM3MO
            END                                                          SAAM3MO
STEPFA:   IF FAIL EQ 0                                                   SAAM3MO
          THEN                                                           SAAM3MO
            BEGIN                                                        SAAM3MO
            SETR$AA (TRC);                                               SAAM3MO
            IF TRC EQ RC AND FWD EQ 0   THEN QLR = 1;                    SAAM3MO
            END                                                          SAAM3MO
          END                #END OF STPF$AA#                            SAAM3MO
CONTROL EJECT;                                                           JJJ0913
PROC TROW$AA (N);                                                        JJJ0913
          BEGIN                                                          JJJ0913
                                                                         ID0913 
 #                                                                       JJJ0913
* *   TROW$AA - LOOK AT A BLOCK THAT HAS BEEN FIXED BY FIXX$AA  PAGE  1  JJJ0916
* *   A.F.R.BROWN                                                        JJJ0913
* 1DC TROW$AA                                                            JJJ0913
*                                                                        JJJ0913
* DC  FUNCTION                                                           JJJ0913
*                                                                        JJJ0913
*     TO SET P<BLOK$AA> AND BLOCLWA TO POINT TO A DIFFERENT BLOCK        JJJ0913
*     WHOSE FWA HAS BEEN SAVED IN ARRAY FIXHOLD BY ROUTINE FIXX$AA.      JJJ0913
*     THIS IS REALLY JUST A SPECIALIZED CASE OF HAWK$AA, BUT IT HAPPENS  JJJ0913
*     OFTEN ENOUGH TO MAKE IT PROFITABLE TO CODE TROW$AA, AND CALL IT    JJJ0913
*     WITH A RATHER BRIEFER CALLING SEQUENCE IN SYMPL.                   JJJ0913
*                                                                        JJJ0913
* DC  ENTRY CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     THERE IS ONE PARAMETER, PASSED IN THE NORMAL SYMPL WAY, BETWEEN    JJJ0913
*     0 AND 3. THE WANTED BLOCK MUST HAVE BEEN FROZEN BY FIXX$AA(N),     JJJ0913
*     WHERE N HAD THAT SAME VALUE, AND NOT YET RELEASED BY UNFX$AA.      JJJ0913
*                                                                        JJJ0913
* DC  EXIT CONDITIONS                                                    JJJ0913
*                                                                        JJJ0913
*     THE WANTED BLOCK IS NOW CURRENT IN THE GENERAL SENSE, EVEN         JJJ0913
*     THOUGH IT MAY NOT BE MENTIONED AT ALL IN THE PTREE.                JJJ0913
*                                                                        JJJ0913
*     P<BLOK$AA> CONTAINS ITS FWA, AND BLOCLWA ITS LWA+1.                JJJ0913
*                                                                        CY210
*     TEMPLOFF AND TEMPOS HAVE BEEN SET TO THE OFFSET IN WORDS AND       CY210
*       CHARACTERS, FROM THE START OF ANY RECORD IN THIS BLOCK TO THE    CY210
*       FIRST CHARACTER OF ITS KEY.                                      CY210
*                                                                        JJJ0913
* DC  ERROR CONDITIONS                                                   JJJ0913
*                                                                        JJJ0913
*     NONE ARE DETECTED HERE. IF THE CONTENT OF FIXHOLD[N] IS WRONG      JJJ0913
*     AT THIS POINT, THINGS WILL FALL APART.                             JJJ0913
*                                                                        JJJ0913
* DC  CALLED ROUTINES                                                    JJJ0913
*                                                                        JJJ0913
*     HAWK$AA - TROW$AA COULD BE CALLED A ((FRONT END)) FOR THIS.        JJJ0913
*                                                                        JJJ0913
* DC  NON-LOCAL VARIABLES                                                JJJ0913
*                                                                        JJJ0913
*     NONE                                                               JJJ0913
*                                                                        JJJ0913
 #                                                                       JJJ0913
          ITEM N;            #WHICH BLOCK IN FIXHOLD#                    JJJ0913
                                                                         JJJ0913
                                                                         JJJ0913
          HAWK$AA ( FIXHOLD[N] ) ;                                       SAAM3
          END                                                            SAAM3
CONTROL EJECT;                                                           ID0913 
PROC UNCH$AA ( (N) );                                                    ID0913 
          BEGIN                                                          ID0913 
                                                                         ID0913 
 #                                                                       ID0913 
* *   UNCH$AA - DELINK A WORD FROM A TWO-WAY CHAIN            PAGE 1     ID0913 
* *   A.F.R.BROWN                                                        ID0913 
* 1DC UNCH$AA                                                            ID0913 
*                                                                        ID0913 
* DC  FUNCTION                                                           ID0913 
*                                                                        ID0913 
*     TO TAKE A WORD THAT IS NOW PART OF A FORWARDS-AND-BACKWARDS        ID0913 
*     CHAIN, ZERO ITS RIGHTMOST 18 BITS AS A SIGN THAT IT IS NO          ID0913 
*     LONGER IN A CHAIN, AND RELINK ITS PREDECESSOR AND SUCCESSOR IN     ID0913 
*     THE CHAIN TO EACH OTHER.                                           ID0913 
*                                                                        ID0913 
* DC  ENTRY CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     THERE IS ONE PARAMETER, PASSED IN THE USUAL SYMPL WAY. THIS IS     ID0913 
*     THE ADDRESS OF THE WORD, IN WHICH BITS 0-17 CONTAIN THE ADDRESS    ID0913 
*     OF THE SUCCESSOR IN THE CHAIN, AND BITS 18-35 CONTAIN THE          ID0913 
*     ADDRESS OF THE PREDECESSOR. THE CHAIN IS CIRCULAR, AND BEGINS      ID0913 
*     AND ENDS AT SOME STABLE WORD, WHOSE TWO POINTERS MERELY POINT      ID0913 
*     TO ITSELF WHEN THE CHAIN IS LOGICALLY EMPTY.                       ID0913 
*                                                                        ID0913 
* DC  EXIT CONDITIONS                                                    ID0913 
*                                                                        ID0913 
*     THE PREDECESSOR AND SUCCESSOR WORDS NOW POINT TO EACH OTHER        ID0913 
*     INSTEAD OF TO THE WORD THAT HAS BEEN REMOVED FROM THE CHAIN,       ID0913 
*     AND BITS 0-17 OF THE WORD HAVE BEEN ZEROED AS A MARK OF ITS NOT    ID0913 
*     BEING IN ANY CHAIN.                                                ID0913 
*                                                                        ID0913 
* DC  ERROR CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     FATAL ERROR, IMPLYING A FAULT IN OUR LOGIC, IF BITS 0-17 OF        ID0913 
*     THE SPECIFIED WORD ARE 0 ON ENTRY, FOR THIS MEANS IT IS NOT IN     ID0913 
*     ANY CHAIN.                                                         ID0913 
*                                                                        ID0913 
* DC  CALLED ROUTINES                                                    ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
* DC  NON-LOCAL VARIABLES                                                ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
 #                                                                       ID0913 
          ITEM N;                                                        ID0913 
                                                                         ID0913 
                             #START OF UNCH$AA CODE#                     ID0913 
          T1 = B<42,18> W[N];                                            ID0913 
          IF T1 NQ 0                                                     ID0913 
          THEN                                                           ID0913 
            BEGIN                                                        ID0913 
            B<42,18>W[N] = 0;                                            ID0913 
            T2 = B<24,18>W[N];                                           ID0913 
            B<24,18>W[T1] = T2;                                          ID0913 
            B<42,18>W[T2] = T1;                                          ID0913 
            END                                                          ID0913 
          ELSE
              BEGIN 
              IMPOSSIBLE(UNCHNER);
              END 
          END                                                            ID0913 
CONTROL EJECT;                                                           ID0913 
PROC UNFX$AA ( N );                                                      ID0913 
          BEGIN                                                          ID0913 
                                                                         ID0913 
 #                                                                       ID0913 
* *   UNFX$AA - RELEASE A FROZEN BLOCK TO THE K-O CHAIN        PAGE 1    ID0913 
* *   A.F.R.BROWN                                                        ID0913 
* 1DC UNFX$AA                                                            ID0913 
*                                                                        ID0913 
* DC  FUNCTION                                                           ID0913 
*                                                                        ID0913 
*     TO RETURN TO NORMAL STATUS A BLOCK OF SOME FILE, IN CORE, THAT     ID0913 
*     HAD BEEN TEMPORARILY REMOVED FROM THE KICK-OUT CHAIN, IN ORDER     ID0913 
*     TO MAKE SURE IT WOULD STAY IN CORE TILL FURTHER NOTICE, BY         ID0913 
*     ROUTINE FIXX$AA.                                                   ID0913 
*                                                                        ID0913 
* DC  ENTRY CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     THERE IS ONE PARAMETER, PASSED IN THE NORMAL SYMPL WAY.            ID0913 
*     THIS IS 0, 1, 2, OR 3, REFERRING TO THE FOUR WORDS IN ARRAY        ID0913 
*     FIXHOLD, BEING FOUR DIFFERENT HOOKS ON WHICH BLOCKS CAN BE         ID0913 
*     HUNG WHEN FROZEN BY FIXX$AA.                                       ID0913 
*                                                                        ID0913 
*     IF FIXHOLD[N] , N BEING THE PARAMETER, CONTAINS 0, THEN THERE      ID0913 
*     IS NO FROZEN BLOCK ON THIS HOOK, AND UNFX$AA DOES NOTHING.         ID0913 
*     THUS UNFX$AA IS ALLOWED TO BE CALLED EVEN WHEN WE ARE NOT SURE     ID0913 
*     IT IS NECESSARY.                                                   ID0913 
*                                                                        ID0913 
*     OTHERWISE, FIXHOLD[N] CONTAINS THE FWA OF THE BLOCK PARCEL.        ID0913 
*     THE BLOCK MUST NOT BE IN THE KICK-OUT CHAIN (I.E. BLFKOPTR[0]      ID0913 
*     IN ITS FRAME MUST BE 0.)                                           ID0913 
*                                                                        ID0913 
* DC  EXIT CONDITIONS                                                    ID0913 
*                                                                        ID0913 
*     FIXHOLD[N], N BEING THE INCOMING PARAMETER, HAS BEEN SET TO 0.     ID0913 
*                                                                        ID0913 
*     THE BLOCK HAS BEEN INSERTED AT THE HEAD OF THE KICK-OUT CHAIN.     ID0913 
*                                                                        ID0913 
* DC  ERROR CONDITIONS                                                   ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
* DC  CALLED ROUTINES                                                    ID0913 
*                                                                        ID0913 
*     INCH$AA - TO INSERT THE BLOCK IN THE KICK-OUT CHAIN.               ID0913 
*                                                                        ID0913 
* DC  NON-LOCAL VARIABLES                                                ID0913 
*                                                                        ID0913 
*     NONE                                                               ID0913 
*                                                                        ID0913 
 #                                                                       ID0913 
          ITEM N;            #WHICH FIXHOLD ENTRY#                       ID0913 
          ITEM X;            #LOCAL SCRATCH#                             ID0913 
                                                                         ID0913 
                             #START OF UNFX$AA CODE#                     ID0913 
          X = FIXHOLD[N] ;                                               SAAM3
          IF X NQ 0                                                      SAAM3
            THEN BEGIN                                                   SAAM3
              FIXHOLD[N] = 0 ;                                           SAAM3
              INCH$AA ( X , LOC(BFCHNHD) ) ;                             SAAM3
            END                                                          SAAM3
          END                                                            SAAM3
CONTROL EJECT;
PROC UNPTREE;                                                            CY210
      BEGIN                                                              CY210
 #                                                                       CY210
* *   UNPTREE -- DELINK A BLOCK IN CORE FROM ITS PTREE            PAGE 1 CY210
* *   A.F.R.BROWN                                                        CY210
* 1DC UNPTREE                                                            CY210
* DC  FUNCTION                                                           CY210
*                                                                        CY210
*     TO MAKE SURE THAT FOR A GIVEN FILE BLOCK IMAGE IN CORE, THERE IS   CY210
*     NO WORD IN A PTREE SOMEWHERE THAT POINTS TO IT. THIS HAS TO BE     CY210
*     DONE WHEN EITHER THE BLOCK IMAGE IS ABOUT TO BE KICKED OUT OF      CY210
*     CORE, OR A PTREE WORD IS ABOUT TO BE SET TO POINT TO IT. THE       CY210
*     FORMER IS THE PRIMARY REASON, BUT AS A BLOCK CAN POINT BACK TO     CY210
*     ONLY ONE PTREE WORD AT A TIME, WE MUST NOT ALLOW MORE THAN ONE     CY210
*     PTREE WORD AT A TIME TO POINT TO THE BLOCK. IF THERE WERE TWO      CY210
*     PTREE WORDS POINTING TO A BLOCK IN CORE, AND THE BLOCK WERE        CY210
*     ABOUT TO BE KICKED OUT, WE COULD FIND AND ADJUST ONLY ONE OF       CY210
*     THE PTREE WORDS, AND THE OTHER WOULD BE LEFT WITH A GARBAGE        CY210
*     POINTER.                                                           CY210
*                                                                        AM2A095
*     THERE IS ALWAYS A CHANCE, IF CMM IS PRESENT AND A FILE MAY         AM2A095
*     HAVE MORE THAN ONE FIT AND PTREE AT A TIME, THAT THE PTREE POIN-   AM2A095
*     TED TO BY THE BLOCK HAS ALREADY BEEN ABOLISHED. SO WE CHECK        AM2A095
*     TO SEE THAT THE WORD WE THINK IS IN THE PTREE ACTUALLY POINTS      AM2A095
*     BACK TO THIS BLOCK. A FURTHER COMPLICATION -- THE PLACE WHERE      AM2A095
*     THE PTREE USED TO BE MAY NOW BE BEYOND FL, SO WE HAVE TO GET       AM2A095
*     FL AND CHECK THAT TOO.                                             AM2A095
*                                                                        CY210
* DC  ENTRY CONDITIONS                                                   CY210
*                                                                        CY210
*     P<BLOK$AA> POINTS TO THE BLOCK IMAGE.                              CY210
*                                                                        CY210
* DC  EXIT CONDITIONS                                                    CY210
*                                                                        CY210
*     IF BLPTRADR[0] IN THE BLOCK FRAME POINTED TO A PTREE WORD, AND     CY210
*     THAT PTREE WORD POINTED BACK TO THE BLOCK, THE PTREE WORD HAS      CY210
*     BEEN RESET TO CONTAIN THE PRU NUMBER OF THE BLOCK RATHER THAN      CY210
*     THE ADDRESS OF THE BLOCK IMAGE.                                    CY210
*                                                                        CY210
*     NOTE THAT THOUGH IT CAN BE DISASTROUS IF A PTREE WORD CONTAINS     CY210
*     A FALSE POINTER TO A BLOCK IMAGE, IT DOES NOT MATTER IF A          CY210
*     BLOCK IMAGE CONTAINS A FALSE POINTER TO A PTREE WORD. BLPTRADR     CY210
*     IS ONLY SET IN A BLOCK IMAGE IN ORDER TO ALLOW THIS SUBROUTINE     CY210
*     TO WORK.                                                           CY210
*                                                                        CY210
* DC  ERROR CONDITIONS                                                   CY210
*                                                                        CY210
*     NONE                                                               CY210
*                                                                        CY210
* DC  CALLED ROUTINES                                                    CY210
*                                                                        CY210
*     NONE                                                               CY210
*                                                                        CY210
* DC  NON-LOCAL VARIABLES                                                CY210
*                                                                        CY210
*     NONE                                                               CY210
*                                                                        CY210
 #                                                                       CY210
      ITEM YY;                                                           CY210
                  # P<BLOK$AA> MUST BE SET #                             SAAM3
                  # PRESERVES P<PTRE$AA> #                               SAAM3
      YY = BLPTRADR[0] ;                                                 AM2A095
      IF YY NQ 0                                                         AM2A095
      THEN                                                               AM2A095
          BEGIN                                                          AM2A095
          IF NOT NOCMM                                                   AM2A095
          THEN                                                           AM2A095
              BEGIN                                                      AM2A095
              T1 = B<42,18>W[53] ;   #RA+65B#                            AM2A095
              T1 = B<42,18>W[-T1]  ;  #FL#                               AM2A095
              IF YY GQ T1                                                AM2A095
              THEN                                                       AM2A095
                  BEGIN                                                  AM2A095
                  RETURN ;                                               AM2A095
                  END                                                    AM2A095
              END                                                        AM2A095
          YY == P<PTRE$AA> ;                                             AM2A095
          IF PTBLKIN[0] NQ 0 AND PTCURBADR[0] EQ P<BLOK$AA>              AM2A095
          THEN                                                           AM2A095
              BEGIN                                                      AM2A095
              PTCURBLK[0] = BLOCKID[0] ;                                 AM2A095
              END                                                        AM2A095
          P<PTRE$AA> = YY ;                                              AM2A095
          END                                                            AM2A095
      END                                                                AM2A095
CONTROL EJECT;                                                           CIM0214
PROC VOKG$AA;                                                            CIM0214
        BEGIN                                                            CIM0214
 #                                                                       CIM0214
* *   VOKG$AA - VERIFY OK TO GET OR GETN       PAGE  1                   CIM0214
* *   CI MCDONALD                                                        CIM0214
* 1DC VOKG$AA                                                            CIM0214
* DC  FUNCTION                                                           CIM0214
*     VERIFY THAT A GET OR GETN MAY BE DONE ON A FILE.                   CIM0214
* DC  ENTRY CONDITIONS                                                   CIM0214
*     P<FIT$AA> = FIT ADDRESS.                                           CIM0214
* DC  EXIT CONDITIONS                                                    CIM0214
*     CONTROL IS RETURNED IF OK TO PROCEED WITH GET OR GETN.             CIM0214
* DC  ERROR CONDITIONS                                                   CIM0214
*     EC300 - NO READ PERMISSION.                                        CIM0214
*     EC421 - NO WSA SPECIFIED.                                          CIM0214
*     EC447 - KA=0 ON GET OR START                                       DABBLE 
* DC  CALLED ROUTINES                                                    CIM0214
*     MSGZ$AA - TO OUTPUT ERROR DIAGONSTICS.                             CIM0214
*     EXIT$AA - TO EXIT FOLLOWING ERROR DETECTION.                       CIM0214
* DC  DESCRIPTION                                                        CIM0214
*     VOKG$AA IS CALLED WHENEVER A GET OR GETN  IS TO BE DONE ON AN      CIM0214
*     AAM FILE.  THE PROGRAM IS A SERIES OF IF-TESTS CHECKING FOR THE    CIM0214
*     ERRORS LISTED UNDER -ERROR CONDITIONS-.  CONTROL IS RETURNED       CIM0214
*     IF NO ERRORS ARE DETECTED AND THE GET OR GETN MAY PROCEED.         CIM0214
*     OTHERWISE, A DIAGONSTIC MESSAGE IS GENERATED AND THE ERROR         CIM0214
*     EXIT (EXIT$AA) IS TAKEN.                                           CIM0214
 #                                                                       CIM0214
CONTROL EJECT;                                                           CIM0214
      IF FTRDB[0] EQ 0       #ERROR IF NO READ PERMISSION#               CIM0214
      THEN                                                               CIM0214
          BEGIN                                                          CIM0214
          ENUM = EC300; 
          GOTO ERR;                                                      CIM0214
          END                                                            CIM0214
      IF FTCOP[0] NQ OP"STR" AND FTWSA[0] EQ 0   #ERROR IF NO WSA#       CIM0214
      THEN                                                               CIM0214
          BEGIN                                                          CIM0214
          ENUM = EC421; 
          GOTO ERR;                                                      CIM0214
          END                                                            CIM0214
      IF FTCOP[0] NQ OP"GTN" AND FTKA[0] EQ 0                            DABBLE 
      THEN                                                               DABBLE 
          BEGIN                                                          DABBLE 
          ENUM = EC447 ;                                                 DABBLE 
          GOTO ERR ;                                                     DABBLE 
          END                                                            DABBLE 
      RETURN;                                                            JJJ0627
ERR:  
      MSGZ$AA (ENUM); 
      GOTO EXIT$AA; 
      END 
CONTROL EJECT ; 
PROC WRATEOI ;
      BEGIN 
  
 #
* *   WRATEOI - EXTEND THE FILE ON DISK BY ONE BLOCK         PAGE 1 
* *   A.F.R.BROWN 
* 1DC WRATEOI 
* 
* DC  FUNCTION
* 
*     TO WRITE ON DISK FOR THE FIRST TIME THE BLOCK OF THE CURRENT
*     FILE TO WHICH FSUNWR1[0] POINTS, AND TO ADJUST FSUNWR1[0] AND 
*     FSUNWR2[0] ACCORDINGLY. 
* 
* DC  ENTRY CONDITIONS
* 
*     FSUNWR1[0] POINTS TO THE IMAGE OF A BLOCK NEVER BEFORE
*       WRITTEN ON DISK.
*     FSNXTPRU[0] IS THE PRU NUMBER OF THAT BLOCK.
*     P<BLOK$AA> NEED NOT POINT TO THE BLOCK. 
* 
* DC  EXIT CONDITIONS 
* 
*     THE BLOCK HAS BEEN WRITTEN, AND P<BLOK$AA> PRESERVED. 
*     FSNXTPRU[0] HAS BEEN INCREASED BY FSBLKSIZ[0] . 
*     FSUNWR2[0] HAS BEEN COPIED INTO FSUNWR1[0] AND
*       THEN ZEROED.
* 
* DC  ERROR CONDITIONS
* 
*     NONE
* 
* DC  CALLED ROUTINES 
* 
*     IOWRITE - TO DO ALL THE WORK. 
*     WTIO$AA - TO TIDY UP. 
*     CHECKWRT - TO RETURN THE GOOD OR BAD I/O STATUS.
*     WTERRB - TO SIGNAL A FATAL ERROR IF THE I/O STATUS IS 
*       BAD. THERE IS NO PROMISING WAY TO RECOVER IF THE BAD
*       BLOCK IS AT THE END OF THE FILE. IF IT WERE IN THE
*       MIDDLE, WE COULD FAKE IT WITH A NEW BLOCK AT THE END
*       OF THE FILE.
* 
* DC  NON-LOCAL VARIABLES 
* 
*     NONE
* 
 #
  
          ITEM BLO ;
  
          BLO = P<BLOK$AA> ;
          P<BLOK$AA> = FSUNWR1[0] ; 
          IOWRITE ( 1 ) ; 
          WTIO$AA ; 
          IF CHECKWRT NQ 0
          THEN
              BEGIN 
              WTERRB ( EC136 ) ;
              END 
          P<BLOK$AA> = BLO ;
          END 
CONTROL EJECT ; 
PROC WTERRB ( N ) ; 
      BEGIN 
 #
* *   WTERRB/WTERR - ISSUE A FATAL WRITE ERROR
* *   A.F.R.BROWN 
* 1DC WTERRB/WTERR
* 
* DC  FUNCTION
* 
*     TO ISSUE A FATAL ERROR MESSAGE BECAUSE OF A BAD WRITE, AND TO CALL
*     FOR A FLUSH IF THE FILE IS NOT ALREADY BEING FLUSHED. IF THE CALL 
*     IS TO ENTRY POINT WTERRB RATHER THAN TO WTERR, THE ROUTINE
*     WILL FIRST FILL UP ANY UNUSED POSITIONS IN THE BADBLOX TABLE WITH 
*     3, A PRU NUMBER THAT COULD NEVER OTHERWISE APPEAR IN THAT TABLE.
*     THIS IS TO PREVENT THE TABLE BEING USED ON ANY FUTURE OCCASION
*     WHEN THIS FILE IS OPENED. 
* 
* DC  ENTRY CONDITIONS
* 
*     THERE IS ONE INCOMING PARAMETER, WHICH IS THE MESSAGE NUMBER. 
*     P<FSTT$AA> LOCATES THE FSTT OF THE CURRENT FILE.
*     P<FIT$AA> LOCATES THE CURRENT FIT.
*     FLSHFLG IS A VARIABLE THAT IS 0 EXCEPT WHEN A FLUSH IS IN 
*       PROGRESS. 
* 
* DC  EXIT CONDITIONS 
* 
*     IF THE CALL WAS THROUGH WTERRB, THE FSBADBLK TABLE IN THE 
*       FSTT HAS BEEN BLOCKED UP, AS EXPLAINED ABOVE. 
*       IF THROUGH WTERR, NOT.
*     FSRUINFLG[0] HAS BEEN SET TRUE. 
*     IF FLSHFLG IS 0,WE BRANCH TO EXIT$AA INSTEAD OF EXITING.
*       OTHERWISE, A FLUSH IS ALREADY IN PROGRESS, AND ALL WE 
*       CAN DO IS EXIT NORMALLY, BACK TO THE ROUTINE IN CONTROL 
*       OF THE FLUSH. 
*     IF THE FSTT BELONGS TO THE CURRENT OPERATION, AND FLSHFLG 
*     IS 0, WE CALL MSGF$AA RIGHT AWAY. OTHERWISE, JUST LEAVE THE 
*     ERROR NUMBER IN WORD FSFTERR OF THE CURRENT FSTT, AND ITS PARTNER 
*     FSTT IF ANY. (THE FATAL ERROR WILL BE DELCARED THE NEXT TIME AN 
*     OPERATION PERTAINING TO THAT FSTT OCCURS.) THEN EXIT NORMALLY . 
* 
* 
* DC  ERROR CONDITIONS
* 
*     NONE
* 
* DC  CALLED ROUTINES 
* 
*     MSGF$AA - TO ISSUE THE FATAL ERROR MESSAGE. 
* 
* DC  NON-LOCAL VARIABLES 
* 
*     NONE
* 
 #
          ITEM N ;
  
          FOR IX = 0 STEP 1 UNTIL 15
          DO
              BEGIN 
              IF FSBADBLK[IX] EQ 0
              THEN
                  BEGIN 
                  FSBADBLK[IX] = 2 + 2 * 2**30 ;
                   #PREVENT FURTHER USE OF BADBLK#
                  END 
              END 
          GOTO WTERRA ; 
  
     ENTRY PROC WTERR ( N ) ; 
     WTERRA:  
          FSFTERR[0] = N ;
          FSRUINFLG[0] = TRUE ; 
          IF FSMIPFSTT[0] NQ 0
          THEN
              BEGIN 
              FSFTERR[FSMIPFSTT[0]-P<FSTT$AA>] = N ;
              END 
          IF FLSHFLG NQ 0 
          THEN
              BEGIN 
              RETURN ;
              END 
          IF P<FSTT$AA> EQ FTFSTT[0] OR P<FSTT$AA> EQ FTMIPFS[0]
          THEN
              BEGIN 
              MSGF$AA ( N ) ; 
              GOTO EXIT$AA ;
              END 
          END 
CONTROL EJECT;                                                           SAAM3MO
     PROC WTIO$AA ; BEGIN ITEM XX , YY ;                                 JJJ1116
                                                                         JJJ0907
 #                                                                       JJJ0907
* *   WTIO$AA - WAIT FOR I-O COMPLETION ON A FET         PAGE  1         JJJ0916
* *   A.F.R.BROWN                                                        JJJ0907
* 1DC WTIO$AA                                                            JJJ0907
*                                                                        JJJ0907
* DC  FUNCTION                                                           JJJ0907
*                                                                        JJJ0907
*     TO WAIT FOR COMPLETION ON THE FET POINTED TO BY P<FET$AA> , IF     JJJ0907
*     NECESSARY, THEN TO COPY THE BLOCK LENGTH ( ACCORDING TO THE ((IN)) JJJ0907
*     POINTER ) AND THE CODE AND STATUS INTO THE BLOCK FRAME.            JJJ0907
*     THEN TO RESET THE CODE AND STATUS IN THE FET TO 1.                 JJJ0907
*                                                                        JJJ0907
* DC  ENTRY CONDITIONS                                                   JJJ0907
*                                                                        JJJ0907
*     P<FET$AA> MUST POINT TO THE FET IN QUESTION.                       JJJ0907
*                                                                        JJJ0907
* DC  EXIT CONDITIONS                                                    JJJ0907
*                                                                        JJJ0907
*     NO POINTERS ARE CHANGED. THE FET IS NOW FREE TO BE USED FOR        JJJ0907
*     ANOTHER BLOCK.                                                     JJJ0907
*                                                                        JJJ0907
* DC  ERROR CONDITIONS                                                   JJJ0907
*                                                                        JJJ0907
*     NONE -- THE ROUTINE THAT CALLED WTIO$AA WILL HAVE TO FIGURE WHAT   JJJ0907
*     TO DO IF THE BLOCK LENGTH OR CODE AND STATUS ARE WRONG.            JJJ0907
*                                                                        JJJ0907
* DC  CALLED ROUTINES                                                    JJJ0907
*                                                                        JJJ0907
*     CRA1$AA - TO DO A CIO RECALL.                                      CY210
*                                                                        JJJ0907
* DC  NON-LOCAL VARIABLES                                                JJJ0907
*                                                                        JJJ0907
*     NONE                                                               JJJ0907
*                                                                        JJJ0907
 #                                                                       JJJ0907
          IF FEFCSE[0] NQ 1                                              JJJ0216
            THEN BEGIN                                                   SAAM3
              IF FECMPLT[0] EQ 0                                         SAAM3
              THEN                                                       SAAM3
                  BEGIN                                                  SAAM3
                  CRA1$AA(DRCL,P<FET$AA>,1,0); #WAIT TILL COMPLETE#      SAAM3
                  FSRCLCNT = FSRCLCNT + 1;  # UDPATE RECALL COUNT  #
                  END                                                    SAAM3
              XX = P<BLOK$AA> ;                                          SAAM3
              P<BLOK$AA> = FEFIRST[0] - DBLKFRAME ; 
              BLRIP[0] = 0 ;                                             SAAM3
              BLCODSTAT[0] = FEFCSE[0] ;                                 JJJ0216
              IF BLWIP[0] EQ 0                                           JJJ1116
                THEN YY = FEIN[0] ;                                      JJJ1116
                ELSE YY = FEOUT[0] ;                                     JJJ1116
              BLKLNG[0] = YY - ( P<BLOK$AA> + DBLKFRAME ) ;              JJJ1116
              FEFCSE[0] = 1;                                             JJJ0216
              P<BLOK$AA> = XX ;                                          SAAM3
            END                                                          SAAM3
          END                                                            SAAM3
                                                                         SAAM3
          END   TERM                                                     SAAM3
