*COMDECK SLF
          TITLE  COMMON MEMORY MANAGER, V1.0, CMM.SLF - SHRINK AT LWA FI
,XED
*CALL CMMCOM
          COMMENT  "SUBSYS"SHRINK AT LWA FIXED. 
          B1=1
 CMM.SLF  SPACE  4
***       CMM.SLF - SHRINK AT LWA FIXED.
* 
* 
*              THE SPECIFIED NUMBER OF WORDS ARE DELETED FROM THE BLOCK 
*         AT THE LWA END, AND THEIR CONTENTS ARE LOST.  IF THE
*         NUMBER SPECIFIED IS ZERO (0), NO CHANGE TO THE BLOCK IS MADE. 
* 
*         ENTRY  (X1) = BLOCK-FWA.
*                (X2) = NUMBER-OF-WORDS.
* 
*         EXIT   (B1) = 1.
* 
*         SAVES  X - 0, 5.
*                B - 2, 3.
*                A - 0. 
  
  
          CMMENT  SLF 
 CMM.SLF  EQ     *+400000B   ENTRY / EXIT 
          SB1    1
          SX1    X1 
          SX6    A0          SAVE A0
          SA3    RA65 
          BX3    -X3
  
 IS       IFSAFE
          SX3    X3 
          PL     X3,SLF102
          UERR   CMEFST,0,3RSLF  ILLEGAL 1ST CALL TO CMM
  
 SLF102   BSS    0
 IS       ENDIF 
  
          SA3    X3          (A0) = FL
          SA0    X3 
          SA6    A0-MNSAVEA0  SAVE A0 
  
 IS       IFSAFE
          SX7    3RSLF       SAVE FUNCTION NAME 
          SA7    A0-MNFNAME 
          SA4    CMM.SLF     SAVE RETURN ADDRESS
          LX4    30 
          BX6    X4 
          SA6    A0-MNRETURN
          SA3    A0-IMAPM 
          ZR     X3,SLF104
          UERR   CMEPMR,0    CALLED FROM POINTER-MAINTENANCE ROUTINE
  
 SLF104   SB7    B0           ? FIXED BLOCK 
          RJ     =XCMM.CAB   -- CHECK ACTIVE BLOCK, (X1) = FWA -- 
 IS       ENDIF 
  
          SB6    X2          (B6) = DECREASE
          SB7    X1-2        (B7) = ADDRESS OF BLOCK HEADER 
          SA3    B7+B1
          PL     X3,SLF2     IF 2-WORD HEADER 
          SB7    B7+B1
 SLF2     SA4    B7          (X4) = HEADER WORD 0 
          SX6    X4          (X6) = FWD 
  
 IS       IFSAFE
          LX4    59-45-1
          MI     X4,SLF106   IF REQUIRED SIZE-CODE BIT SET
          UERR   CMESCV,0    SIZE-CODE VIOLATION
  
 SLF106   IX1    X6-X1       BLOCK-SIZE = FWD - FWA 
          MI     X2,SLF107   IF NUM NEGATIVE
          IX3    X1-X2
          PL     X3,SLF108   IF NUM LE BLOCK SIZE 
 SLF107   UERR   CMENUM,0    ILLEGAL NUM SPECIFIED
  
 SLF108   LX4    -59+45+1 
 IS       ENDIF 
  
*         FREE SPACE BY CREATING FREE REGION HEADER AT END OF BLOCK.
  
          ZR     B6,SLF7     IF ZERO CHANGE 
          IX7    X4-X2       SET FWD DOWN BY DECREASE 
          SA7    A4 
          SA1    X6          NEXT REGION HEADER 
          SX4    A4          FORM NEW FREE REGION HEADER
          LX4    18 
          IX3    X6-X2
          BX6    X4+X6
          SA6    X3 
          SX4    A4          ADJUST BKD IN NEXT REGION HEADER 
          IX4    X3-X4
          LX4    18 
          IX7    X1+X4
          SA7    A1 
          MI     X1,SLF6     IF NEXT REGION NOT FREE
          SX2    A1          REMOVE UPPER FREE REGION HEADER BY 
          SX6    X1           ADJUSTING POINTERS
          IX6    X6-X2
          SA4    A6          FWD IN NEWLY-CREATED FREE REGION HEADER
          IX7    X4+X6
          SA7    A4 
          IX7    X3-X2       BKD IN NEXT HEADER 
          SA1    X1 
          LX7    18 
          IX7    X7+X1
          SA7    A1 
  
*         ADJUST USED SPACE AND REDUCE FIELD LENGTH IF APPROPRIATE. 
  
 SLF6     SX1    B6           ? (X1) = DECREASE 
          RJ     =XCMM.AUS   -- ADJUST USED SPACE --
          RJ     =XCMM.FFA   -- FIXED FREE ALGORITHM -- 
 SLF7     SA2    A0-MNSAVEA0  RESTORE A0
          SA0    X2 
          EQ     CMM.SLF     RETURN 
  
