*DECK OPNMDAA                                                            OPNMDAA
          IDENT  OPNM$AA                                                 OPNMDAA
          LDSET  EPT=OPNM$AA
          LDSET  EPT=OPEN$AK/OPEN$DA/OPEN$IS
          LDSET  EPT=CLSF$AK/CLSF$DA/CLSF$IS
          SST                                                            JJJ0606
          LDSET  OMIT=CMM$ALF/CMM$FRF                                    JJJ0530
 OPNM$AA  CAP.RM
          ENTRY  INFO$AA
*#
* *       INFO$AA - MAKE FILINFO CALL 
*1CD      INFO$AA 
*         THIS ROUTINE CALLS FILINFO AND USES THE RETURNED INFORMATION
*         TO SET FILE PERMISIONS AND LENGTH OF FILE IN THE FIT
*0CD      ENTRY CONDITIONS
*         X1 POINTS TO A WORD CONTAINING THE FET ADDRESS OF THE FILE
*         IN QUESTION 
*0CD      EXIT CONDITIONS 
*         B1=1,BITS 30-0 OF FET+6 CONTAIN LENGTH OF FILE IN PRUS. 
*         BITS 23-20 OF FET+8 CONTAIN PERMISION BITS FOR THE FILE.
*         A157,X157,B5 ARE DESTROYED
*0CD      ROUTINES CALLED 
*         FILINFO - THE SYSTEM ROUTINE TO GIVE THE INFORMATION NEEDED 
*0CD      DESCRIPTION 
*         ON ENTRY B1 IS SET TO 1 AND A5 IS SET TO POINT TO THE FET.
*         WE THEN SET UP THE FIRST WORD OF FNAME FOR THE FILINFO CALL 
*         WITH FILE NAME AND TABLE LENGTH (TABLE LENGTH = 6)
*         WE SET THE PRUNO FIELD IN FET+6 FROM BITS 36-59 OF WORD 3 
*         OF THE TABLE. SINCE THE WRITE BIT IMPLIES THE MODIFY BIT, WE
*         MASK THE BOTTOM 3 PERMISSION BITS STAIGHT IN. WE CHECK THE
*         MODIFY BIT AND FORCE IT ON IN THE FET IF IT IS SET. THE 
*         PERMISIONS ARE STORED IN FET+6
*#
 FNAME    BSS    6
 PRMWD    EQU    8
 PRUWD    EQU    6
 INFO$AA  BSS    1
          SB1    1
          SA5    X1 
          SA5    X5          A5 NOW POINTS TO FET/FIT 
          MX7    42 
          BX5    X7*X5       PUT FILE NAME IN X5
          MX7    2
          LX7    15          SET LENGTH PARAMETER TO 6
          BX7    X5+X7
          SA7    FNAME       PARAMETERS FOR FILINFO IN FNAME
          FILINFO  FNAME
          MX7    30 
          SA1    FNAME+3     GET WORD WITH LAST PRU NUMBER
          LX1    24          MOVE PRUNO TO BOTTOM OF X1 
          BX5    -X7*X1      ISOLATE PRUNO (X1 BITS 24-29 DEFINED 0)
          SA1    A5+PRUWD    GET FET/FIT WORD 6 
          BX1    X1*X7       CLEAR PRUNO
          BX7    X1+X5       PUT PRUNO IN 
          SA7    A1          PUT FET WORD 6 INTO PLACE
          SA1    FNAME+1     GET WORD WITH PERMISSION BITS
          MX5    57 
          AX1    6           MOVE PERM BITS TO BOTTOM OF X1 
          BX7    -X5*X1      SET READ,MODIFY(IMPLIED BY WRITE),EXTEND 
          LX1    56          MOVE MODIFY BIT(NOT WRITE IMPLIED) TO SIGN 
          PL     X1,NOMDB    BRANCH IF MODIFY BIT IS NOT SET
          MX1    1
          LX1    2           MOVE A BIT TO MODIFY LOCATION IN X7
          BX7    X7+X1
 NOMDB    SA1    A5+PRMWD    GET FIT/FET WORD FOR PERMISSION BITS 
          LX5    20          MOVE 57 BIT MASK TO COVER PERM BITS
          LX7    20          MOVE PERM BITS INTO POSITION 
          BX5    X1*X5       CLEAR 3 PERM BITS(CONTROL BIT IGNORED) 
          BX7    X5+X7       MAKE NEW FIT/FET WORD 8 IN X7
          SA7    A1 
          EQ     INFO$AA
          ENTRY  MIPTIME                                                 RPNMIP 
