*COMDECK FRV
          TITLE  COMMON MEMORY MANAGER, V1.0, CMM.FRV - FREE VARYING
*CALL CMMCOM
          COMMENT  "SUBSYS"FREE VARYING.
          B1=1
 CMM.FRV  SPACE  4,10 
***       CMM.FRV - FREE VARYING. 
* 
* 
*              THE BLOCK WHOSE CURRENT FWA IS BLOCK-FWA IS FREED/ 
*         DESTROYED/ERASED, AND THE CONTENTS ARE LOST.
* 
*         ENTRY  (X1) = BITS 59-30 -- NOT REFERENCED BY CMM.
*                       BITS 29-0  -- BLOCK-FWA.
* 
*         EXIT   (B1) = 1.
* 
*         SAVES  X - 0, 5.
*                B - 2, 3.
*                A - 0. 
  
  
          CMMENT  FRV 
 CMM.FRV  EQ     *+400000B   ENTRY / EXIT 
          SB1    1
          SA2    RA65 
          SX6    A0          SAVE A0
          BX2    -X2
  
 IS       IFSAFE
          SX1    X1 
          SX2    X2 
          PL     X2,FRV102
          UERR   CMEFST,0,3RFRV  ILLEGAL 1ST CALL TO CMM
  
 FRV102   BSS    0
 IS       ENDIF 
  
          SA3    X2          (A0) = FL
          SA0    X3 
          SA6    A0-MNSAVEA0  SAVE A0 
  
 IS       IFSAFE
          SX7    3RFRV       SAVE FUNCTION NAME 
          SA7    A0-MNFNAME 
          SA2    CMM.FRV     SAVE RETURN ADDRESS
          LX2    30 
          BX6    X2 
          SA6    A0-MNRETURN
          SA4    A0-IMAPM 
          ZR     X4,FRV104
          UERR   CMEPMR,0    CALLED FROM POINTER-MAINTENANCE ROUTINE
  
 FRV104   SB7    B1           ? (B7) = 1 - VARIABLE BLOCK 
          RJ     =XCMM.CAB   -- CHECK ACTIVE BLOCK -- 
 IS       ENDIF 
  
          SA2    X1-3        HEADER WORD 1
          MX3    2
          BX3    X3*X2       (TYPE-CODE) - 1
          LX3    2
          SX4    X3-2 
          NZ     X4,FRV1     IF NOT TYPE-CODE 3 
          SA4    X2          FETCH HEADER WORD 1 OF TYPE 1 BLOCK
          SA4    X4-3         AND REDUCE AUX2 BY 1
          SX6    B1 
          LX6    18 
          IX6    X4-X6
          SA6    A4 
 FRV1     BSS    0
  
 IS       IFSAFE
          AX2    18 
          SX4    X2          AUX2 
          NZ     X3,FRV106   IF NOT TYPE-CODE 1 
          ZR     X4,FRV106   IF NO TYPE 3 POINTER WORDS 
          UERR   CMEFTP3     MAY NOT FREE BLOCK WITH TYPE 3 PTR WORDS 
  
 FRV106   BSS    0
 IS       ENDIF 
  
*         ADJUST POINTERS TO FREE BLOCK.
  
          SB7    X1-4        (B7) = HEADER FWA
          SA2    B7          (X2) = HEADER WORD 0, (A2) = ADDRESS 
          MX6    6           SET CODE FIELD OF BLOCK HEADER = 0 
          BX6    -X6*X2       (CMM.GBI WILL THUS KNOW THE BLOCK NO
          SA6    A2            LONGER EXISTS) 
          LX2    -36         (B5) = SPACE BEING FREED 
          R=     B6,2        (B6) = LAST BLOCK IN REGION FLAG            CMM0008
          SB5    X2+4             = (BLOCK SIZE) + (HEADER SIZE)
          LX2    18 
          SX1    X2          (X1) = BKD 
          LX2    18          (X3) = FWD 
          SX3    X2 
          NZ     X3,FRV2     IF NOT FREEING HIGHEST BLOCK IN REGION 
          SB6    B6-B1       FLAG HIGHEST BLOCK 
          EQ     FRV3 
  
 FRV2     SX7    A2          SET NEXT BKD = BKD OF FREED BLOCK
          SA4    X3 
          IX7    X1-X7
          LX7    18 
          IX6    X4+X7
          SA6    A4 
 FRV3     SA4    X1          FETCH PREVIOUS HEADER
          MX7    3           CODE = 7 IF REGION HEADER
          BX6    X7*X4
          BX6    X6-X7
          SX7    A2          SET FOR ADJUSTMENT OF FWD IN BITS 0-17 
          IX7    X3-X7
          ZR     X6,FRV4     IF PREV. HEADER NOT REGION HEADER
          SB6    B6-B1       FLAG FREEING 1ST (POSSIBLY ONLY) BLOCK 
          LX7    36          SET FOR ADJUSTMENT OF FWD IN BITS 36-53
 FRV4     ZR     B6,FRV6     IF FREEING ONLY BLOCK IN REGION
          SB5    B5-B1       NOT FREEING REGION HEADER
          IX6    X4+X7       ADJUST FWD 
          SA6    A4 
          EQ     FRV12
  
