*COMDECK SXV
          TITLE  COMMON MEMORY MANAGER, V1.0, CMM.SFV - SHRINK AT FWA VA
,RYING
*CALL CMMCOM
          COMMENT  "SUBSYS"SHRINK AT FWA AND LWA VARYING. 
          B1=1
 CMM.SFV  SPACE  4,10 
***       CMM.SFV - SHRINK AT FWA VARYING.
* 
* 
*              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.
* 
*         ENTRY  (X1) = BITS 59-30 -- NOT REFERENCED BY CMM.
*                       BITS 29-0  -- BLOCK-FWA.
*                (X2) = NUMBER-OF-WORDS.
* 
*         EXIT   (B1) = 1.
* 
*         SAVES  X - 0, 5.
*                B - 2, 3.
*                A - 0. 
  
  
          CMMENT  SFV 
 CMM.SFV  EQ     *+400000B   ENTRY / EXIT 
          SB1    1
          SA3    RA65 
          SX6    A0          SAVE A0
          BX3    -X3
  
 IS       IFSAFE
          SX1    X1 
          SX3    X3 
          PL     X3,SFV102
          UERR   CMEFST,0,3RSFV  ILLEGAL 1ST CALL TO CMM
  
 SFV102   BSS    0
 IS       ENDIF 
  
          SA3    X3          (A0) = FL
          SA0    X3 
          SA6    A0-MNSAVEA0  SAVE A0 
  
 IS       IFSAFE
          SX7    3RSFV       SAVE FUNCTION NAME 
          SA7    A0-MNFNAME 
          SA4    CMM.SFV     SAVE RETURN ADDRESS
          LX4    30 
          BX6    X4 
          SA6    A0-MNRETURN
          SA3    A0-IMAPM 
          ZR     X3,SFV104
          UERR   CMEPMR,0    CALLED FROM POINTER-MAINTENANCE ROUTINE
  
 SFV104   SB7    B1           ? (B1) = 1 - VARIABLE BLOCK 
          RJ     =XCMM.CAB   -- CHECK ACTIVE BLOCK -- 
          LX6    59-2 
          MI     X6,SFV106   IF REQUIRED SIZE-CODE BIT SET
          UERR   CMESCV,0    SIZE-CODE VIOLATION
  
 SFV106   SA3    X1-4 
          MI     X2,SFV108   IF NUM NEGATIVE
          AX3    36          VERIFY NUM @ BLOCK SIZE
          SX6    X3+4 
          IX6    X6-X2
          PL     X6,SFV109
 SFV108   UERR   CMENUM,0    ILLEGAL NUM
  
 SFV109   BSS    0
 IS       ENDIF 
  
*         MOVE BLOCK HEADER UP BY AMOUNT OF DECREASE. 
  
          ZR     X2,SFV14    IF ZERO CHANGE 
          SA3    X1-4        SET NEW LENGTH IN HEADER 
          LX3    -36
          IX6    X3-X2
          LX6    36 
          SA6    A3 
          SB4    X1          (B4) = BLOCK FWA 
          SB5    X2          (B5) = DECREASE
          SX1    A3           ? (X1) = CURRENT HEADER FWA 
          IX2    X1+X2        ? (X2) = NEW HEADER FWA 
                              ? (B1) = 1 - CALL P-M SUBR IF TC = 2
          RJ     =XCMM.PPM   -- PROCESS POINTER MAINTENANCE 
          SA4    B4-B1       MOVE BLOCK HEADER UP BY DECREASE 
          SA3    A4-B1       (X3) = HEADER WORD 2 
          BX7    X4 
          LX6    X3 
          SA7    A4+B5
          SA6    A3+B5
          SA2    A3-B1       HEADER WORD 1
          SA1    A2-B1       HEADER WORD 0
          BX7    X2 
          LX6    X1 
          SA7    A2+B5
          SA6    A1+B5
          SX6    X6          FWD
          SX2    B5          (X2) = DECREASE
          SX4    B5          (X4) = DECREASE
          ZR     X6,SFV4     IF LAST BLOCK IN REGION
          SA4    X6          ADJUST BKD OF NEXT HEADER
          LX2    18 
          IX6    X4+X2
          SA6    A4 
          SX4    B5          (X4) = DECREASE
 SFV4     LX1    -18         (X1) = PREVIOUS HEADER 
          SA1    X1 
          MX6    3
          BX7    X6*X1
          BX7    X7-X6
          ZR     X7,SFV5     IF BLOCK HEADER
          LX4    36          SET TO ADJUST REGION HEADER
 SFV5     IX6    X1+X4       ADJUST FWD 
          SA6    A1 
          ZR     X3,SFV12    IF NO GROUP-ID 
          SB6    X3 
          SA1    X3          NEXT ENTRY IN CHAIN
          ZR     B6,SFV7     IF LAST ENTRY
          SX2    B5          (X2) = DECREASE = ADJ TO GBKD OR GFWD
          LX2    18 
          IX6    X1+X2       ADJUST GBKD
          SA6    A1 
 SFV7     LX3    -18         ADJUST PREVIOUS ENTRY IN CHAIN 
          SX4    X3 
          SA1    X3 
          NZ     X4,SFV9     IF NOT 1ST ENTRY IN CHAIN
          LX3    -18
          SB4    X3          (B4) = GROUP-ID
          SA1    A0-P.GID    FIND P.GID ENTRY TO ADJUST GFWD
          SA1    X1+B1
 SFV8     SA1    A1-B1       NEXT ENTRY 
          BX6    X1 
          AX6    36 
          SB6    X6 
          NE     B4,B6,SFV8  LOOP UNTIL MATCH 
 SFV9     LX2    -18         ADJUST GFWD
          IX6    X1+X2
          SA6    A1 
 SFV12    SX1    B5           ? (X1) = DECREASE 
          RJ     =XCMM.AUS   -- ADJUST USED SPACE --
          RJ     =XCMM.VFA   -- VARIABLE FREE ALGORITHM --
 SFV14    SA3    A0-MNSAVEA0  RESTORE A0
          SA0    X3 
          EQ     CMM.SFV     RETURN 
          TTL    COMMON MEMORY MANAGER, V1.0, CMM.SLV - SHRINK AT LWA VA
