*COMDECK SDA
          TITLE  COMMON MEMORY MANAGER, V1.0, CMM.SDA - SET DABA
          IPARAMS 
 OPSYS    MICRO  1,7,*"OS.NAME"_"OS.VER"* 
*CALL CMMCOM
          COMMENT  "SUBSYS"SET DABA.
          B1=1
 CMM.SDA  SPACE  4
***       CMM.SDA - SET DABA. 
* 
* 
*              IF NEW-DABA IS SMALLER THAN THE CURRENT VALUE OF DABA, 
*         THEN THE AREA FROM NEW-DABA TO DABA IS REGARDED AS BEING
*         -UNLOADED- BY THIS CALL, AND ANY UNLOAD-ACTION SUBROUTINES
*         PENDING UPON ANY PORTION OF THIS AREA ARE CALLED.  FOLLOWING
*         THIS, THE CURRENT VALUE OF DABA IS SET TO NEW-DABA.  CMM
*         ASSURES THAT THE CONTENTS OF ALL ACTIVE BLOCKS ARE
*         UNAFFECTED.  AN INITIAL CALL OF THIS FORM IS NOT NECESSARY. 
* 
*         ENTRY  (X1) = NEW-DABA. 
* 
*         EXIT   (B1) = 1.
* 
*         SAVES  X - 0, 5.
*                B - 2, 3.
*                A - 0. 
  
  
          CMMENT  SDA 
 CMM.SDA  EQ     *+400000B   ENTRY / EXIT 
          SB1    1
          RJ     =XCMM.ICM   INITIALIZE AND SET A0
          SX6    3RSDA       SAVE FUNCTION NAME 
          SA6    A0-MNFNAME 
  
 IS       IFSAFE
          SA3    A0-IMAPM 
          SA4    A0-IMAUA 
          ZR     X3,SDA101
          UERR   CMEPMR,0    CALLED FROM POINTER-MAINTENANCE ROUTINE
  
 SDA101   ZR     X4,SDA102
          UERR   CMEUAR,0    CALLED FROM UNLOAD-ACTION SUBR 
  
 SDA102   SA3    HHA
          SX3    X3 
          SX1    X1 
          IX3    X3-X1
          PL     X3,SDA103
          UERR   CMEDGHH,0   MAY NOT INCREASE DABA GT HHA 
  
 SDA103   BSS    0
 IS       ENDIF 
  
          SA2    CMM.SDA     SAVE RETURN ADDRESS
          BX7    X2 
          LX7    30 
          SX6    X1          SAVE PARAMETER (NEW-DABA)
          SA6    A0-NDABA 
          SA7    A0-MNRETURN
          SA4    RA65 
          BX4    -X4
          SX4    X4          (X4) = CURRENT DABA
          IX7    X6-X4       (X7) = CHANGE = NEW - CURRENT
          SA7    A0-CHANGE
          ZR     X7,SDA20    IF NO CHANGE 
          PL     X7,SDA6     IF INCREASE                                000150
  
*         PROCESS DECREASE IN DABA.  CALL UNLOAD-ACTION ROUTINES, AS
*         NECESSARY.
  
 IF       IFFAST
          SX2    =YCMM.PUA
          MI     X2,SDA3     IF UNLOAD-ACTION CODE NOT PRESENT
          BX2    X4           ? (X2) = LWA+1 OF UNLOADED AREA = DABA
                              ? (X1) = FWA OF UNLOADED AREA = NEW-DABA
          RJ     =YCMM.PUA   -- PROCESS UNLOAD ACTION --
 IF       ENDIF 
 IS       IFSAFE
          SX2    =YCMM.PUA
          PL     X2,SDA2     IF UNLOAD-ACTION CODE PRESENT
          SA2    A0-P.UAS    CHECK IF ANY PENDING UNLOAD-ACTION SUBRS 
          AX2    18 
          SX2    X2 
          ZR     X2,SDA3     IF NONE
          UERR   CMENEED,3RPUA  CMM.PUA NEEDED BUT NOT PRESENT
  
 SDA2     BX2    X4           ? (X2) = LWA+1 OF UNLOADED AREA = DABA
                              ? (X1) = FWA OF UNLOADED AREA = NEW-DABA
          RJ     =YCMM.PUA   -- PROCESS UNLOAD ACTION --
  
 IS       ENDIF 
  
 SDA3     BSS    0
          SA1    A0-NDABA    STORE FL AT NEW DABA 
          SX6    A0 
          MX4    2
          BX6    X4+X6
          SA6    X1 
          SA2    RA65        SET NEW DABA IN RA+65
          SA3    A0-CHANGE
          IX7    X2-X3
          SA7    A2 
          BX2    -X2
          SA4    X2+B1       FETCH HEADER FROM PREVIOUS DABA+1
          MI     X4,SDA4     IF NOT A FREE REGION 
          SA2    X4          ADJUST BKD IN NEXT HEADER TO POINT TO
          LX3    18           LOWER FREE REGION 
          IX6    X2+X3
          SA6    A2 
          SX7    X4          SET NEW FREE REGION HEADER AT NEW DABA+1 
          SX2    X1 
          LX2    18 
          BX7    X2+X7
          SA7    X1+B1
          EQ     SDA20       GO TO EXIT 
  
 SDA4     SX6    X3+B1       SET BKD TO POINT TO NEW FREE REGION
          LX6    18 
          IX6    X4+X6
          SA6    A4 
          SX7    A4          SET NEW FREE REGION HEADER AT DABA+1 
          SX6    X1 
          LX6    18 
          BX7    X6+X7
          SA7    X1+B1
          EQ     SDA20       GO TO EXIT 
  
