*DECK MISCDAA                                                            JJJ1015
          IDENT  MISC$AA                                                 JJJ1018
          LIST   -L                                                      MISCDAA
*CALL AAMCOMCMP                                                          JJJ1018
          LIST   *                                                       MISCDAA
          ENTRY  MOVW$AA,MOVC$AA,MUVW$AA,CPCH$AA,ALFB$AA                 JJJ1018
          LDSET  EPT=MOVC$AA/MOVW$AA/MUVW$AA/CPCH$AA/ALFB$AA             JJJ1018
          TITLE  MISC$AA - COLLECTION OF COMPASS ROUTINES                AM2A077
*#                                                                       JJJ1129
* *   MOVW$AA/MUVW$AA - MOVE A BLOCK OF WORDS IN CORE     PAGE  1        AM2A077
* *   A.F.R.BROWN                                                        CY211
* 1DC MOVW$AA / MUVW$AA                                                  CY211
*                                                                        CY211
* DC  FUNCTION                                                           CY211
*                                                                        CY211
*     TO COPY A BLOCK OF WORDS FROM ITS CURRENT LOCATION IN CORE         CY211
*     TO SOME OTHER LOCATION. IF THE LOCATIONS OVERLAP, THE COPY         CY211
*     AT THE DESTINATION WILL BE CORRECT.                                CY211
*                                                                        CY211
* DC  ENTRY CONDITIONS                                                   CY211
*                                                                        CY211
*     THERE ARE THREE PARAMETERS, PASSED IN THE STANDARD WAY             CY211
*     AS IN SYMPL PROGRAMS.                                              CY211
*     (1) THE FWA OF THE BLOCK TO BE COPIED.                             CY211
*     (2) ITS LENGTH IN WORDS.                                           CY211
*     (3) FOR MUVW$AA -- THE DISTANCE, POSITIVE OR NEGATIVE,             CY211
*            IN WORDS, BY WHICH THE BLOCK IS TO BE MOVED.                CY211
*         FOR MOVW$AA -- THE FWA OF THE AREA INTO WHICH THE              CY211
*            BLOCK IS TO BE COPIED.                                      CY211
*                                                                        CY211
* DC  EXIT CONDITIONS                                                    CY211
*                                                                        CY211
*     THE BLOCK HAS BEEN MOVED.                                          CY211
*                                                                        CY211
*     B1 = 1.                                                            CY211
*                                                                        CY211
* DC  ERROR CONDITIONS                                                   CY211
*                                                                        CY211
*     NONE                                                               CY211
*                                                                        CY211
* DC  CALLED ROUTINES                                                    CY211
*                                                                        CY211
*     NONE                                                               CY211
*                                                                        CY211
* DC  REGISTERS USED                                                     CY211
*                                                                        CY211
*     A1,A2,A3,A4,A6,X1,X2,X3,X4,X6,B1,B2,B3                             CY211
*#                                                                       JJJ1129
          TITLE  MOVW$AA/MUVW$AA - WORD MOVERS                           AM2A077
 MUVW$AA  BSS    0                                                       JJJ1018
MOVEX     DATA   0                                                       JJJ1018
          SX6    B0                                                      JJJ1018
MOVEXC    SB1    1                                                       JJJ1018
          SA2    A1+B1                                                   JJJ1018
          SA3    A2+B1                                                   JJJ1018
          SA1    X1                                                      JJJ1018
          SA2    X2                                                      JJJ1018
          ZR     X2,MOVEX                                                JJJ1018
          SA3    X3                                                      JJJ1018
          ZR     X3,MOVEX                                                JJJ1018
          SB2    X2                                                      JJJ1018
          SB3    X3                                                      JJJ1018
          ZR     X6,MOVEXD                                               JJJ1018
          IX3    X3-X1                                                   JJJ1018
          SB3    X3                                                      JJJ1018
MOVEXD    NG     B3,MOVEXA                                               JJJ1018
          SB2    B2-B1                                                   JJJ1018
MOVEXB    SA4    X1+B2                                                   JJJ1018
          BX6    X4                                                      JJJ1018
          SA6    A4+B3                                                   JJJ1018
          SB2    B2-B1                                                   JJJ1018
          PL     B2,MOVEXB                                               JJJ1018
          EQ     MOVEX                                                   JJJ1018
*                                                                        JJJ1018
MOVEXA    SA4    X1                                                      JJJ1018
          BX6    X4                                                      JJJ1018
          SA6    A4+B3                                                   JJJ1018
          SX1    X1+B1                                                   JJJ1018
          SB2    B2-B1                                                   JJJ1018
          NZ     B2,MOVEXA                                               JJJ1018
          EQ     MOVEX                                                   JJJ1018
          SPACE  1
 MOVW$AA  BSS    1
          SA2    MOVW$AA
          BX6    X2 
          SA6    MOVEX
          RJ     CLRSTAK     CLEAR INSTRUCTION STACK
 CLRSTAK  BSSZ   1
          EQ     MOVEXC 
          TITLE  MOVC$AA - CHARACTER STRING MOVER                        AM2A077
*#                                                                       JJJ1129
* *   MOVC$AA - MOVE A CHARACTER STRING IN CORE           PAGE  1        AM2A077
* *   A.F.R.BROWN                                                        CY211
* 1DC MOVC$AA                                                            CY211
*                                                                        CY211
* DC  FUNCTION                                                           CY211
*                                                                        CY211
*     TO COPY A STRING OF CHARACTERS, WHICH DOES NOT NECESSARILY         CY211
*     BEGIN OR END ON A WORD BOUNDARY, FROM ITS PRESENT POSITION         CY211
*     TO SOME OTHER POSITION IN CORE, WHICH ALSO NEED NOT BEGIN          CY211
*     OR END ON A WORD BOUNDARY. THE TWO POSITIONS MUST NOT OVERLAP OR   CY211
*     HAVE ANY WORD OF CORE IN COMMON. I.E. THERE MUST BE NO WORD OF     CY211
*     CORE THAT CONTAINS ONE OR MORE CHARACTERS OF THE STARTING STRING   CY211
*     AND IS INTENDED TO CONTAIN ONE OR MORE CHARACTERS OF THE           CY211
*     COPY. THIS POSSIBILITY IS NOT CHECKED FOR BY MOVC$AA.              CY211
*                                                                        CY211
* DC  ENTRY CONDITIONS                                                   CY211
*                                                                        CY211
*     THERE ARE 5 PARAMETERS, PASSED IN THE STANDARD MANNER AS FOR       CY211
*     SYMPL.                                                             CY211
*     (1) THE ADDRESS OF THE WORD IN WHICH THE FIRST CHARACTER OF        CY211
*       THE STARTING STRING OCCURS.                                      CY211
*     (2) THE DISTANCE IN CHARACTERS FROM THE START OF THAT WORD         CY211
*       TO THE FIRST CHARACTER OF THE STRING -- FROM 0 TO 9              CY211
*       INCLUSIVE.                                                       CY211
*     (3) THE ADDRESS OF THE WORD CONTAINING THE FIRST CHARACTER         CY211
*       OF THE DESTINATION.                                              CY211
*     (4) THE DISTANCE IN CHARACTERS FROM THE START OF THAT WORD         CY211
*       TO THE FIRST CHARACTER OF THE STRING -- FROM 0 TO 9              CY211
*       INCLUSIVE.                                                       CY211
*     THE SOURCE AND DESTINATION AREAS MUST NOT OVERLAP, OR EVEN SHARE   CY211
*     A WORD OF CORE.                                                    CY211
*                                                                        CY211
* DC  EXIT CONDITIONS                                                    CY211
*                                                                        CY211
*     THE STRING HAS BEEN COPIED.                                        CY211
*                                                                        CY211
*     B1 = 1.                                                            CY211
*                                                                        CY211
* DC  ERROR CONDITIONS                                                   CY211
*                                                                        CY211
*     NONE                                                               CY211
*                                                                        CY211
* DC  CALLED ROUTINES                                                    CY211
*                                                                        CY211
*     NONE                                                               CY211
*                                                                        CY211
* DC  REGISTERS USED                                                     CY211
*                                                                        CY211
*     ALL BUT A0 AND A7.
*#                                                                       JJJ1129
          EJECT                                                          AM2A077
 MOVC$AA  BSS    0                 CHARACTER MOVE ROUTINES               JJJ1018