*         CHANGE EMPTY VP REGION INTO A FREE REGION AND COMBINE 
*         WITH ADJACENT FREE REGIONS, IF PRESENT. 
  
 FRV6     SA2    A4          (X2) = CURRENT (EMPTY VP REGION) HEADER
          SA3    X4          (X3) = NEXT HEADER 
          BX1    X2          (X1) = PREVIOUS HEADER 
          AX1    18 
          SA1    X1 
          PL     X3,FRV7     IF NEXT IS FREE
          MI     X1,FRV9     IF PREVIOUS IS NOT FREE
          BX3    X2          USE CURRENT HEADER 
 FRV7     MI     X1,FRV8     IF PREVIOUS IS NOT FREE
          SA2    A1          SET A2 TO PREVIOUS HEADER
 FRV8     BX4    X3-X2       NOW  (X2) = BKD2, FWD2 
          SX1    X4               (X3) = BKD3, FWD3 
          BX2    X2-X1       FORM (X2) = BKD2, FWD3 
          SA4    X3          SET BKD IN NEXT NON-FREE BLOCK 
          MX7    -18
          SX1    A2 
          LX7    18 
          LX1    18 
          BX4    X7*X4
          IX7    X4+X1
          SA7    A4 
 FRV9     MX7    -36         SET NEW FREE REGION
          BX6    -X7*X2 
          SA6    A2 
  
*         ADJUST USED SPACE.
  
 FRV12    SX1    B5+B1        ? (X1) = SPACE BEING FREED
          RJ     =XCMM.AUS   -- ADJUST USED SPACE --
  
*         ADJUST GROUP-ID CHAIN, IF NECESSARY.
  
          SA2    B7+2        HEADER WORD 2 OF FREED BLOCK 
          ZR     X2,FRV20    IF NOT PART OF A BLOCK GROUP 
          SX3    X2          (X3) = GFWD
          SX1    A2          (X1) = ADDRESS OF FREED ENTRY
          AX2    18 
          SX7    X2          (X7) = GBKD
          ZR     X3,FRV14    IF THIS WAS LAST ENTRY IN CHAIN
          SA4    X3          ADJUST GBKD IN NEXT ENTRY
          LX4    -18
          IX6    X4-X1
          IX6    X6+X7
          LX6    18 
          SA6    A4 
 FRV14    SA4    X7          PREVIOUS ENTRY 
          NZ     X7,FRV16    IF NOT FREEING 1ST ENTRY 
          AX2    18          (B4) = GROUP-ID
          SB4    X2 
          SA4    A0-P.GID    FIND P.GID ENTRY TO ADJUST GFWD
          SA4    X4+B1
 FRV15    SA4    A4-B1       NEXT ENTRY 
          BX7    X4 
          AX7    36 
          SB5    X7 
          NE     B4,B5,FRV15  LOOP UNTIL MATCH
 FRV16    IX6    X4-X1       ADJUST GFWD
          IX6    X6+X3
          SA6    A4 
  
*         TRY TO REDUCE FL. 
  
 FRV20    RJ     =XCMM.FFA   -- FIXED FREE ALGORITHM -- 
                                (CALLS CMM.VFA IF NECESSARY)
          SA2    A0-MNSAVEA0  RESTORE A0
          SA0    X2 
          EQ     CMM.FRV     RETURN 
  
          VFD    42/0,18/=XCMM.VFA
  
