*COMDECK SHA
          TITLE  COMMON MEMORY MANAGER, V1.0, CMM.SHA - SET HHA 
*CALL CMMCOM
          COMMENT  "SUBSYS"SET HHA. 
          B1=1
 CMM.SHA  SPACE  4
***       CMM.SHA - SET HHA.
* 
* 
*              THE CURRENT VALUE OF HHA IS SET TO NEW-HHA.  ALL BLOCK 
*         CONTENTS ARE UNAFFECTED.  AN INITIAL CALL OF THIS FORM IS 
*         NOT NECESSARY.
* 
*         ENTRY  (X1) = NEW-HHA.
* 
*         EXIT   (B1) = 1.
* 
*         SAVES  X - 0, 5.
*                B - 2, 3.
*                A - 0. 
  
  
          CMMENT  SHA 
 CMM.SHA  EQ     *+400000B   ENTRY / EXIT 
          SB1    1
          RJ     =XCMM.ICM   INITIALIZE AND SET A0
  
 IS       IFSAFE
          SX6    3RSHA       SAVE FUNCTION NAME 
          SA6    A0-MNFNAME 
          SA4    CMM.SHA     SAVE RETURN ADDRESS
          LX4    30 
          BX6    X4 
          SA6    A0-MNRETURN
          SA3    A0-IMAPM 
          ZR     X3,SHA101
          UERR   CMEPMR,0    CALLED FROM POINTER-MAINTENANCE ROUTINE
  
 SHA101   SA2    RA65        (X2) = DABA
          BX2    -X2
          SX2    X2 
          IX3    X1-X2
          PL     X3,SHA102
          UERR   CMEHHLD,0   MAY NOT REDUCE HHA LT DABA 
  
 SHA102   SA4    HHA         (X4) = CURRENT HHA 
          SX4    X4 
          IX6    X4-X1
          PL     X6,SHA104   IF NOT AN INCREASE IN HHA
          SB7    X2+B1       VERIFY THAT NO FIXED BLOCKS PRESENT
 SHA103   SA3    B7          NEXT REGION
          SB7    X3 
          ZR     B7,SHA104   IF AT TRAILER
          DF     X3,SHA103   IF NOT A FIXED BLOCK 
          UERR   CMEHFXB,0   MAY NOT UP HHA IF FIXED BLOCKS PRESENT 
  
 SHA104   BSS    0
 IS       ENDIF 
  
          SX7    X1          SET NEW HHA
          SA7    HHA
          SA2    A0-MNSAVEA0  RESTORE A0
          SA0    X2 
          EQ     CMM.SHA     RETURN 
  