*         PROCESS INCREASE IN DABA.  USE CMM.RLS IF NECESSARY TO CLEAR
*         OUT THE AREA BELOW NEW-DABA.
  
 SDA6     BSS    0                                                      000170
          SX2    X1+B1       SET FL TO (NEW DABA)+1, IF CURRENTLY LESS  000180
          SX6    A0                                                     000190
          SA3    A0-B1       MINIMUM ALLOWABLE                          000200
          IX3    X6-X3        = (NEW DABA) + 1 + (INTERNAL AREA SIZE)   000210
          IX3    X3+X2                                                  000220
          SB5    X4          (B5) = CURRENT DABA                        000224
          IX6    X6-X3       (CURRENT FL) - (MINIMUM ALLOWABLE)         000230
          BX4    -X6         NEEDED INCREASE IF PL                      000240
          PL     X6,SDA10    IF INCREASE NOT NECESSARY                  000250
          RJ     =XCMM.CFL   -- CHANGE FIELD LENGTH --                  000260
 SDA10    BSS    0
  
 IS       IFSAFE
          SA2    A0-P.GID    MAKE SURE NO GROUP-TYPE 1 BLOCK
          SA3    X2+B1        GROUPS ACTIVE 
          AX2    18 
          SB7    X2 
 SDA108   ZR     B7,SDA109
          SA3    A3-B1
          SB7    B7-B1
          PL     X3,SDA108   IF GROUP-TYPE 0
          UERR   CMENGT1     GROUP-TYPE 1 BLOCKS ILLEGALLY ACTIVE 
  
 SDA109   BSS    0
 IS       ENDIF 
  
          SA3    B5+B1                                                  000280
          SA1    A0-NDABA    (X1) = (NEW-DABA)                          000290
          SX4    X1+B1                                                  000300
          MI     X3,SDA11    IF 1ST REGION NOT FREE 
          SX2    X3 
          IX2    X2-X4       COMPARE LWA FREE REGION WITH (NEW-DABA)+1  000320
          PL     X2,SDA15    IF ALL BLOCKS ALREADY ABOVE NEW DABA 
 SDA11    BSS    0
  
 IS       IFSAFE
          SX2    =YCMM.RLS
          PL     X2,SDA110
          UERR   CMENEED,3RRLS  CMM.RLS NEEDED BUT NOT PRESENT
  
 SDA110   BSS    0
 IS       ENDIF 
  
          SX1    X1+B1        ? (X1) = NEW DABA+1 
          RJ     =YCMM.RLS   -- RELEASE LOWER SPACE --
  
*         MAKE INCREASE TO DABA AND ADJUST HEADERS ACCORDINGLY. 
  
 SDA15    SA1    RA65        (X3) = (OLD DABA) + 1
          BX1    -X1
          SX3    X1+B1
          SA2    A0-CHANGE   (X2) = CHANGE
          SX6    X2-1        SET FOR CASE OF FREE REGION ELIMINATED 
          LX6    18 
          SA1    X3          1ST HEADER 
          SA4    X1          2ND HEADER 
          IX6    X4+X6       ADVANCE BKD BY AMOUNT OF INCREASE
          SA6    A4 
          SX7    X1          (X7) = (1ST FREE REGION SIZE) - CHANGE 
          SX4    A1 
          IX7    X7-X4
          IX7    X7-X2
          ZR     X7,SDA16    IF NEXT REGION STARTS RIGHT ON NEW DABA+1
          SX3    B1          ADJUST BKD 
          LX3    18 
          IX6    X6+X3
          SA6    A6 
          LX2    18 
          IX6    X1+X2       ADJUST BKD IN 1ST HEADER 
          LX2    -18         MOVE UP 1ST HEADER (FREE REGION) 
          SB7    X2 
          SA6    A1+B7
 SDA16    SX6    A0          SET FL AT NEW DABA 
          MX4    2
          BX6    X4+X6
          SA6    A6-B1
          SA1    RA65        SET NEW DABA IN RA+65
          IX6    X1-X2
          SA6    A1 
  
*         RESTORE A0 AND EXIT.
  
 SDA20    SA1    A0-MNSAVEA0  RESTORE A0
          SA2    A0-MNRETURN  GET RETURN ADDRESS
          SA0    X1 
          SB7    X2 
          JP     B7          RETURN 
  
 NDABA    EQU    MNARG1      NEW-DABA 
 CHANGE   EQU    MNARG2      CHANGE TO DABA (OLD - NEW) 
          SPACE  4,10 
*         ALTERNATE ENTRY POINT TO CMM.SDA TO RETURN TO SCOPE 2 
*         OPERATING SYSTEM. 
  
 OS       IFC    EQ,*"OPSYS"*SCOPE 2* 
          CMMENT  SD2 
 CMM.SD2  BSS    0
          RJ     CMM.SDA
          MJ     434B        RETURN TO OU.LOL 
 OS       ENDIF 
  
