*COMDECK FGR
          TITLE  COMMON MEMORY MANAGER, V1.0, CMM.FGR - FREE GROUP
*CALL CMMCOM
          COMMENT  "SUBSYS"FREE GROUP.
          B1=1
 CMM.FGR  SPACE  4
***       CMM.FGR - FREE GROUP. 
* 
* 
*              ALL OF THE BLOCKS ALLOCATED AS MEMBERS OF THE GROUP
*         IDENTIFIED BY GROUP-ID ARE FREED AND THE GROUP IS 
*         DEACTIVATED.
* 
*         ENTRY  (X1) = GROUP-ID. 
* 
*         EXIT   (B1) = 1.
* 
*         SAVES  X - 0, 5.
*                B - 2, 3.
*                A - 0. 
  
  
          CMMENT  FGR 
 CMM.FGR  EQ     *+400000B   ENTRY / EXIT 
          SB1    1
          SX6    A0          SAVE A0
          SA2    RA65 
          BX2    -X2
  
 IS       IFSAFE
          SX2    X2 
          PL     X2,FGR102
          UERR   CMEFST,0,3RFGR  ILLEGAL 1ST CALL TO CMM
  
 FGR102   BSS    0
 IS       ENDIF 
  
          SA2    X2          (A0) = FL
          SA0    X2 
          SA6    A0-MNSAVEA0  SAVE A0 
          SX6    B2-B0       SAVE B2
          SX7    B3-B0       SAVE B3
          SA6    FGRSV
          SA7    A6+B1
  
 IS       IFSAFE
          SX6    3RFGR       SAVE FUNCTION NAME 
          SA6    A0-MNFNAME 
          SA3    CMM.FGR     SAVE RETURN ADDRESS
          LX3    30 
          BX6    X3 
          SA6    A0-MNRETURN
          SA2    A0-IMAPM 
          ZR     X2,FGR104
          UERR   CMEPMR,0    CALLED FROM POINTER-MAINTENANCE ROUTINE
  
 FGR104   BSS    0
 IS       ENDIF 
  
*         REMOVE ENTRY FROM TABLE OF GROUP-IDS AND SHORTEN THE TABLE
*         BY THE NUMBER OF UNUSED ENTRIES AT THE END. 
  
          SA2    A0-P.GID 
          SB2    X2 
          AX2    18 
          SB3    X2          NUMBER OF ENTRIES
          SB2    B2-B3       FETCH ADDRESS
          SB7    B0          NO. OF UNUSED ENTRIES AT END TO FREE 
          SB6    B0          HIGHEST-USED-ENTRY-FOUND FLAG
          SB5    B0          ADDRESS OF ENTRY TO BE FREED 
 FGR2     ZR     B3,FGR8     IF ENTIRE BLOCK EXAMINED 
          SB2    B2+B1       ADVANCE SEARCH 
          SB3    B3-B1       REDUCE COUNT 
          SA2    B2          NEXT ENTRY 
          NZ     X2,FGR4     IF ENTRY BEING USED
          NZ     B6,FGR2     IF BELOW AREA THAT CAN BE FREED
          SB7    B7+B1       ADVANCE COUNT OF WORDS THAT CAN BE FREED 
          EQ     FGR2        LOOP 
  
 FGR4     AX2    36          COMPARE GROUP-ID 
          SX2    X2 
          IX3    X2-X1
          ZR     X3,FGR6     IF MATCH 
          SB6    B1          FLAG NO MORE WORDS TO BE FREED 
          EQ     FGR2        LOOP 
  
 FGR6     SB5    A2          NOTE DESIRED ENTRY 
          NZ     B6,FGR2     IF BELOW AREA THAT CAN BE FREED
          SB7    B7+B1       ADD THIS TO TOTAL TO BE FREED
          EQ     FGR2        LOOP 
  
 FGR8     BSS    0
  
 IS       IFSAFE
          NZ     B5,FGR106
          UERR   CMENGID,0   NON-EXISTENT GROUP-ID SPECIFIED
  
 FGR106   BSS    0
 IS       ENDIF 
  
          SA1    B5          FETCH ENTRY TO BE FREED
          SB2    X1          (B2) = POINTER TO FIRST BLOCK
          MX6    0           CLEAR ENTRY
          SA6    A1 
          SB3    B0          (B3) = HIGHEST BLOCK FREED 
          ZR     B7,FGR10    IF NO FREE WORDS AT END OF P.GID 
          SX2    -B7          ? -(NO. OF WORDS TO FREE) 
          SX1    P.GID        ? 
          RJ     =XCMM.CIA   -- CHANGE INTERNAL AREA -- 
  
*         FREE ALL BLOCKS IN THE CHAIN FOR THIS GROUP-ID. 
  
 FGR10    ZR     B2,FGR30    IF NO MORE BLOCKS
          SA4    B2          NEXT ENTRY IN GROUP-ID CHAIN 
          SB2    X4 
          MI     X4,FGR20    IF VARIABLE BLOCK
  