*#                                                                       RPNMIP 
* *       MIPTIME - CALCULATE MIPWORD            PAGE  1                 AM2A077
*1CD      MIPTIME                                                        RPNMIP 
*         THIS ROUTINE COMPUTES THE MIPWORD FOR CREATION OF MIP FILES.   RPNMIP 
*0CD      ENTRY CONDITIONS                                               RPNMIP 
*         THIS ROUTINE IS CALLED AS A FUNCTION WITH NO PARAMETERS.       RPNMIP 
*0CD      EXIT CONDITIONS                                                RPNMIP 
*         THE FUNCTION VALUE IS RETURNED IN X6.  THE VALUE RETURNED      RPNMIP 
*         IS A COMPOSITE OF JDATE AND CLOCK, WITH ALL SEPARATORS REMOVED RPNMIP 
*         THE FIRST 5 DIGITS IN DISPLAY CODE BEING THE JDATE, AND THE    RPNMIP 
*         LAST 5 DIGITS BEING THE HOUR,MINUTES AND 10-SECONDS.  THE LAST RPNMIP 
*         DIGIT FOR SECONDS IS TRUNCATED.                                RPNMIP 
*0CD      ERROR CONDITIONS                                               RPNMIP 
*         NONE                                                           RPNMIP 
*0CD      CALLED ROUTINES                                                RPNMIP 
*         CRA1$AA - TO ISSUE THE TIME CALLS FOR JDATE AND CLOCK          RPNMIP 
*0CD      DESCRIPTION                                                    RPNMIP 
*         SET UP FIRST CALL TO CRA1$AA TO GET CLOCK, THEN SECOND CALL    RPNMIP 
*         TO GET JDATE                                                   RPNMIP 
*         NOW WITH JDATE IN MIPTA AND CLOCK IN MIPTA+1, MOVES THINGS     RPNMIP 
*         AROUND UNTIL WE GET THE DESIRED RESULT IN X6                   RPNMIP 
*#                                                                       RPNMIP 
 LOC      BSS    1                                                       RPNMIP 
 MIPTA    BSSZ   2                                                       RPNMIP 
 PAR      VFD    42/0,18/TIM                                             RPNMIP 
          VFD    42/0,18/LOC                                             RPNMIP 
          VFD    42/0,18/REC                                             RPNMIP 
          VFD    42/0,18/TYPE                                            RPNMIP 
 TIM      DATA   3                                                       RPNMIP 
 REC      DATA   1                                                       RPNMIP 
 TYPE     BSS    1                                                       RPNMIP 
 MIPTIME  BSS    1                                                       RPNMIP 
          SX6    MIPTA                                                   RPNMIP 
          SA6    LOC                                                     RPNMIP 
          SX6    3                                                       RPNMIP 
          SA6    TYPE                                                    RPNMIP 
          SA1    PAR                                                     RPNMIP 
          RJ     =YCRA1$AA         GET JDATE INTO MIPTA+1                RPNMIP 
          SX6    MIPTA+1                                                 RPNMIP 
          SA6    LOC                                                     RPNMIP 
          SX6    2                                                       RPNMIP 
          SA6    TYPE                                                    RPNMIP 
          SA1    PAR                                                     RPNMIP 
          RJ     =YCRA1$AA         GET CLOCK                             RPNMIP 
          SA1    MIPTA                                                   RPNMIP 
          LX1    12                                                      RPNMIP 
          MX0    48                                                      RPNMIP 
          SA2    A1+B1                                                   RPNMIP 
          LX2    18                                                      RPNMIP 
          BX6    -X0*X2                                                  RPNMIP 
          BX6    X1+X6                                                   RPNMIP 
          LX6    12                                                      RPNMIP 
          LX2    18                                                      RPNMIP 
          BX1    -X0*X2                                                  RPNMIP 
          BX6    X6+X1                                                   RPNMIP 
          LX6    6                                                       RPNMIP 
          LX2    12                                                      RPNMIP 
          MX0    54                                                      RPNMIP 
          BX1    -X0*X2                                                  RPNMIP 
          BX6    X6+X1                                                   RPNMIP 
          EQ     MIPTIME                                                 RPNMIP 
          BX6    X6+X1                                                   RPNMIP 
          EQ     MIPTIME                                                 RPNMIP 
          EJECT 
          ENTRY INIT$AA,CLUN$AA 
          LDSET  NOEPT=INIT$AA/CLUN$AA
          LIST   -L 