CHMOVE    DATA   0
          SB1    1
          SA2    A1+B1
          SA3    A2+B1
          SA4    A3+B1
          SA5    A4+B1
          SA5    X5 
          ZR     X5,CHMOVE   ZERO STRING LENGTH 
          SA1    X1 
          SX0    X1          X0=A 
          SA2    X2 
          SX7    X2          X7=B 
          SA3    X3 
          SB4    X3          B4=C 
          SA4    X4 
          SB6    X4          B6=D 
          SB5    X5          B5=E 
CHMOVQ    SA2    X7+CHMASK   X2=BMASK 
          IX5    X7+X7
          IX5    X5+X7
          LX5    1
          SB7    X5          B7=6*B 
CHMOVP    SA1    X0 
          BX1    X2*X1
          SA5    A1+B1
          BX5    -X2*X5 
          BX1    X1+X5
          LX1    X1,B7
          NZ     B6,CHMOVR
          SB5    B5-10
          NG     B5,CHMOVS
          BX6    X1 
          SA6    B4 
          ZR     B5,CHMOVE
          SB4    B4+B1
          SX0    X0+B1
          EQ     CHMOVP 
* 
CHMOVS    SA3    CHMASK+10+B5 
          SA4    B4 
          BX6    X3*X4
          BX1    -X3*X1 
          BX6    X6+X1
          SA6    A4 
          EQ     CHMOVE 
* 
CHMOVR    SB2    10 
          SB2    B2-B6       B2=10-D
          SB3    B5-B2       B3=F=E-(10-D)
          SX5    B2+B2
          SX5    X5+B2
          LX5    1
          SB2    X5          B2=60-6*D=R
          SA4    B4 
          LX1    X1,B2
          PL     B3,CHMOVT
          SA3    CHMASK+B5
          LX3    X3,B2
          BX6    X3*X4
          BX1    -X3*X1 
          BX6    X6+X1
          SA6    A4 
          EQ     CHMOVE 
* 
CHMOVT    SA5    CHMASK+B6
          BX6    -X5*X4 
          BX1    X5*X1
          BX6    X6+X1
          SA6    A4 
          ZR     B3,CHMOVE
          SB4    B4+B1
          SB5    B3 
          SB2    10 
          SB2    B2-B6       B2=Y=10-D
          SB6    B0          D=0
          SX7    X7+B2       B=B+Y
          SX6    X7-10
          NG     X6,CHMOVQ
          SX7    X6          B=B-10 
          SX0    X0+B1       A=A+1
          EQ     CHMOVQ 
          TITLE  CPCH$AA - COMPARE TWO KEYS                              AM2A077
*#                                                                       JJJ1129
* *   CPCH$AA - COMPARE TWO KEY VALUES                    PAGE  1        AM2A077
* *   A.F.R.BROWN                                                        CY211
* 1DC CPCH$AA                                                            CY211
*                                                                        CY211
* DC  FUNCTION                                                           CY211
*                                                                        CY211
*     TO COMPARE TWO CHARACTER STRINGS THAT FUNCTION AS KEY              CY211
*     VALUES, AND SET VARIABLE COND TO 0, GREATER THAN 0, OR             CY211
*     LESS THAN ZERO, ACCORDING AS THE FIRST-NAMED STRING                CY211
*     IS EQUAL TO, HIGHER THAN, OR LOWER THAN, THE SECOND-NAMED          CY211
*     STRING. THE EFFECT IS AS IF THE SECOND STRING WERE                 CY211
*     SUBTRACTED FROM THE FIRST, AND THE DIFFERENCE STORED AT            CY211
*     COND -- THOUGH THE MAGNITUDE IN COND CAN ONLY BE RELIED            CY211
*     ON TO BE CORRECT AS TO SIGN AND AS TO ZERO/NONZERO-NESS.           CY211
*                                                                        CY211
* DC  ENTRY CONDITIONS                                                   CY211
*                                                                        CY211
*     THERE ARE SIX PARAMETERS, PASSED IN THE STANDARD WAY AS            CY211
*     FOR SYMPL.                                                         CY211
*     (1) THE ADDRESS OF THE WORD CONTAINING THE FIRST CHARACTER         CY211
*       OF THE FIRST-NAMED KEY.                                          CY211
*     (2) THE DISTANCE IN CHARACTERS FROM THE START OF THAT              CY211
*       WORD TO THE START OF THE KEY -- 0 TO 9 INCLUSIVE.                CY211
*     (3) AND (4) -- THE SAME AS (1) AND (2), BUT FOR THE                CY211
*       SECOND-NAMED KEY.                                                CY211
*     (5) THE LENGTH OF BOTH KEYS, IN CHARACTERS.                        CY211
*     (6) THE TYPE OF BOTH KEYS. THIS CAN BE 1, 2, OR 3.                 CY211
*       THERE IS NO DIFFERENCE IN MEANING BETWEEN 1 AND 3. BOTH          CY211
*       OF THEM SAY THAT A KEY IS TO BE TREATED AS AN UNSIGNED           CY211
*       POSITIVE INTEGER OF WHATEVER LENGTH. TYPE 2, ON THE              CY211
*       OTHER HAND, SAYS THAT BOTH KEYS ARE 60-BIT SIGNED                CY211
*       INTEGERS, AND FURTHERMORE THAT THE KEYS ARE LOCATED              CY211
*       AS IF PARAMETERS (2) AND (4) WERE BOTH 0.                        CY211
*                                                                        CY211
* DC  EXIT CONDITIONS                                                    CY211
*                                                                        CY211
*     COND HAS BEEN SET AS DESCRIBED ABOVE UNDER ((FUNCTION)).           CY211
*                                                                        CY211
* DC  ERROR CONDITIONS                                                   CY211
*                                                                        CY211
*     NONE                                                               CY211
*                                                                        CY211
* DC  CALLED ROUTINES                                                    CY211
*                                                                        CY211
*     NONE                                                               CY211
*                                                                        CY211
* DC  REGISTERS USED                                                     CY211
*                                                                        CY211
*     ALL BUT A0 AND B6.                                                 CY211
*#                                                                       JJJ1129
          EJECT                                                          AM2A077
