*COMDECK OPB
          TITLE  COMMON MEMORY MANAGER, V1.0, CMM.OP4 - COMPACT DYNAMIC 
,AREA 
*CALL CMMCOM
          COMMENT  "SUBSYS"COMPACT DYNAMIC AREA.
          B1=1
 CMM.OP4  SPACE  4,10 
***       CMM.OP4 - COMPACT DYNAMIC AREA. 
* 
* 
*              THIS CALL INFORMS CMM OF THE BEGINNING OF A LONG PERIOD
*         WITH NO CMM ACTIVITY.  CMM WILL COMPACT THE DYNAMIC AREA IN 
*         ORDER TO REDUCE TOTAL FL REQUIREMENTS.
* 
*         ENTRY  NONE.
* 
*         EXIT   (B1) = 1.
* 
*         SAVES  X - 0, 5.
*                B - 2, 3.
*                A - 0. 
  
  
          CMMENT  OP4 
 CMM.OP4  EQ     *+400000B   ENTRY / EXIT 
          SB1    1
          RJ     =XCMM.ICM   INITIALIZE AND SET A0
  
 IS       IFSAFE
          SX7    3ROP4       SAVE FUNCTION NAME 
          SA7    A0-MNFNAME 
          SA4    CMM.OP4     SAVE RETURN ADDRESS
          LX4    30 
          BX6    X4 
          SA6    A0-MNRETURN
          SA1    A0-IMAPM 
          ZR     X1,OP4ECA
          UERR   CMEPMR,0    CALLED FROM POINTER-MAINTENANCE ROUTINE
  
 OP4ECA   BSS    0
 IS       ENDIF 
  
*         IF PRIMARY VP REGION IS PRESENT, CALL CMM.VSQ TO MOVE DOWN
*         VARIABLE BLOCKS, AND THEN REDUCE THE FL.  OTHERWISE, REDUCE 
*         THE FL BASED ON LWA+1 OF THE HIGHEST FIXED BLOCK. 
  
          ERRNZ  P.ENDZ-1 
          SA2    A0-B1
          SA2    X2 
          AX2    18 
          SA1    X2 
          MX6    6
          BX6    X6*X1
          MX4    1
          BX4    X6-X4
          NZ     X4,OP4A     IF NO PRIMARY VP REGION
  
 IS       IFSAFE
          SX3    =YCMM.VSQ
          PL     X3,OP4ECB   IF CMM.VSQ PRESENT 
          UERR   CMENEED,0,3RVSQ  CMM.VSQ NEEDED, BUT NOT PRESENT 
  
 OP4ECB   BSS    0
 IS       ENDIF 
  
          RJ     =YCMM.VSQ   -- VARIABLE SQUEEZE -- 
          EQ     OP4D 
  
 OP4A     SX6    X1          SET FOR LWA HIGHEST FIXED BLOCK
          ID     X1,OP4D     IF FIXED BLOCK 
          SX6    A1          IF NOT, THE NEXT-LOWER REGION HAS TO BE A
                              FIXED BLOCK (EVEN IF THE DUMMY AT DABA) 
 OP4D     SA1    A0-B1        ? (X4) = -[(CURRENT ENDZ)-(NEW ENDZ)] 
          IX4    X6-X1
          RJ     =XCMM.CFL   -- CHANGE FIELD LENGTH --
          SA1    A0-MNSAVEA0  RESTORE A0
          SA0    X1 
          EQ     CMM.OP4     RETURN 
  
