*COMDECK SFF
          TITLE  COMMON MEMORY MANAGER, V1.0, CMM.SFF - SHRINK AT FWA FI
,XED
*CALL CMMCOM
          COMMENT  "SUBSYS"SHRINK AT FWA FIXED. 
          B1=1
 CMM.SFF  SPACE  4
***       CMM.SFF - SHRINK AT FWA FIXED.
* 
* 
*              THE SPECIFIED NUMBER OF WORDS ARE DELETED FROM THE 
*         BLOCK AT THE FWA END, AND THEIR CONTENTS ARE LOST.  IF THE
*         NUMBER SPECIFIED IS ZERO (0), NO CHANGE TO THE BLOCK IS MADE. 
*         THIS CALL INCREASES BLOCK-FWA BY THE SPECIFIED NUMBER.
* 
*         ENTRY  (X1) = BLOCK-FWA.
*                (X2) = NUMBER-OF-WORDS.
* 
*         EXIT   (B1) = 1.
* 
*         SAVES  X - 0, 5.
*                B - 2, 3.
*                A - 0. 
  
  
          CMMENT  SFF 
 CMM.SFF  EQ     *+400000B   ENTRY / EXIT 
          SB1    1
          SX1    X1 
          SX6    A0          SAVE A0
          SA3    RA65 
          BX3    -X3
  
 IS       IFSAFE
          SX3    X3 
          PL     X3,SFF102
          UERR   CMEFST,0,3RSFF  ILLEGAL 1ST CALL TO CMM
  
 SFF102   BSS    0
 IS       ENDIF 
  
          SA3    X3          (A0) = FL
          SA0    X3 
          SA6    A0-MNSAVEA0  SAVE A0 
  
 IS       IFSAFE
          SX7    3RSFF       SAVE FUNCTION NAME 
          SA7    A0-MNFNAME 
          SA4    CMM.SFF     SAVE RETURN ADDRESS
          LX4    30 
          BX6    X4 
          SA6    A0-MNRETURN
          SA3    A0-IMAPM 
          ZR     X3,SFF104
          UERR   CMEPMR,0    CALLED FROM POINTER-MAINTENANCE ROUTINE
  
 SFF104   SB7    B0           ? FIXED BLOCK 
          RJ     =XCMM.CAB   -- CHECK ACTIVE BLOCK, (X1) = FWA -- 
 IS       ENDIF 
  
          SX7    B1          SET FOR GROUP-ID PRESENT 
          SB7    X1-2        (B7) = ADDRESS OF BLOCK HEADER 
          SA3    B7+B1
          PL     X3,SFF2     IF 2-WORD HEADER 
          SX7    B0          SET FOR NO GROUP-ID
          SB7    B7+B1
 SFF2     SA4    B7          (X4) = HEADER WORD 0 
          SA7    GID         SAVE GROUP-ID FLAG 
  
 IS       IFSAFE
          SX6    X4          FWD
          LX4    59-45-2
          MI     X4,SFF106   IF REQUIRED SIZE-CODE BIT SET
          UERR   CMESCV,0    SIZE-CODE VIOLATION
  
 SFF106   IX6    X6-X1       BLOCK-SIZE = FWD - FWA 
          MI     X2,SFF107   IF NUM NEGATIVE
          IX3    X6-X2
          PL     X3,SFF108   IF NUM LE BLOCK SIZE 
 SFF107   UERR   CMENUM,0    ILLEGAL NUM SPECIFIED
  
 SFF108   LX4    -59+45+2    RESTORE HEADER WORD 0
 IS       ENDIF 
  
          ZR     X2,SFF17    IF ZERO CHANGE 
          LX4    -18
          SB5    X4          (B5) = FWA PREVIOUS REGION 
          SX1    B5          (X1) = FWA PREVIOUS REGION 
          SA3    B5 
          MI     X3,SFF6     IF PREVIOUS REGION NOT FREE
          IX6    X3+X2       ADVANCE FWD IN FREE REGION HEADER
          SA6    A3 
          EQ     SFF10
  
 SFF6     SX7    B7+X2       FORM NEW FREE REGION HEADER AT PREVIOUS
          LX1    18           HEADER FWA
          BX7    X7+X1
          SA7    B7 
          SX3    B7-B5       SET BKD IN HEADER WORD 0 
          IX4    X4+X3
 SFF10    LX4    18          STORE HEADER WORD 0 IN NEW LOCATION
          SA3    B7+B1       HEADER WORD 1 IN CASE GROUP-ID PRESENT 
          BX6    X4 
          SA6    B7+X2
          SA1    X6          ADJUST BKD IN NEXT HEADER
          LX2    18 
          IX7    X1+X2
          SA7    A1 
          LX2    -18
          BX7    X3 
  
*         ADJUST GROUP-ID CHAIN, IF NECESSARY.
  
          SA3    GID
          ZR     X3,SFF16    IF NO GROUP-ID 
          SA7    A6+B1       MOVE UP WORD 1 OF HEADER 
          SX1    X7          (X1) = GFWD
          AX7    18 
          SX3    X7          (X3) = GBKD
          ZR     X1,SFF12    IF LAST ENTRY IN CHAIN 
          SA4    X1          ADJUST GBKD IN NEXT ENTRY
          LX2    18 
          IX6    X4+X2
          SA6    A4 
          LX2    -18
 SFF12    SA4    X3          PREVIOUS ENTRY 
          NZ     X3,SFF14    IF NOT 1ST ENTRY 
          AX7    18          (B4) = GROUP-ID
          SB4    X7 
          SA4    A0-P.GID    FIND P.GID ENTRY TO ADJUST GFWD
          SA4    X4+B1
 SFF13    SA4    A4-B1       NEXT ENTRY 
          BX7    X4 
          AX7    36 
          SB5    X7 
          NE     B4,B5,SFF13  LOOP UNTIL MATCH
 SFF14    IX6    X4+X2       ADJUST GFWD
          SA6    A4 
  
*         ADJUST USED SPACE.
  
 SFF16    BX1    X2           ? SPACE FREED 
          RJ     =XCMM.AUS   -- ADJUST USED SPACE --
 SFF17    SA2    A0-MNSAVEA0  RESTORE A0
          SA0    X2 
          EQ     CMM.SFF     RETURN 
  
 GID      CON    0           NZ IF GROUP-ID PRESENT 
  