CHMASK    BSS    0                                                       JJJ1018
XXX       SET    0                                                       JJJ1018
          DUP    10,2                                                    JJJ1018
          VFD    XXX/0,*P/-0                                             JJJ1018
XXX       SET    XXX+6                                                   JJJ1018
*                                                                        JJJ1018
 CPCH$AA  BSS    0                 CHARACTER STRING COMPARE              JJJ1018
PARAGON   DATA   0                                                       JJJ1018
          SX6    B0                                                      JJJ1018
          SF.AA  GCOM$AA,COND,X6,,6                                      JJJ1018
          SB1    1                                                       JJJ1018
          SA2    A1+B1                                                   JJJ1018
          SA3    A2+B1                                                   JJJ1018
          SA4    A3+B1                                                   JJJ1018
          SA5    A4+B1                                                   JJJ1018
          SA1    X1          X1= A FWA                                   JJJ1018
          SA2    X2          X2= A OFFSET                                JJJ1018
          SX7    6                                                       JJJ1018
          IX0    X7*X2                                                   JJJ1018
          SB2    X0          B2= A OFFSET IN BITS                        JJJ1018
          SA2    CHMASK+X2                                               JJJ1018
          BX0    X2          X0= A MASK                                  JJJ1018
          SA3    X3          X3= B FWA                                   JJJ1018
          SA4    X4          X4= B OFFSET                                JJJ1018
          IX7    X7*X4                                                   JJJ1018
          SB3    X7          B3= B OFFSET IN BITS                        JJJ1018
          SA4    X4+CHMASK   X4= B MASK                                  JJJ1018
          SA2    A5+B1                                                   JJJ1018
          SA5    X5                                                      JJJ1018
          SB5    X5          B5= CHARACTER COUNT TO COMPARE              JJJ1018
          SA2    X2                                                      JJJ1018
          SB4    X2          B4= KEY TYPE                                JJJ1018
          SB7    10                                                      JJJ1018
          SX7    B4-2                                                    AFB0203
          NZ     X7,PARAGA   CHARACTERS                                  AFB0721
          SA2    X1                                                      AFB0203
          SA5    X3                                                      AFB0203
          IX7    X2-X5                                                   AFB0721
          BX6    X2-X5                                                   AFB0721
          PL     X6,PARAGF                                               AFB0203
          BX7    X2                                                      AFB0203
          NZ     X7,PARAGF                                               AFB0203
          BX7    -X5                                                     AFB0203
PARAGF    SF.AA  GCOM$AA,COND,X7                                         AFB0203
          EQ     PARAGON                                                 AFB0203
PARAGA    SA2    X1                                                      JJJ1018
          SX1    X1+B1                                                   JJJ1018
          ZR     B2,PARAGB                                               JJJ1018
          SA5    X1                                                      JJJ1018
          BX2    X0*X2                                                   JJJ1018
          BX5    -X0*X5                                                  JJJ1018
          BX2    X2+X5                                                   JJJ1018
          LX2    B2,X2                                                   JJJ1018
PARAGB    SA5    X3                                                      JJJ1018
          SX3    X3+B1                                                   JJJ1018
          ZR     B3,PARAGC                                               JJJ1018
          BX6    X4*X5                                                   JJJ1018
          SA5    X3                                                      JJJ1018
          BX5    -X4*X5                                                  JJJ1018
          BX5    X5+X6                                                   JJJ1018
          LX5    B3,X5                                                   JJJ1018
PARAGC    IX7    X2-X5                                                   JJJ1018
          NZ     X7,PARAGD                                               JJJ1018
          BX6    X2-X5
          NG     X6,PARAGD   -0 COMPARED TO +0
          SB5    B5-B7                                                   JJJ1018
          LE     B5,B0,PARAGON                                           JJJ1018
          EQ     PARAGA                                                  JJJ1018
*                                                                        JJJ1018
PARAGD    GE     B5,B7,PARAGE                                            AFB0203
          SA1    CHMASK+B5                                               JJJ1018
          BX2    -X1*X2                                                  JJJ1018
          BX5    -X1*X5                                                  JJJ1018
          IX7    X2-X5                                                   JJJ1018
          ZR     X7,PARAGON                                              JJJ1018
*                                                                        JJJ1018
PARAGE    BSS    0                                                       JJJ1018
          BX0    X2-X5       NO,STRAIGHT CHAR COMPARE                    JJJ1018
          PL     X0,PARAGF   LIKE SIGNS,DIFFERENCE OK                    JJJ1018
          BX7    X5          ELSE RESULT HAS SIGN OF 1ST,INVERTED        JJJ1018
          NZ     X7,PARAGF                                               AFB0214
          SX0    B1                                                      AFB0214
          BX7    X7-X0       AVOID +0 OR -0                              AFB0214
          EQ     PARAGF                                                  JJJ1018
          TITLE  CMM INTERFACE ROUTINES                                  AM2A077
          COMMENT **** CMM TRACE CODE PRESENT                        *** RPN0118
          SPACE  2                                                       RPN0118
          ENTRY  CMM$ALF                                                 RPN0118