*CALL AAMCOMCMP 
          LIST   L
*#
* *       INIT$AA - INITIALIZE                   PAGE  1                 AM2A077
*1CD      INIT$AA 
*         THIS ROUTINE IS CALLED WHEN WE OPENED THE FIRST AAM FILE. 
*         GLOBAL INITIALIZATION IS DONE HERE. 
*0        THIS ROUTINE IS CALLED BY OPENDAA.  THE NOFDL AND NOCMM 
*         BITS WILL BE SET IF FDL AND CMM HAVE BEEN OMITTED.  ENTRY 
*         POINT CMM.POE IS CHECKED FOR CMM AVAILABILITY AS AAM MUST 
*         SET UP AN OVERFLOW ACTION STACK ENTRY WHEN CMM IS USED. 
*         REPRIEVE STACK ENTRY AND CMM OVERFLOW ENTRY ARE BOTH
*         STACKED HERE. 
*#
 INIT$AA  BSS    1
          RECOVR =YRPV$AA,377B,=YRPVE$AA SET UP REPRIEVE ENTRY
          SX4    =YCMM.POE   TEST FOR CMM AVAILABILITY
          SA5    =YAAM$CTL-1
          SA3    GCOM$AA+?CFLGS 
          SX5    X5-2        TEST FOR STATIC LOADING (USAGE COUNT GE 2) 
          MX6    1
          NG     X5,INIT1    SKIP IF DYNAMIC LOAD 
          BX3    X6+X3       OR IN NOFDL BIT
 INIT1    LX6    59 
          PL     X4,INIT2    SKIP IF CMM AVAILABLE
          BX3    X6+X3
 INIT2    BX6    X3 
          SA6    A3          STORE THOSE FLAGS
          SX6    GCOM$AA+?_BFCHNHD INITIALIZE BUFFER CHAIN HEADER 
          BX5    X6 
          LX6    18 
          BX6    X6+X5
          SA6    X5 
          NG     X4,INIT$AA  EXIT IF NO CMM 
          SX4    =XCMOV$AA   SET UP TO PUSH CMM OVERFLOW ENTRY
          SA2    =0.90
          MX3    0
          RJ     =YCMM.POE   PUSH ENTRY 
          SF.AA  GCOM$AA,OVACID,X1 SAVE ENTRY ID
          EQ     INIT$AA
          EJECT 