,RYING
 CMM.SLV  EJECT 
***       CMM.SLV - SHRINK AT LWA VARYING.
* 
* 
*              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) = BITS 59-30 -- NOT REFERENCED BY CMM.
*                       BITS 29-0  -- BLOCK-FWA.
*                (X2) = NUMBER-OF-WORDS.
* 
*         EXIT   (B1) = 1.
* 
*         SAVES  X - 0, 5.
*                B - 2, 3.
*                A - 0. 
  
  
          CMMENT  SLV 
 CMM.SLV  EQ     *+400000B   ENTRY / EXIT 
          SB1    1
          SA3    RA65        SAVE A0
          SX6    A0 
          BX3    -X3
  
 IS       IFSAFE
          SX1    X1 
          SX3    X3 
          PL     X3,SLV102
          UERR   CMEFST,0,3RSLV  ILLEGAL 1ST CALL TO CMM
  
 SLV102   BSS    0
 IS       ENDIF 
  
          SA3    X3          (A0) = FL
          SA0    X3 
          SA6    A0-MNSAVEA0  SAVE A0 
  
 IS       IFSAFE
          SX7    3RSLV       SAVE FUNCTION NAME 
          SA7    A0-MNFNAME 
          SA4    CMM.SLV     SAVE RETURN ADDRESS
          LX4    30 
          BX6    X4 
          SA6    A0-MNRETURN
          SA3    A0-IMAPM 
          ZR     X3,SLV104
          UERR   CMEPMR,0    CALLED FROM POINTER-MAINTENANCE ROUTINE
  
 SLV104   SB7    B1           ? (B7) = 1 - VARIABLE BLOCK 
          RJ     =XCMM.CAB   -- CHECK ACTIVE BLOCK -- 
          LX6    59-1 
          MI     X6,SLV106   IF REQUIRED SIZE-CODE BIT SET
          UERR   CMESCV,0    SIZE-CODE VIOLATION
  
 SLV106   SA3    X1-4 
          MI     X2,SLV108   IF NUM NEGATIVE
          AX3    36          VERIFY NUM @ BLOCK SIZE
          SX6    X3+4 
          IX6    X6-X2
          PL     X6,SLV109
 SLV108   UERR   CMENUM,0    ILLEGAL NUM
  
 SLV109   BSS    0
 IS       ENDIF 
  
*         REDUCE LENGTH IN HEADER.
  
          ZR     X2,SLV4     IF ZERO CHANGE 
          SA3    X1-4        HEADER WORD 0
          LX3    -36         REDUCE LENGTH
          IX6    X3-X2
          LX6    36 
          SA6    A3 
          SB5    X2          (B5) = DECREASE
          SX1    A3           ? (X1) = CURRENT HEADER FWA 
          SX2    A3           ? (X2) = NEW HEADER FWA (SAME)
          SB1    B0           ? (B1) = 0 - DO NOT CALL P-M SUBR 
          RJ     =XCMM.PPM   -- PROCESS POINTER MAINTENANCE --
          SX1    B5           ? (X1) = DECREASE 
          RJ     =XCMM.AUS   -- ADJUST USED SPACE --
          RJ     =XCMM.VFA   -- VARIABLE FREE ALGORITHM --
 SLV4     SA3    A0-MNSAVEA0  RESTORE A0
          SA0    X3 
          EQ     CMM.SLV     RETURN 
  