*#                                                                       AM2A077
* *   CMM SYMPL INTERFACES                                               AM2A077
* 1DC CMM$ALF/ALFB$AA/CMM$FRF/CMM$GOS                                    AM2A077
* 0DC FUNCTION                                                           AM2A077
* 0   TO ACT AS A SYMPL INTERFACE TO CMM ROUTINES.                       AM2A077
* 0DC ENTRY CONDITIONS                                                   AM2A077
* 0   P<BLOK$AA> = CMM$ALF(BLOCKSIZE,SIZECODE,GROUPID);  (CMM.ALF +)     AM2A077
* 0   P<BLOK$AA> = ALFB$AA(BLOCKSIZE,SIZECODE,GROUPID);  (CMM.ALF)       AM2A077
* 0   CMM$FRF(P<BLOK$AA>);                                V              AM2A077
* 0   CMM$FRF(P<BLOK$AA>);                               (CMM.FRF)       AM2A077
* 0   P<ARRAY> = CMM$GOS;                                (CMM.GOS)       AM2A077
* 0   BLOCKSIZE IS IN WORDS. SIZECODE IS DEFINED IN THE CMM REFERENCE    AM2A077
*     MANUAL. WE USE 2 = SHRINK-AT-LWA. GROUPID IS NOT USED CURRENTLY    AM2A077
*     BUT IS PASSED.                                                     AM2A077
* 0   THE ENTRY CONDITIONS SHOWN ABOVE ARE MEANT TO ILLUSTRATE HOW THE   AM2A077
*     ROUTINES ARE USED.                                                 AM2A077
* 0DC EXIT CONDITIONS                                                    AM2A077
* 0   CMM$ALF - ANY TRANSIENT CAPSULE HAS BEEN UNLOADED.                 AM2A077
*               A PARCEL OF CMM HAS BEEN ALOCATED AND SET TO ZERO.       AM2A077
*               THE FWA OF THE PARCEL IS IN X6.                          AM2A077
* 0   ALFB$AA - SAME AS CMM$ALF EXCEPT PARCEL IS NOT ZEROED.             AM2A077
* 0   CMM$FRF - THE PARCEL HAS BEEN RETURNED TO CMM.                     AM2A077
* 0   CMM$GOS - THE ADDRESS OF THE CMM STATISTICS PARCEL IS IN X6.       AM2A077
* 0DC REGISTERS USED                                                     AM2A077
* 0   SINCE THESE ROUTINES ARE CALLED BY SYMPL, NO REGISTERS ARE SAVED.  AM2A077
 #                                                                       AM2A077
CMM$ALF   DATA   0                                                       RPN0118
          RJ     UTC         UNLOAD ALL TRANSIENT CAPSULES FIRST         RPN0524
          SA2    CMM$ALF     SAVE THE CALLERS ADDRESS FOR TRACE      *** RPN0118
          LX2    30                                                  *** RPN0118
          SX6    X2-1                                                *** RPN0118
          SA6    CMM$XYZ                                             *** RPN0118
          SA2    X1          X2 = BLOCK-SIZE                             RPN0118
          LX6    X2                                                      RPN0118
          SA6    SAVE        SAVE SIZE TO BE USED UPON RETURN FROM CMM   RPN0118
          SA3    A1+1                                                    RPN0118
          SA3    X3          X3 = SIZE-CODE                              RPN0118
          LX3    6           SIZE-CODE IN BITS 11-6                      RPN0118
          SA4    A1+2                                                    RPN0118
          SA4    X4          X4 = GROUP-ID                               RPN0118
          LX4    12          GROUP-ID IN BITS 28-12                      RPN0118
          BX3    X3+X4       MERGE SIZE-CODE AND GROUP-ID IN X3          RPN0118
          RJ     =XCMM.ALF                                               RPN0118
          BX6    X1          CMM.ALF RETURNS BLOCK-FWA IN X1             RPN0118
          BX7    -X7*X7      0 IN X7 FOR CLEARING PURPOSES               RPN0118
          SB1    1                                                       RPN0118
          SA1    SAVE                                                    RPN0118
          ZR     X1,CMM$ALF  NO MEMORY TO PRESET IF SIZE WAS ZERO        RPN0118
          SB7    X1          GET SIZE IN LOOP CONTROL REGISTER           RPN0118
LOOP      SB7    B7-B1       COMPUTE ADDRESS OF WORD TO CLEAR            RPN0118
          SA7    X6+B7                                                   RPN0118
          GT     B7,B0,LOOP                                              RPN0118
          EQ     CMM$ALF                                                 RPN0118
SAVE      BSS    1                                                       RPN0118
          ENTRY  CMM$XYZ                                             *** RPN0118
CMM$XYZ   DATA   0                                                   *** RPN0118
          SPACE  2                                                       RPN0118
 ALFB$AA  JP     *+400000B   ALOCATE FIXED BLOCK, NO CLEARING.           RPN0118
          SA2    ALFB$AA     SAVE THE CALLERS ADDRESS FOR TRACE      *** RPN0118
          RJ     UTC         UNLOAD TRANSIENT                            RPN0524
          LX2    30                                                  *** RPN0118
          SX6    X2-1                                                *** RPN0118
          SA6    CMM$XYZ                                             *** RPN0118
          SA2    X1          X2 = BLOCK-SIZE                             RPN0118
          SA3    A1+1                                                    RPN0118
          SA3    X3          X3 = SIZE-CODE                              RPN0118
          LX3    6           SIZE-CODE IN BITS 11-6                      RPN0118
          SA4    A1+2                                                    RPN0118
          SA4    X4          X4 = GROUP-ID                               RPN0118
          LX4    12          GROUP-ID IN BITS 28-12                      RPN0118
          BX3    X3+X4       MERGE SIZE-CODE AND GROUP-ID IN X3          RPN0118
          RJ     =XCMM.ALF                                               RPN0118
          BX6    X1          CMM.ALF RETURNS BLOCK-FWA IN X1             RPN0118
          EQ     ALFB$AA                                                 RPN0118
          SPACE  2                                                       RPN0524
 UTC      BSS    1                                                       RPN0524
          SB3    A1          SAVE A1                                     RPN0524
          RJ     =YRM$UTC    GO TRY UNLOAD TRANSIENT                     RPN0524
          SA1    B3          RESTORE A1                                  RPN0524
          EQ     UTC         EXIT                                        RPN0524
          SPACE  2                                                       RPN0118
          ENTRY  CMM$FRF                                                 RPN0118
                             THIS PROCEDURE FREES A FIXED-POSITION BLOCK RPN0118
                             WHOSE FIRST-WORD-ADDRESS IS GIVEN.          RPN0118
                             CALLING SEQUENCE IS                         RPN0118
                                                                         RPN0118
                               CALL CMM$FRF(P<ARRAY>);                   RPN0118
CMM$FRF   DATA   0                                                       RPN0118
          SA2    CMM$FRF     SAVE THE CALLERS ADDRESS FOR TRACE      *** RPN0118
          LX2    30                                                  *** RPN0118
          SX6    X2-1                                                *** RPN0118
          SA6    =XCMM$XYZ                                           *** RPN0118
          SA1    X1                                                      RPN0118
          RJ     =XCMM.FRF                                               RPN0118
          EQ     CMM$FRF                                                 RPN0118
*                                                                        JJJ1018
          ENTRY  CMM$GOS                                                 JJJ0402