*#
* *       CLUM$AA - CLOSE HELPER                 PAGE  1                 AM2A077
*1DC      CLUN$AA 
*         ATTEMPT TO UNLOAD ALL RESIDENT AND FUNCTIONAL CAPSULES USED 
*         BY CURRENT FIT, AND UNSTACKING THE CMM OVERFLOW AND REPRIEVE
*         ENTRIES.
*0CD      CALLED BY CLSE$AA AND ALSO OPEN$AA WHEN A FATAL ERROR 
*         OCCURS DURING OPEN, RESULTING IN FILE NOT OPENED
*0CD      INPUT PARAMETERS
*         FIT$AA IS SET TO FIT IN QUESTION AND AAMSR1 IN FIT SET TO 
*         INDICATE CAPSULES IN USE BY THIS ROUTINE
*OCD      DESCRIPTION 
*         PICK UP AAMSR1 FROM FIT, EXAMINE BITS CORRESPONDING TO CAPSULE
*         IN USE.  FOR EVERY CAPSULE IN USE, DECREMENT THS CAPSULE
*         USAGE COUNT. WHEN THE COUNT GOES TO ZERO, CALL UNLD$AA TO 
*         UNLOAD THE CAPSULE.  AAMSR1 IS CLEARED ON EXIT. 
*         NOTE A TRICK IS USED TO EXAMINE THE BITS USING THE NX INSTRUCT
*         -ION.  THIS WORKS ONLY IF WE HAVE LESS THAN 48 CAPSULES.  IF
*         FURTHER DEVELOPMENT RESULTS IN MORE THAN 48 CAPSULES, THIS COD
*         SHOULD BE CHANGED.
*         FINALLY, THE AAM$CTL USAGE COUNT IS EXAMINED.  IF THE CURRENT 
*         FILE IS THE LAST FILE LEFT, BOTH CMM AND REPRIEVE STACK 
*         ENTRIES ARE REMOVED.
*#
 CLUN$AA  BSS    1
          SA5    FIT$AA 
          SA0    X5          RESTORE A0 
          MX7    0
          SB3    =YCAPN$AA+48 
          F.RM   AAMSR1,5       KEEP MASK IN X5 
          SB1    1
          SET.RM AAMSR1,X7
 CLOOP    ZR     X5,NOCAP    JUMP OUT IF NO MORE CAPSULE TO UNLOAD
          MX4    13          SET MASK 
          PX5    X5 
          NX5    X5,B2       B2=SHIFT COUNT TO GET TO FIRST CAPSULE 
          SB3    B3-B2       B3=ADDRESS OF CAPSULE ENTRY TO UNLOAD
          BX5    -X4*X5      CLEAR TOP BIT OF X5 FOR NEXT CAPSULE 
          SA2    B3          LOAD UP CAPSULE ENTRY
          SA3    X2-1        TEST CAPSTAT WORD OF THAT CAPSULE
          MX7    -1 
          SB2    X3 
          GT     B2,B1,CL1   SKIP IF CURRENT COUNT GT 1 
          RJ     =YUNLD$AA   UNLOAD THIS CAPSULE
          EQ     CLOOP
 CL1      IX7    X7+X3       DECREMENT CAPSULE USAGE COUNT
          SA7    A3 
          EQ     CLOOP       LOOP BACK FOR NEXT CAPSULE 
 NOCAP    SA1    =YAAM$CTL-1 TEST FOR AAM$CTL USAGE COUNT 
          SB2    X1          B2=CURRENT NUMBER OF OPENED AAM FILE 
          GT     B2,B1,CLUN$AA     EXIT IF MORE THAN ONE FILE LEFT
          RF.AA  GCOM$AA,OVACID 
          ZR     X1,NOCMM    TEST IF CMM.POE ENTRY IS SET 
          RJ     =YCMM.DOE   IF SO, UNSTACK THAT ENTRY
 NOCMM    RECOVR =YRPV$AA,0,=YRPVE$AA    TURN REPRIEVE OFF
          EQ     CLUN$AA     RETURN 
          EJECT 
          ENTRY  STFT$AA,STFT$IS,STFT$DA,STFT$AK                         GBK0711