*         FREE A FIXED BLOCK. 
  
          SA4    A4-B1       BLOCK HEADER WORD 0
          SX3    X4           ? (X1) = SIZE OF BLOCK + HDR
          SX2    A4 
          IX1    X3-X2
          RJ     =XCMM.AUS   -- ADJUST USED SPACE --
  
*         COMMON CODE FOR FREEING A FIXED BLOCK AND ELIMINATING AN
*         EMPTY VP REGION.  ADJACENT FREE REGIONS, IF PRESENT, ARE
*         COMBINED INTO ONE.
  
 FGR12    SA3    X4          (X3) = NEXT HEADER 
          SA2    A4          (X2) = CURRENT HEADER, (A2) = ADDRESS
          AX4    18          (X1) = PREVIOUS HEADER 
          MX6    -36                                                     CMM0008
          SA1    X4 
          PL     X3,FGR13    IF NEXT IS FREE
          MI     X1,FGR15    IF PREVIOUS IS NOT FREE
          BX3    X2          USE CURRENT HEADER 
 FGR13    MI     X1,FGR14    IF PREVIOUS IS NOT FREE
          SA2    A1          SET A2 TO PREVIOUS HEADER
 FGR14    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 
 FGR15    BX6    -X6*X2      SET NEW FREE REGION                         CMM0008
          SA6    A2 
          EQ     FGR10       PROCESS NEXT BLOCK 
  
*         FREE A VARIABLE BLOCK.
  
 FGR20    SA4    A4-2        BLOCK HEADER WORD 0
          LX4    -36          ? (X1) = LENGTH + HEADER SIZE 
          SX1    X4+4 
          RJ     =XCMM.AUS   -- ADJUST USED SPACE --
  
 IS       IFSAFE
          SA2    A4+B1       HEADER WORD 1
          MX6    2           TYPE-CODE
          BX6    X6*X2
          NZ     X6,FGR110   IF BLOCK NOT TYPE 1
          AX2    18          AUX2 
          SX2    X2 
          ZR     X2,FGR110   IF NO TYPE 3 BLOCK POINTERS PRESENT
          UERR   CMEFTP3,0   MAY NOT FREE BLOCK WITH TYPE 3 PTR WDS 
  
 FGR110   BSS    0
 IS       ENDIF 
  
          LX4    18 
          R=     B7,2        FLAG WILL BECOME 0 IF LAST BLOCK 
          SX2    X4          (X2) = BKD 
          LX4    18          (X3) = FWD 
          SX3    X4 
          NZ     X3,FGR22    IF NOT FREEING HIGHEST BLOCK IN REGION 
          SB7    B7-B1       FLAG HIGHEST BLOCK 
          EQ     FGR23
  
 FGR22    SX7    A4          SET NEXT BKD = BKD OF FREED BLOCK
          SA1    X3 
          IX7    X2-X7
          LX7    18 
          IX6    X1+X7
          SA6    A1 
 FGR23    SA1    X2          FETCH PREVIOUS HEADER
          MX7    3           CODE = 7 IF REGION HEADER
          BX6    X7*X1
          BX6    X6-X7
          SX7    A4          SET FOR ADJUSTMENT OF FWD IN BITS 0-17 
          IX7    X3-X7
          ZR     X6,FGR24    IF PREV. HDR NOT REGION HDR
          SB7    B7-B1       FLAG FREEING 1ST (POSSIBLY ONLY) BLOCK 
          LX7    36          SET FOR ADJUSTMENT OF FWD IN BITS 36-53
 FGR24    ZR     B7,FGR26    IF FREEING LAST BLOCK OF REGION
          IX6    X1+X7       ADJUST FWD 
          SA6    A1 
          EQ     FGR10       PROCESS NEXT BLOCK 
  
*         TIME TO ELIMINATE A VP REGION SINCE THE LAST BLOCK IN IT IS 
*         BEING FREED.  TIE IN WITH THE FIXED BLOCK FREE ALGORITHM. 
  
 FGR26    SX1    B1           ? (X1) = 1 FOR REGION HEADER
          SA4    A1          (A4) = FWA VP REGION 
          RJ     =XCMM.AUS   -- ADJUST USED SPACE --
          EQ     FGR12       GO FORM ONE FREE REGION
  
*         RELEASE SOME FIELD LENGTH, IF POSSIBLE. 
  
 FGR30    RJ     =XCMM.FFA   -- FIXED FREE ALGORITHM -- 
                                (CALLS CMM.VFA IF NECESSARY)
          SA1    FGRSV       RESTORE B2 
          SA4    A0-MNSAVEA0  RESTORE A0                                 CMM0008
          SA0    X4                                                      CMM0008
          SA2    A1+B1       RESTORE B3 
          SB2    X1-0 
          SB3    X2-0 
          EQ     CMM.FGR     RETURN 
  
 FGRSV    BSS    2           SAVE AREA FOR B2, B3 
  