CMM$GOS   DATA   0           GET CMM OVERFLOW STATS                      JJJ0402
          RJ     =XCMM.GOS                                               JJJ0402
          BX6    X1                                                      JJJ0402
          EQ     CMM$GOS                                                 JJJ0402
          TITLE  MDLO$AA - MODULO ROUTINE                                AM2A077
          ENTRY     MDLO$AA                                              JJJ1020
 MDLO$AA  DATA      0        FIND X1-X1/X2*X2                            JJJ1020
          SA2    A1+1                                                    JJJ1020
          SA1    X1                                                      JJJ1020
          SA2    X2                                                      JJJ1020
          PX6    X1                                                      JJJ1020
          PX7    X2                                                      JJJ1020
          NX7    X7                                                      JJJ1020
          FX7    X6/X7                                                   JJJ1020
          UX7    X7,B2                                                   JJJ1020
          LX7    X7,B2                                                   JJJ1020
          IX7    X7*X2                                                   JJJ1020
          IX6    X1-X7                                                   JJJ1020
          EQ     MDLO$AA                                                 JJJ1020
          TITLE  REPREIVE PROCESSING                                     AM2A077
          ENTRY  RPV$AA,RPVE$AA                                          JJJ1018
 #LFHED#  EQU    1       LENGTH OF LIST-OF-FILES HEADER 
RPV$AA    DATA   10HAAMFLUSH
* 
*************************************************** 
* 
*         THE WORD AT RPV$AA IS ALWAYS TO CONTAIN ((AAMFLUSH  ))
*         SO THAT ANY SYSTEM PROGRAM WITH ACCESS TO THE REPRIEVE
*         STACK CAN SEE WHETHER THIS (THE AAM REPRIEVE ROUTINE
*         THAT FLUSHES AAM FILES) IS ON THE STACK, AND CALL IT IF 
*         SO, WITHOUT LETTING ANY OTHER REPRIEVE ACTIONS HAPPEN.
* 
*************************************************** 
* 
          SA1    RPV$AA 
          BX6    X1 
          SA6    RPVEXX 
          SA2    =10LAAMFLUSH 
          BX6    X2 
          SA6    A1 
          SF.AA  GCOM$AA,REPVFLG,1
          SA1    =YLOF$RM 
          SX6    X1+#LFHED#  POINT TO FIRST WORD OF LIST
          SA6    L.O.F
          SA1    L.PAR
RPVE$AA   RJ     =XFLSH$AA   FLUSH ALL FILES
RPVEXX    DATA   0
 L.O.F    BSS    1
 L.PAR    VFD    42/0,18/L.O.F
          TITLE  VARIOUS AAM$AA ROUTINES RECODED IN COMPASS              AM2A077
*         IN SYMPL, AND HAVE BEEN MOVED HERE TO BE CODED IN              AFB0707
*         COMPASS AND RUN FASTER. THE SYMPL CODE HAS BEEN LEFT IN        AFB0707
*         SAAM3, BUT DEACTIVATED BY CONTROL STATEMENTS. IF ANY CHANGE    AFB0707
*         HAS TO BE MADE, MAKE IT TO THE SYMPL VERSION OF THE            AFB0707
*         ROUTINE FIRST, AND PREFERABLY TESTED IN THAT VERSION,          AFB0707
*         BEFORE THE COMPASS ROUTINE IS ALTERED AND TESTED.              AFB0707
*         THE SYMPL VERSION SHOULD BE CONSIDERED THE OFFICIAL ONE,       AFB0707
*         IN WHICH THE ACTION OF THE SUBROUTINE IS DEFINED, WHILE        AFB0707
*         THE COMPASS VERSION IS A SHORT CUT.                            AFB0707
*                                                                        AFB0707
          ENTRY  LWAD$AA,CPKY$AA,LOCR$AA,RPGT$AA,CKSM$AA                 AFB0707
*                                                                        AFB0707
*#                                                                       JJJ1129
* *   LWAD$AA - RETURN THE LWA+1 OF A SPECIFIED RECORD                   CY211
* *   A.F.R.BROWN                                                        CY211
* 1DC LWAD$AA                                                            CY211
*                                                                        CY211
*     SEE THE COMMENTS IN MODULE AAM$AA, PRECEDING A DEACTIVATED         CY211
*     COPY THAT REMAINS THERE, OF THIS SUBROUTINE CODED IN SYMPL.        CY211
*#                                                                       JJJ1129
LWAD$AA   DATA   0           LWAD$AA ( N )                               AFB0707
          SA2    X1                                                      AFB0707
          SX6    B0                                                      AFB0707
          ZR     X2,LWAD$AA  IF N EQ 0 THEN LWAD$AA = 0                  AFB0707
          SB1    1             ELSE BEGIN                                AFB0707
          SA3    BLOK$AA                                                 AFB0707
          RF.AA  GCOM$AA,BLOCLWA,4                                       AFB0707
          SA5    X3+4                                                    AFB0707
          PL     X5,LWADAB       IF UR NQ 0                              AFB0707
*             OR N EQ 1 IS OMITTED HERE BECAUSE THEN UR IS INDIFFERENT   AFB0707
          SA1    X4-1        THEN BEGIN M=RPFIELD(17.13.1)               AM2A089
          MX0    47                                                      AFB0707
          BX1    -X0*X1                                                  AFB0707
          IX6    X1*X2       LWAD$AA = N*M                               AM2A089
          EQ     LWAD$AA       END                                       AFB0707
*                                                                        AFB0707
LWADAB    SX3    X2+B1         ELSE LWA = RPFIELD(17,13,N)               AFB0707
          LX3    59                                                      AFB0707
          SX6    X3                                                      AFB0707
          IX7    X4-X6                                                   AFB0707
          SA1    X7                                                      AFB0707
          PL     X3,LWADAE                                               AFB0707
          AX1    30                                                      AFB0707
LWADAE    MX0    47                                                      AFB0707
          BX6    -X0*X1                                                  AFB0707
          EQ     LWAD$AA                                                 AFB0707