*#
* *       STFT$AA - SETFIT PROCESSOR             PAGE  1                 AM2A077
*1CD      STFT$AA 
*         SETFIT ENTERS HERE.  CURRENTLY, THIS IS JUST A DUMMY ROUTINE. 
*         SINCE SETFIT FOES THROUGH OPEN, MANY RESIDENT CAPSULES WILL 
*         HAVE BEEN LOADED FOR THIS FIT, OR THE CAPSULE USAGE COUNTS
*         BUMPED.  TO BRING THE COUNTS BACK INTO SYNCHRONIZATION, WE
*         WILL DECREMENT THOSE CAPSULE COUNTS BACK. 
*         NOTE THAT THIS ROUTINE IS ENTERED WITH A0 = FIT,AND B1 = 1. 
*         A SIMILAR SCHEME AS IN CLUN$AA IS USED TO FIND THE CAPSULES 
*         THAT ARE BEING USED BY THIS FILE BY EXAMINING THE CAPSULE 
*         USAGE MASK IN THE FIT.
*#
 STFT$AA  BSS    0
 STFT$DA  BSS    0                                                       GBK0711
 STFT$AK  BSS    0                                                       GBK0711
 STFT$IS  BSS    1
          F.RM   AAMSR1,1 
          SB3    =YCAPN$AA+48 
          MX0    13 
          MX7    -1 
          SET.RM STFT,0,6,5  TURN OF STFT BIT FIRST FOR BAM 
          SA5    =YAAM$CTL-1
          IX6    X5+X7       DECRMENET COUNT
          SA6    A5          OF OPENED AAM FILE 
 STL1     ZR     X1,STFT$AA 
          PX1    X1 
          NX1    X1,B2
          SB3    B3-B2       B3=CAPSULE ENTRY ADDRESS IN PASSLOC TABLE
          SA5    B3 
          SA5    X5-1        LOAD CAPSULE USAGE WORD
          BX1    -X0*X1      GET READY FOR NEXT CAPSULE 
          IX6    X5+X7
          SA6    A5 
          EQ     STL1 
          EJECT 
          ENTRY  LOADCPR