*#                                                                       JJJ1129
* *   LOCR$AA - LOCATE A RECORD BY NUMBER IN THE CURRENT BLOCK           CY211
* *   A.F.R.BROWN                                                        CY211
* 1DC LOCR$AA                                                            CY211
*                                                                        CY211
*     SEE THE COMMENTS IN MODULE AAM$AA, PRECEDING A DEACTIVATED         CY211
*     COPY THAT REMAINS THERE, OF THIS SUBROUTINE CODED IN SYMPL.        CY211
*#                                                                       JJJ1129
*                                                                        AFB0707
LOCRAC    VFD    42/0,18/*+1                                             JJJ0721
          VFD    60/0                                                    AFB0707
*                                                                        AFB0707
LOCRAK    SF.AA  GCOM$AA,RECLNG,X6,,6  RECLNG = RECLWA-RECFWA            AFB0707
*                                                                        AFB0707
LOCR$AA   DATA   0           LOCR$AA ( N )                               AFB0707
          SA2    X1                                                      AFB0707
          SX6    X2                                                      AFB0707
          SF.AA GCOM$AA,RNO,X6,,6 RNO = N                                AFB0707
          NZ     X6,LOCRAB   IF N EQ 0                                   AFB0707
          SA3    BLOK$AA       THEN BEGIN                                AFB0707
          SX7    X3+5                                                    AFB0707
          SF.AA  GCOM$AA,RECFWA,X7  RECFWA=BLOCFWA                       AFB0707
          SF.AA  GCOM$AA,RECLWA,X7  RECLWA=RECFWA                        AFB0707
          EQ     LOCRAK        END                                       AFB0707
*                                                                        AFB0707
LOCRAB    SX7    X6-1          ELSE BEGIN                                AFB0707
          SA7    LOCRAC+1                                                AFB0707
          SA1    A7-1                                                    AFB0707
          RJ     LWAD$AA       #LWAD$AA(N-1)#                            AFB0707
          SA1    BLOK$AA                                                 AFB0707
          SX2    X1+5                                                    AFB0707
          IX7    X2+X6                                                   AFB0707
          SF.AA GCOM$AA,RECFWA,X7         RECFWA=LWAD$AA(N-1)+BLOCFWA    AFB0707
          SA3    X2-1            IF UR EQ 0                              AFB0707
          NG     X3,LOCRAD         THEN BEGIN                            AFB0707
          SA4    LOCRAC+1                                                AFB0707
          SX5    X4+2                RPGT$AA(N)                          AFB0707
          LX5    59                                                      AFB0707
          SX0    X5          #RATHER THAN CALL RPGT$AA,WE DUPLICATE      AFB0707
          RF.AA GCOM$AA,BLOCLWA,1   PART OF IT HERE,THEN GO TO LOCRAG    AFB0707
          IX4    X1-X0       WITH RECPTR IN BITS 0-29 OF X3#             AFB0707
          SA3    X4                                                      AFB0707
          PL     X5,LOCRAG                                               AFB0707
          LX3    30                                                      AFB0707
          EQ     LOCRAG                                                  AFB0707
*                                                                        AFB0707
LOCRAD    BX2    X7          ELSE BEGIN #UR EQ 1#                        AFB0707
          RF.AA  GCOM$AA,BLOCLWA,4   RPGT$AA(1)                          AM2A089
          SA3    X4-1        #HERE WE TAKE A SHORTCUT TO GET RECPTR#     AFB0707
*                                                                        AFB0707
LOCRAG    MX0    30                                                      AFB0707
          BX6    -X0*X3                                                  AFB0707
          SF.AA  GCOM$AA,RECPTR,X6,,6                                    AFB0707
          MX0    47                                                      AFB0707
          BX4    -X0*X6                                                  AFB0707
          IX6    X4+X2                                                   AFB0707
          SF.AA GCOM$AA,RECLWA,X6,,6  RECLWA=LWAFIELD+BLOCFWA            AFB0707
          IX6    X6-X7                                                   AFB0707
          SF.AA GCOM$AA,RECLNG,X6,,6                                     AFB0707
          RF.AA  GCOM$AA,RECFWA,1 
          RF.AA  GCOM$AA,TEMPLOF,2
          IX7    X1+X2
          SF.AA  GCOM$AA,TEMPLOC,X7    TEMPLOC=RECFWA+TEMPLOFF
          EQ     LOCR$AA     END                                         AFB0707
*#                                                                       JJJ1129
* *   RPGT$AA - FETCH A RECORD POINTER FROM THE CURRENT BLOCK            CY211
* *   A.F.R.BROWN                                                        CY211
* 1DC RPGT$AA                                                            CY211
*                                                                        CY211
*     SEE THE COMMENTS IN MODULE AAM$AA, PRECEDING A DEACTIVATED         CY211
*     COPY THAT REMAINS THERE, OF THIS SUBROUTINE CODED IN SYMPL.        CY211
*#                                                                       JJJ1129
*                                                                        AFB0707
RPGT$AA   DATA   0           RPGT$AA ( N )                               AFB0707
          SA2    X1                                                      AFB0707
          SX2    X2+1                                                    AFB0707
          LX2    59                                                      AFB0707
          SX7    X2                                                      AFB0707
          RF.AA GCOM$AA,BLOCLWA,3                                        AFB0707
          IX4    X3-X7                                                   AFB0707
          SA5    X4                                                      AFB0707
          PL     X2,RPGTAB                                               AFB0707
          LX5    30                                                      AFB0707
RPGTAB    MX0    30                                                      AFB0707
          BX6    -X0*X5                                                  AFB0707
          SF.AA GCOM$AA,RECPTR,X6,,6  RECPTR=RPFIELD(0,30,N)             AFB0707
          EQ     RPGT$AA                                                 AFB0707
*#                                                                       JJJ1129
* *   CPKY$AA - COMPARE THE KEY OF A RECORD WITH THE GIVEN KEY           CY211
* *   A.F.R.BROWN                                                        CY211
* 1DC CPKY$AA                                                            CY211
*                                                                        CY211
*     SEE THE COMMENTS IN MODULE AAM$AA, PRECEDING A DEACTIVATED         CY211
*     COPY THAT REMAINS THERE, OF THIS SUBROUTINE CODED IN SYMPL.        CY211
*#                                                                       JJJ1129
*                                                                        AFB0707
CPKYAA    VFD    42/0,18/GCOM$AA+?KEYFWA                                 JJJ0721
          VFD    42/0,18/GCOM$AA+?KEYOFF                                 JJJ0721
          VFD    42/0,18/GCOM$AA+?TEMPLOC                                JJJ0721
          VFD    42/0,18/GCOM$AA+?TEMPOS                                 JJJ0721
          VFD    42/0,18/GCOM$AA+?MAJKEY                                 JJJ0721
          VFD    42/0,18/CPKYAB    KTYPE                                 JJJ0721
CPKYAB    DATA   0                                                       AFB0707
*                                                                        AFB0707
CPKY$AA   DATA   0           CPKY$AA( THETA )                            AFB0707
          RJ     LOCR$AA     LOCR$AA(THETA)                              AFB0707
          SA1    FINF$AA                                                 AFB0707
          SA2    X1+2                                                    AFB0707
          MX0    57                                                      AFB0707
          LX2    28                                                      AFB0707
          BX7    -X0*X2                                                  AFB0707
          SA7    CPKYAB      KTYPE                                       AFB0707
          SA1    CPKYAA                                                  AFB0707
          RJ     CPCH$AA  (KEYFWA,KEYOFF,TEMPLOC,TEMPOS,MAJKEY,KTYPE)    AFB0707
          RF.AA  GCOM$AA,COND,1   IF COND EQ 0                           AFB0707
          NZ     X1,CPKY$AA                                              AFB0707
          SA2    FINF$AA                                                 AFB0707
          SA3    X2+2                                                    AFB0707
          RF.AA  GCOM$AA,MAJKEY,4                                        AFB0707
          SX0    X3                                                      AFB0707
          IX1    X4-X0        AND MAJKEY LS KLENG                        AFB0707
          PL     X1,CPKY$AA    THEN BEGIN                                AFB0707
          RF.AA  GCOM$AA,QREL,5    IF QREL EQ REL.GT.                    AFB0707
          SX1    X5-6                                                    AFB0707
          MX6    59                                                      AFB0707
          NZ     X1,CPKYAD         ELSE COND = -1                        AFB0707
          SX6    1                 THEN COND = +1                        AFB0707
CPKYAD    SA6    A1                                                      AFB0707
          EQ     CPKY$AA     END                                         AFB0707
*                                                                        AFB0707
CKSM$AA   DATA   0                                                       AFB0707
          SA1    BLOK$AA                                                 AFB0707
          SB2    X1          B2=LOC(BLWRD0[0])                           AFB0707
          MX0    47                                                      AFB0707
          SX6    B0          J = 0                                       AFB0707
          SA2    X1+2                                                    AFB0707
          SB3    4           I = 4                                       AFB0707
          SB6    1           STEP = 1                                    AFB0707
          LX2    42                                                      AFB0707
          BX1    -X0*X2                                                  AFB0707
          SB1    X1+2        K = BLKLNG[0]+2                             AFB0707
CKSMA     SA5    B2+B3                                                   AFB0707
          IX6    X6+X5       J=J+BLWRD0[I]                               AFB0707
          SB3    B3+B6       I=I+STEP                                    AFB0707
          GE     B1,B3,CKSMA IF I LQ K                                   AFB0707
          MX0    30            THEN GOTO CKSMA                           AFB0707
          BX1    X0*X6                                                   AFB0707
          BX2    -X0*X6                                                  AFB0707
          LX1    30                                                      AFB0707
          IX7    X1+X2       J=B<0,30>J+B<30,30>J                        AFB0707
          BX6    -X0*X7      CKSM$AA=B<30,30>J                           AFB0707
          EQ     CKSM$AA                                                 AFB0707
*                                                                        AM2A089
          ENTRY  BNCH$AA                                                 AM2A089
          LDSET  EPT=BNCH$AA                                             AM2A089
BNCH$AA   DATA   0                                                       AM2A089
          SB1    1                                                       AM2A089
          SA1    FINF$AA                                                 AM2A089
          SA2    X1+2        KTYPE 2,25,3                                AM2A089
          AX2    32                                                      AM2A089
          MX0    57                                                      AM2A089
          BX6    -X0*X2                                                  AM2A089
          SX6    X6-2                                                    AM2A089
          NZ     X6,BINCHA                                               AM2A089
          SA1    BINSWA      TYPE 1                                      AM2A089
          RF.AA  GCOM$AA,KEYFWA,4                                        AM2A089
          SA5    X4          X5=KEY IF TYPE INTEGER                      AM2A089
          EQ     BINCHB                                                  AM2A089
*                                                                        AM2A089
BINCHA    RF.AA  GCOM$AA,TEMPOS,1                                        AM2A089
          NZ     X1,BINCHC                                               AM2A089
          RF.AA  GCOM$AA,KEYOFF,1                                        AM2A089
          NZ     X1,BINCHC                                               AM2A089
          SA1    BINSWB      BOTH START ON WD BDRY                       AM2A089
          EQ     BINCHB                                                  AM2A089
*                                                                        AM2A089
BINSWA    EQ     BINCMA                                                  AM2A089
BINSWB    EQ     BINCMB                                                  AM2A089
BINSWC    EQ     BINCMC                                                  AM2A089
*                                                                        AM2A089
BINCHC    SA1    BINSWC      GENERAL CASE                                AM2A089
BINCHB    BX6    X1                                                      AM2A089
          SA6    BINSW                                                   AM2A089
          SB2    B0          SMALREC=B2                                  AM2A089
          SA1    BLOK$AA                                                 AM2A089
          SA2    X1+4                                                    AM2A089
          BX7    X2          UR=X7 FOR NOW                               AM2A089
          LX2    22                                                      AM2A089
          MX0    47                                                      AM2A089
          BX3    -X0*X2      RC                                          AM2A089
          SB3    X3+B1       ZZ=B3                                       AM2A089
          SX4    A2+B1       BLOCFWA                                     AM2A089
          RF.AA  GCOM$AA,TEMPLOF,1                                       AM2A089
          IX2    X4+X1                                                   AM2A089
          SB6    X2          ALPHA=B6                                    AM2A089
          RF.AA  GCOM$AA,BLOCLWA,3                                       AM2A089
          SB5    X3-1        BLOCLWA-1 = B5                              AM2A089
          PL     X7,BINCHD                                               AM2A089
          SA4    B5                                                      AM2A089
          BX0    -X0*X4      BETA=X0                                     AM2A089
*         IF X0 .GT. 0, UR=1 AND X0=BETA.                                AM2A089
*         ELSE X0 IS A 47/13 MASK AND UR=0.                              AM2A089
*                                                                        AM2A089
BINCHD    SB7    B2+B1                                                   AM2A089
          GT     B3,B7,BINCHE    ZZ .GT. SMALREC+1                       AM2A089
          SX6    B2                                                      AM2A089
          SF.AA  GCOM$AA,SMALREC,X6,,6                                   AM2A089
          SX7    B0                                                      AM2A089
          SF.AA  GCOM$AA,MATRESL,X7                                      AM2A089
          EQ     BNCH$AA                                                 AM2A089
*                                                                        AM2A089
BINCHE    SX6    B2+B3                                                   AM2A089
          AX6    1           THETA = (SMALREC+ZZ)/2                      AM2A089
          SF.AA  GCOM$AA,MATRESL,X6,,6  JUST IN CASE                     AM2A089
          SX2    X6-1                                                    AM2A089
          ZR     X2,BINCHF                                               AM2A089
          NG     X0,BINCHG                                               AM2A089
          IX3    X2*X0       UR=1                                        AM2A089
          SA1    X3+B6       TEMPLOC=(THETA-1)*BETA+ALPHA                AM2A089
          EQ     CLEARIT
*                                                                        AM2A089
BINCHF    SA1    B6          THETA=1                                     AM2A089
          EQ     CLEARIT
*                                                                        AM2A089
BINCHG    BSS    0                                                       AM2A089
          SX2    X2-1        BACK UP ONE FOR NON UNIFORM RECORD          AM2A089
*                            THIS IS SO BECAUSE WE HAVE LWA + 1 IN EACH  AM2A089
*                            RECORD HEADER.                              AM2A089
          LX2    59          HALVE TO GET WORD OFFSET                    AM2A089
          SX4    X2                                                      AM2A089
          BX4    -X4                                                     AM2A089
          SA1    X4+B5                                                   AM2A089
          PL     X2,BINCHH                                               AM2A089
          AX1    30                                                      AM2A089
BINCHH    BX2    -X0*X1                                                  AM2A089
          SA1    X2+B6                                                   AM2A089
 CLEARIT  RJ     BINSW-1     CLEAR INSTRUCTION STACK
          BSSZ   1           RESERVED SPACE FOR PSEUDO RJ 
BINSW     EQ     BINCMA                                                  AM2A089
*                                                                        AM2A089
BINCMA    IX6    X5-X1                                                   AM2A089
          ZR     X6,BNCH$AA 
          BX1    X5-X1
          PL     X1,BINCHN   SAME SIGN,SO DIFF OK 
          BX6    X5          GET SIGN OF TRUE DIFF,ANYWAY 
BINCHN    RF.AA  GCOM$AA,MATRESL,1   =THETA                              AM2A089
          PL     X6,BINCHK                                               AM2A089
          SB3    X1          ZZ=THETA                                    AM2A089
          EQ     BINCHD                                                  AM2A089
*                                                                        AM2A089
BINCHK    SB2    X1          SMALREC=THETA                               AM2A089
          EQ     BINCHD                                                  AM2A089
*                                                                        AM2A089
BINCMB    RF.AA  GCOM$AA,MAJKEY,2                                        AM2A089
          SB7    X2                                                      AM2A089
          RF.AA  GCOM$AA,KEYFWA,4                                        AM2A089
          SA5    X4                                                      AM2A089
BINCHL    ZR     B7,BINCHQ                                               AM2A089
          BX7    X5-X1                                                   AM2A089
          PL     X7,BINCHM                                               AM2A089
          BX6    X1                                                      AM2A089
          EQ     BINCHN                                                  AM2A089
*                                                                        AM2A089
BINCHM    SB7    B7-10                                                   AM2A089
          PL     B7,BINCHO                                               AM2A089
          SA2    BINMAS+B7                                               AM2A089
          BX1    X2*X1                                                   AM2A089
          BX5    X2*X5                                                   AM2A089
          SB7    B0                                                      AM2A089
BINCHO    IX6    X5-X1                                                   AM2A089
          NZ     X6,BINCHN                                               AM2A089
          SA1    A1+B1                                                   AM2A089
          SA5    A5+B1                                                   AM2A089
          EQ     BINCHL                                                  AM2A089
*                                                                        AM2A089
BINCOV    BSSZ   1                                                       AM2A089
ZZZ       SET    6                                                       AM2A089
YYY       SET    54                                                      AM2A089
          DUP    9,3                                                     AM2A089
          VFD    ZZZ/-0,YYY/0                                            AM2A089
ZZZ       SET    ZZZ+6                                                   AM2A089
YYY       SET    YYY-6                                                   AM2A089
BINMAS    VFD    60/-0                                                   AM2A089
*                                                                        AM2A089
BINCMC    RF.AA  GCOM$AA,MAJKEY,2                                        AM2A089
          SB7    X2                                                      AM2A089
          RF.AA  GCOM$AA,KEYFWA,4                                        AM2A089
          SA5    X4                                                      AM2A089
          RF.AA  GCOM$AA,TEMPOS,3                                        AM2A089
          LX6    X3,B1                                                   AM2A089
          SA3    X3+BINCOV                                               AM2A089
          IX7    X6+X6                                                   AM2A089
          IX7    X7+X6                                                   AM2A089
          SB4    X7                                                      AM2A089
          RF.AA  GCOM$AA,KEYOFF,4                                        AM2A089
          LX6    X4,B1                                                   AM2A089
          SA4    X4+BINCOV                                               AM2A089
          IX7    X6+X6                                                   AM2A089
          IX7    X7+X6                                                   AM2A089
          SB5    X7                                                      AM2A089
*                                                                        AM2A089
BINCHP    ZR     B7,BINCHQ                                               AM2A089
          SA2    A1+B1                                                   AM2A089
          BX1    -X3*X1                                                  AM2A089
          BX2    X3*X2                                                   AM2A089
          BX1    X1+X2                                                   AM2A089
          LX1    X1,B4                                                   AM2A089
          SA2    A5+B1                                                   AM2A089
          BX5    -X4*X5                                                  AM2A089
          BX2    X4*X2                                                   AM2A089
          BX5    X5+X2                                                   AM2A089
          LX5    X5,B5                                                   AM2A089
          BX7    X5-X1                                                   AM2A089
          PL     X7,BINCHR                                               AM2A089
          BX6    X1                                                      AM2A089
          NZ     X6,BINCHT                                               AM2A089
          SX3    B1                                                      AM2A089
          BX6    X6-X3       BIAS RESULTS TO AVOID + OR - 0              AM2A089
BINCHT    RF.AA  GCOM$AA,BLOCLWA,3                                       AM2A089
          SB5    X3-1                                                    AM2A089
          EQ     BINCHN                                                  AM2A089
*                                                                        AM2A089
BINCHR    SB7    B7-10                                                   AM2A089
          PL     B7,BINCHS                                               AM2A089
          SA2    BINMAS+B7                                               AM2A089
          BX1    X2*X1                                                   AM2A089
          BX5    X2*X5                                                   AM2A089
          SB7    B0                                                      AM2A089
BINCHS    IX6    X5-X1                                                   AM2A089
          NZ     X6,BINCHT                                               AM2A089
          SA1    A1+B1                                                   AM2A089
          SA5    A5+B1                                                   AM2A089
          EQ     BINCHP                                                  AM2A089
*                                                                        AM2A089
BINCHQ    SA1    FINF$AA                                                 AM2A089
          SA2    X1+2                                                    AM2A089
          SX2    X2          KLENG  2,42,18                              AM2A089
          RF.AA  GCOM$AA,MAJKEY,1                                        AM2A089
          IX7    X1-X2                                                   AM2A089
          PL     X7,BNCH$AA                                              AM2A089
          RF.AA  GCOM$AA,QREL,1   MAJKEY .LS. KLENG                      AM2A089
          SX6    X1-6        REL#GT#                                     AM2A089
          EQ     BINCHT      X6=0 WILL COUNT +, ELSE -                   AM2A089
*                                                                        AM2A089
          END                                                            JJJ1018