* 
*#
* *       LOADCPR - LOAD COMPRESSION RTN         PAGE  1                 AM2A077
*1CD      LOADCPR 
*         LOADS THE SYSTEM COMPRESSION CAPSULE AND SETS THE FIT FIELDS
*         CPA AND DCA WITH THE [OMPRESSION ENTRY ADDRESS AND THE
*         DECOMPRESSION ENTRY ADDRESS.
*0CD      ENTRY CONDITIONS
*         THIS ROUTINE IS CALLED FROM SYMPL WITH ONE PARAMETER, THE 
*         SYSTEM COMPRESSION CAPSULE NUMBER.  THE CAPSULE NAME TABLE
*         (AT LABEL -CAPTABL-) MUST HAVE AN ENTRY FOR EACH SYSTEM 
*         COMPRESSION CAPSULE IN THE LIBRARY.  THE MACRO -GENTBL- 
*         GENERATES THE ENTRIES. THE TABLE ENTRIES MUST BE SPECIFIED
*         IN CONSECUTIVE ASCENDING NUMERICAL ORDER BEFORE THE LABEL 
*         -TABLENG-.
*0CD      EXIT CONDITIONS 
*         THE CAPSULE IS LOADED AND FTCPA AND FTDCA ARE SET.
*0CD      ERROR CONDITIONS
*         EC536 - NO OR WRONG COMPRESSION ROUTINE -- ISSUED WHEN THE
*         CAPSULE NUMBER ISNT WITHIN THE RANGE OF THE CAPSULE NAME TABLE
*         AND WHEN WE RETURN FROM LOAD$AA WITHOUT THE CAPSULE LOADED. 
*0CD      CALLED ROUTINES 
*         LOAD$AA - LOADS THE CAPSULE. (PRESERVES X5,B3,B6,A0,B1=1) 
*         FATERR  - ISSUES ERROR MESSAGE AND ENDS THE OPEN PROCESSING.
*0CD      DESCRIPTION 
*         - CHECK THAT PARAMETER IS IN TABLE RANGE, ELSE ERROR 536B.
*         - IF THE CAPSULE IS ALREADY LOADED INCREMENT USAGE COUNT BY 1 
*           ELSE LOAD CAPSULE.  IF LOAD NOT SUCCESSFUL, ERROR 536B. 
*         - SET FTCPA AND FTDCA TO THEIR RESPECTIVE ADDRESSES.
*#
* 
 GENTBL   MACRO  CAPNAME
          VFD    42/0L_CAPNAME,18/=Y_CAPNAME
 GENTBL   ENDM
* 
* 
 CAPTABL  BSS    0
 TABLE    ECHO   1,P1=(01,02,03,04,05,06,07,08,09,10)                    CY211
          GENTBL CMPR$_P1                                                CY211
 TABLE    ENDD                                                           CY211
* 
* ANY MORE TABLE ENTRIES MUST BE DECLARED BEFORE THIS CARD
* 
 TABLENG  EQU    *-CAPTABL         LENGTH OF CAPSULE NAME TABLE 
 PARAM    DATA   536B              ERROR CODE FOR NO OR WRONG COMPR RTN 
 EC536    VFD    42/0,18/PARAM
* 
 LOADED   SA2    B3                GET CAPSULE TABLE WORD 
          SB7    X2                B7 IS CAPSULE ENTRY POINT ADDRESS
          SA2    B7-1              GET CAPSTAT WORD 
          IX7    X2-X5             INCREMENT COUNT BY ZERO OR ONE 
          SA7    A2                RESET CAPSTAT WORD 
          SA2    =YFIT$AA          SET UP FIT ADDRESS IN A0 
          SA0    X2 
          SA3    B7                X3 IS COMPRESSION ROUTINE ADDRESS
          SET.RM CPA,X3            SET FTCPA
          SA3    B7+1              X3 IS DECOMPRESSION ROUTINE ADDRESS
          SET.RM DCA,X3            SET FTDCA
 LOADCPR  EQ     *+1S17 
          SA1    X1                LOAD PARAMETER 
          SX2    TABLENG           GET TABLE LENGTH 
          IX3    X2-X1
          NG     X3,ERR            WRONG COMPRESSION ROUTINE
          SA2    X1+CAPTABL-1 
          SB3    A2                SAVE CAPSULE TABLE ADDRESS IN B3 
          SB2    X2                B2 IS COMPRESSION CAPSULE ENTRY ADDR 
          MX5    -1                INCREMENT IS -1
          GT     B2,B0,LOADED      IS CAPSULE LOADED
          MX5    0                 INCREMENT IS 0 
          SB1    1
          RJ     =YLOAD$AA         LOAD CAPSULE 
          SA2    B3                GET CAPSULE TABLE WORD 
          SB7    X2                B2 IS COMPRESSION CAPSULE ENTRY ADDR 
          GT     B7,B0,LOADED      WAS CAPSULE SUCCESSFULLY LOADED
 ERR      SA1    EC536             ERROR, NO COMPRESSION CAPSULE LOADED 
          RJ     =YFATERR          PROCESS ERROR
          EQ     LOADCPR
          EJECT 
          ENTRY  UNLDCPR
* 
*#
* *       UNLDCPR - UNLOAD COMPRESSION RTN       PAGE  1                 AM2A077
*1CD      UNLDCPR 
*         UNLOADS A SYSTEM COMPRESSION CAPSULE. 
*0CD      ENTRY CONDITIONS
*         THIS ROUTINE IS CALLED FROM SYMPL WITH ONE PARAMETER, THE 
*         NUMBER CORRESPONDING TO THE SYSTEM COMPRESSION CAPSULE TO BE
*         UNLOADED.  THE CAPSULE NAME TABLE MUST BE AS DESCRIBED IN THE 
*         COMPRESSION CAPSULE LOAD ROUTINE -LOADCPR-. 
*0CD      EXIT CONDITIONS 
*         THE CAPSULE IS UNLOADED IF IT ISNT BEING USED BY ANOTHER FIT, 
*         ELSE THE USAGE COUNT IS DECREMENTED BY 1. 
*0CD      ERROR CONDITIONS
*         NONE. 
*0CD      CALLED ROUTINES 
*         UNLD$AA - UNLOADS THE CAPSULE.
*0CD      DESCRIPTION 
*         - DECREMENT THE CAPSULE USAGE COUNT BY 1. 
*         - UNLOAD THE CAPSULE IF THE USAGE COUNT IS 0, ELSE RESET
*           THE DECREMENTED COUNT AND RETURN. 
*#
* 
 UNLD     SB1    1
          RJ     =YUNLD$AA         UNLOAD COMPRESSION CAPSULE 
 UNLDCPR  EQ     *+1S17 
          SA1    X1                LOAD PARAMETER 
          MX7    -1                X7 IS -1 
          SA2    X1+CAPTABL-1      GET CAPSULE TABLE ENTRY
          SA3    X2-1              GET CAPSTAT WORD OF CAPSULE
          IX7    X7+X3             DECREMENT CAPSULE USAGE COUNT
          SX3    X7                X3 IS CAPSULE USAGE COUNT
          ZR     X3,UNLD           UNLOAD IF USAGE COUNT IS ZERO
          SA7    A3                RESET CAPSTAT WORD 
          EQ     UNLDCPR           RETURN 
          EJECT                                                          GAG0725
          ENTRY  POWR$AA                                                 GAG0725
*                                                                        GAG0725
*#                                                                       GAG0725
* *       POWR$AA - INTEGER EXPONENTIATION       PAGE  1                 GAG0725
* *       PROGRAM - OPEN$AA                                              GAG0725
* *       G.A.GREENE.                           DATE.                    GAG0725
*                                                                        GAG0725
*1CD      FUNCTION.                                                      GAG0725
*                                                                        GAG0725
*         RAISE AN INTEGER BASE TO AN INTEGER EXPONENT WITHOUT MODING    GAG0725
*         OUT.  IF THE RESULT IS GREATER THAN 2**40, THEN 2**40 WILL BE  GAG0725
*         RETURNED.                                                      GAG0725
*                                                                        GAG0725
* CD      ENTRY CONDITIONS.                                              GAG0725
*                                                                        GAG0725
*         BASE - SUPPLIED AS 1ST PASSED SYMPL PARAMETER.                 GAG0725
*         EXPONENT - SUPPLIED AS 2ND PASSED SYMPL PARAMETER.             GAG0725
*                                                                        GAG0725
* CD      EXIT CONDITIONS.                                               GAG0725
*                                                                        GAG0725
*         RESULT OR 2**40 RETURNED IN X6.                                GAG0725
*                                                                        GAG0725
* CD      ERROR CONDITIONS.                                              GAG0725
*                                                                        GAG0725
*         NONE.                                                          GAG0725
*                                                                        GAG0725
* CD      CALLED ROUTINES.                                               GAG0725
*                                                                        GAG0725
*         NONE.                                                          GAG0725
*#                                                                       GAG0725
*                                                                        GAG0725
 POWR$AA  EQ     *+1S17      ((((((( ENTRY POINT )))))))                 GAG0725
          SA2    A1+1                                                    GAG0725
          SA1    X1                X1 IS THE BASE                        GAG0725
          SA2    X2                X2 IS THE EXPONENT                    GAG0725
          SX6    X1                COPY BASE INTO X6 FOR MULTIPLICATION  GAG0725
          SB4    X2                COPY EXP TO B4,THE MULT LOOP COUNTER  GAG0725
          SB2    48                                                      GAG0725
          PX3    B0,X1                                                   GAG0725
          NX3    B3,X3             DETERMINE POWER OF 2 CONTAINING BASE  GAG0725
          SX3    B2-B3                                                   GAG0725
          IX4    X3*X2             MULTIPLY THE EXPONENTS  ((2**X3)**X2) GAG0725
          SB3    X4-40       IF RESULT GT 2**40,DONT CALC                GAG0725
          NG     B3,CALC                                                 GAG0725
          MX6    40                                                      GAG0725
          LX6    40                                                      GAG0725
          EQ     POWR$AA     RETURN WITH A VERY LARGE NUMBER             GAG0725
                                                                         GAG0725
 CALC     SB4    B4-1                                                    GAG0725
          ZR     B4,POWR$AA  RETURN WITH THE RESULT                      GAG0725
          IX6    X6*X1             MULT BASE TIMES PREVIOUS RESULT       GAG0725
          EQ     CALC                                                    GAG0725
                                                                         GAG0725
          EJECT 
          ENTRY  BADM$AA
* 
*#
* *       BADM$AA - ISSUE MESSAGE ABOUT WRITE PARITY ERROR    PAGE 1
*1CD      BADM$AA 
*         THIS IS CALLED WHEN AN AAM FILE IS CLOSED, IF THE BADBLK
*         TABLE IS NOT EMPTY, WHICH INDICATES THAT AT LEAST ONCE IN THE 
*         PAST, THERE WAS A WRITE PARITY ERROR WHILE REWRITING A BLOCK. 
*         THIS CONDITION WAS REMEDIED, AND ALL THE INFORMATION WAS PRE- 
*         SERVED, BY WRITING THE BLOCK AGAIN AT EOI, AND RECORDING IN 
*         BADBLK, IN THE FSTT, THE PRU NUMBERS AT WHICH THE BLOCK SHOULD
*         HAVE BEEN AND ACTUALLY IS. IT WOULD BE VERY TRICKY TO OUTPUT
*         A DAYFILE MESSAGE WITH THE FILE NAME, AT THE TIME THE ERROR 
*         HAPPENED, SO WE TAKE AN EASY WAY OUT AND DO IT AT CLOSE TIME. 
*         BADM$AA IS CALLED ONLY FROM OPEN$AA.
*0CD      ENTRY CONDITIONS
*         BADM$AA IS CALLED FROM A SYMPL PROGRAM WITH ONE PARAMETER,
*         THE NAME OF THE FILE BEGINNING AT THE 4TH CHARACTER OF A WORD,
*         WITH BINARY ZERO FILL IN THE FIRST 3 CHARACTERS, AND ALSO IN
*         THE LAST CHARACTERS OF THE WORD IF THE NAME IS LESS THAN 7
*         CHARACTERS LONG.
*0CD      EXIT CONDITIONS 
*         THE DAYFILE MESSAGES HAVE BEEN ISSUED WITH RECALL.
*0CD      ERROR CONDITIONS
*         NONE
*0CD      CALLED ROUTINES 
*         CRA1$AA - OUR ROUTINE FOR PASSING ON ALL MONITOR REQUESTS 
*#
* 
BADM$AA   DATA   0
          SA1    X1 
          LX1    18 
          MX0    42 
          BX1    X0*X1
          MX0    6
          SX3    1R 
          LX3    54 
BADMA     BX4    X0*X1
          ZR     X4,BADMB 
          SX2    X2+1 
          LX0    54 
          LX3    54 
          EQ     BADMA
BADMB     LX2    59 
          PL     X2,BADMC    EVEN NUMBER OF CH IN NAME
          BX1    X1+X3
BADMC     BX6    X1 
          SA6    BADMES+3 
          SX6    BADMES 
          SA6    BADQ 
          SA1    BADP 
          RJ     =XCRA1$AA
          SX6    BADMET 
          SA6    BADQ 
          SA1    BADP 
          RJ     =XCRA1$AA
          EQ     BADM$AA
* 
BADP      VFD    42/0,18/*+4
          VFD    42/0,18/BADQ 
          VFD    42/0,18/*+3   RECALL 
          VFD    42/0,18/0
          DATA   2           MSG
          VFD    42/0,18/200000B
BADQ      VFD    42/0,18/BADMES 
BADMES    DATA   40H  WRITE PARITY ERROR IN FILE
BADMET    DIS    0,*BUT NO DATA IN BAD BLOCK(S)*
          END                                                            OPNMDAA
