*COMDECK ALV
          TITLE  COMMON MEMORY MANAGER, V1.0, CMM.ALV - ALLOCATE VARYING
*CALL CMMCOM
          COMMENT  "SUBSYS"ALLOCATE VARYING.
          B1=1
 CMM.ALV  SPACE  4,10 
***       CMM.ALV - ALLOCATE VARYING. 
* 
* 
*              CMM.ALV ALLOCATES/CREATES A VARYING-POSITION BLOCK OF
*         THE SPECIFIED SIZE AND PROPERTIES.  THE INITIAL CONTENTS
*         OF THE BLOCK ARE UNDEFINED. 
*              IF GROUP-ID IS NON-ZERO, THE BLOCK IS ALLOCATED AS A 
*         MEMBER OF THE IDENTIFIED GROUP. 
*              FOR BLOCK TYPES 1 AND 3, THE POINTER WORD IS INITIALIZED 
*         WITH BLOCK-FWA IN BITS 29-0 AND BLOCK-SIZE IN BITS 59-30. 
*         THIS POINTER WORD WILL BE MAINTAINED WITH THE CORRECT VALUES
*         BY CMM UNTIL THE BLOCK IS FREED.
*              FOR TYPE 2 BLOCKS, THE USER-SUPPLIED SUBROUTINE MANAGES
*         ALL POINTER MAINTENANCE.  THIS SUBROUTINE IS CALLED AS A
*         RESULT OF THIS CALL AND WHENEVER THE BLOCK WITH WHICH IT
*         IS ASSOCIATED IS MOVED BY CMM.
*              FOR TYPE 4 BLOCKS, THE USER MUST CALL THE FUNCTION 
*         CMM.FWA TO OBTAIN THE BLOCK-FWA.  THIS VALUE IS VALID ONLY
*         UNTIL THE NEXT CALL TO CMM.  WHEN THE USER DOES NOT ELECT TO
*         SUPPLY THE UNIQUE-ID, CMM GENERATES AND RETURNS ONE.
*              CMM WILL POSITION EACH BLOCK SO AS TO GUARANTEE EIGHT
*         (8) WORDS PAST THE LWA END OF THE BLOCK WHICH MAY BE FETCHED
*         WITHOUT CAUSING AN ADDRESS RANGE ERROR EXIT.
* 
*         ENTRY  (X2) = BLOCK-SIZE. 
*                (X3) = BITS 59-29 -- ZERO. 
*                       BITS 28-12 -- GROUP-ID. 
*                       BITS 11-6  -- SIZE-CODE.
*                       BITS  5-0  -- TYPE-CODE.
*                (X4) = BITS 59-36 -- ZERO. 
*                       BITS 35-18 -- AUX2. 
*                       BITS 17-0  -- AUX1. 
* 
*         EXIT   (X1) = IF TYPE-CODE = 4 AND AUX1 = 0,
*                          THEN UNIQUE-ID,
*                          ELSE UNDEFINED.
*                (B1) = 1.
* 
*         SAVES  X - 0, 5.
*                B - 2, 3.
*                A - 0. 
  
  
          CMMENT  ALV 
 CMM.ALV  EQ     *+400000B   ENTRY / EXIT 
          SB1    1
          RJ     =XCMM.ICM   INITIALIZE AND SET A0
          SX6    3RALV       SAVE FUNCTION NAME 
          SA6    A0-MNFNAME 
          SA1    CMM.ALV     SAVE RETURN ADDRESS
          LX1    30 
          BX6    X1 
          SA6    A0-MNRETURN
  
*         SAVE INPUT PARAMETERS.
  
          SX7    X2+4        SAVE BLOCK-SIZE + HEADER 
          SA7    A0-TOTSIZE 
  
 IS       IFSAFE
          PL     X2,ALV101
          UERR   CMESIZE,0   SIZE < 0 
  
 ALV101   BSS    0
 IS       ENDIF 
  
          MX7    -6          SAVE TYPE-CODE 
          BX6    -X7*X3 
          SA6    A0-TC
          AX3    6           SAVE SIZE-CODE 
          BX7    -X7*X3 
          SA7    A0-SC
          AX3    6           SAVE GROUP-ID
  
 IS       IFSAFE
          SB4    X6          (B4) = TYPE-CODE 
          LT     B4,B1,ALV102 
          SB5    B4-5 
          MI     B5,ALV103
 ALV102   UERR   CMETC,0     IMPROPERLY SPECIFIED TYPE-CODE 
  
 ALV103   SB5    X7-20B 
          MI     B5,ALV104   VERIFY SIZE-CODE 
          UERR   CMESC,0     IMPROPERLY SPECIFIED SIZE-CODE 
  
 ALV104   BSS    0
 IS       ENDIF 
  
          MX6    0           SET FOR NO GROUP-ID
          ZR     X3,ALV4     IF NO GROUP-ID 
          SA2    A0-P.GID    FIND ENTRY IN P.GID
          SB6    X3          (B6) = GROUP-ID
          SA1    X2+B1
  
          IFSAFE  2 
          AX2    18 
          SB7    X2 
 ALV2     SA1    A1-B1       NEXT ENTRY 
          BX6    X1 
          AX1    36 
          SB5    X1 
  
 IS       IFSAFE
          EQ     B5,B6,ALV106  IF CORRECT ENTRY 
          SB7    B7-B1
          NZ     B7,ALV2
          UERR   CMENGID,0   NON-ACTIVE GROUP-ID SPECIFIED
  
 ALV106   BSS    0
 IS       ELSE
          NE     B5,B6,ALV2  LOOP UNTIL CORRECT ENTRY FOUND 
 IS       ENDIF 
  
 ALV4     SA6    A0-GIDENT   SAVE P.GID ENTRY OR ZERO 
          SX7    X4          SAVE AUX1
          AX4    18          SAVE AUX2
          SA7    A0-AUX1
          SX6    X4 
          SA6    A0-AUX2
  
 IS       IFSAFE
          SB4    B4-2        (B4) = (TYPE-CODE) - 2 
          NE     B4,B1,ALV111  IF NOT TYPE-CODE 3 
          SA1    X7           ? (X1) = FWA OF TYPE 1 BLOCK
          SB7    B1           ? (B7) = 1 - CHECK VP BLOCK 
          SX1    X1 
          RJ     =XCMM.CAB   -- CHECK ACTIVE BLOCK -- 
          SX6    X6-4        VERIFY THIS BLOCK SIZE-CODE = 00XX 
          MI     X6,ALV108
          UERR   CMETY1M,0   POINTER WORD IN BLOCK WITH MOVEABLE FWA
  
 ALV108   SA1    X1-4        VERIFY AUX2 OF PROPER FORMAT 
          AX1    36 
          SB5    X1 
          SA2    A0-AUX2
          SB6    X2 
          MI     X2,ALV110
          LT     B6,B5,ALV113  IF AUX2 < BLOCK SIZE 
 ALV110   UERR   CMEAUX,0    IMPROPERLY SPECIFIED AUX2
  
 ALV111   LE     B4,B1,ALV113  IF NOT TYPE-CODE 4 
          LX7    59          VERIFY AUX1 NOT ODD
          PL     X7,ALV113
          UERR   CMEUID,0    IMPROPERLY SPECIFIED UNIQUE-ID 
  
 ALV113   BSS    0
 IS       ENDIF 
  
          SA2    A0-TC       (B4) = (TYPE-CODE) - 2 
          SB4    X2-2 
          LE     B4,B1,ALV6  IF NOT TYPE-CODE 4 
          SA1    A0-AUX1
          NZ     X1,ALV6     IF UNIQUE-ID SPECIFIED 
          SA2    A0-UNIQUEID  ADVANCE CMM-SUPPLIED UNIQUE-ID
          SX6    X2+2         AND SET AUX1 TO IT
          SA6    A2 
          SA6    A1 
 ALV6     BSS    0
  
 IS       IFSAFE
          SA1    A0-IMAPM 
          ZR     X1,ALV115
          UERR   CMEPMR,0    CALLED FROM POINTER-MAINTENANCE ROUTINE
  
 ALV115   BSS    0
 IS       ENDIF 
  
*         INITIAL #EASY# ATTEMPT. 
  
          RJ     ALVE 
          ZR     X1,ALV8     IF NOT SUCCESSFUL
          SA3    A0-MNSAVEA0  RESTORE A0
          SA0    X3 
          EQ     CMM.ALV     RETURN, (X1) = UNIQUE-ID OR UNDEFINED
  
*         IF OVERFLOW-ACTION CODE NOT PRESENT, CHECK DEFAULT TRIGGER
*         LEVEL AND, IF NOT REACHED, MAKE ONE TRY AT COMPLETING THE 
*         FUNCTION VIA THE #HARD# ATTEMPT.
  
 ALV8     SX2    =YCMM.GOA
          PL     X2,ALV14    IF OVERFLOW-ACTION CODE PRESENT
          SX1    B1           ? (X1) = 1 - ABORT IF EXCEEDED
          RJ     =XCMM.CUL   -- COMPUTE UTILIZATION LEVEL --
          RJ     ALVH 
          NZ     X1,ALV10    IF SUCCESSFUL
          MERR   ERRFAIL     CANNOT CONTINUE
  
*         RETURN THROUGH SAVED RETURN ADDRESS.  ACTUAL WOULD BE CHANGED 
*         IF OVERFLOW-ACTION PROCESSING EXECUTED THIS SAME FUNCTION.
  
 ALV10    SA2    A0-MNSAVEA0  RESTORE A0
          SA3    A0-MNRETURN  RETURN THRU SAVED RETURN ADDRESS
          SA0    X2 
          SB7    X3 
          JP     B7          RETURN, (X1) = UNIQUE-ID OR UNDEFINED
  
*         OVERFLOW-ACTION PROCESSING. 
  
 ALV14    SX1    ALVE         ? (X1) = #EASY# PROCESSOR 
          SX2    ALVH         ? (X2) = #HARD# PROCESSOR 
          SA3    A0-TOTSIZE   ? (X3) = SPACE NEEDED 
          RJ     =YCMM.GOA   -- GENERAL OVERFLOW ACTION --
          EQ     ALV10       GO TO RETURN 
  
 TOTSIZE  EQU    MNARG1      BLOCK SIZE, INCLUDING HEADER 
 TC       EQU    MNARG2      TYPE-CODE
 SC       EQU    MNARG3      SIZE-CODE
 GIDENT   EQU    MNARG4      P.GID ENTRY OR ZERO
 AUX1     EQU    MNARG5      AUX1 
 AUX2     EQU    MNARG6      AUX2 
 ALVE     SPACE  4,10 
**        ALVE - EASY CASE SUBROUTINE FOR ALLOCATE VARYING. 
* 
* 
*              THIS ROUTINE TRIES TO FIND A LARGE ENOUGH GAP IN A 
*         VARIABLE REGION FOR A BLOCK OF THE REQUESTED SIZE.  IF THE
*         BLOCK IS OF GROUP-TYPE 0, THE SEARCH BEGINS WITH THE
*         PRIMARY VP REGION AND PROGRESSES TO SUCCESSIVELY LOWER
*         SECONDARY VP REGIONS AS NECESSARY.  IF THE BLOCK IS TO BE 
*         OF GROUP-TYPE 1, THE SEARCH BEGINS WITH THE LOWEST
*         SECONDARY VP REGION AND PROGRESSES UPWARD, SO AS TO PLACE 
*         THE BLOCK BELOW HHA, IF POSSIBLE. 
*              AT ANY TIME WHEN THE PRIMARY VP REGION IS TO BE SEARCHED,
*         BUT FOUND NOT TO EXIST YET (USUALLY THE FIRST VP ALLOCATE), 
*         IT IS CREATED.  NOTE THAT EVERY VP REGION HAS AT LEAST ONE
*         BLOCK IN IT, SO THE FREEING OF THE LAST BLOCK WILL CAUSE A
*         VP REGION TO BE CHANGED TO A FREE REGION. 
*              A SECONDARY VP REGION WILL BE CREATED IN A LARGE 
*         ENOUGH FREE REGION ON A GROUP-TYPE 1 ALLOCATE IF THERE ARE
*         NO GAPS OF SUFFICIENT SIZE FOR THE BLOCK IN ANY OF THE
*         EXISTING SECONDARY VP REGIONS BELOW HHA.  FOR A GROUP-TYPE
*         0 ALLOCATE, A SECONDARY VP REGION WILL BE CREATED ONLY IF 
*         THERE ARE NO VP REGIONS ANYWHERE WITH A GAP OF SUFFICIENT 
*         SIZE. 
* 
*         ENTRY  ARGUMENTS ARE IN SAVE AREA.
*                (B1) = 1.
*                (A0) = FL. 
* 
*         EXIT   (X1) = NZ IF SUCCESS (UNIQUE-ID IF TYPE-CODE = 4 
*                            AND AUX1 = 0). 
*                       0 IF FAILURE. 
*                (B1) = 1.
*                (A0) = FL. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 5, 6, 7. 
  
  
 ALVE     EQ     *+400000B   ENTRY / EXIT 
          BX6    X0          SAVE X0
          LX7    X5          SAVE X5
          SA6    ALVESV 
          SA7    A6+B1
          SA1    HHA         SET FOR TA = HHA+1 
          SX6    X1+B1
          SA6    TA 
          SA5    A0-GIDENT
          ERRNZ  P.ENDZ-1 
          SA1    A0-B1       GET FWA PRIMARY VP REGION
          SA2    X1 
          AX2    18 
          SX6    X2 
          MI     X5,ALVE30   IF GROUP-TYPE 1
          SA6    A6          TA = FWA PRIMARY VP REGION 
  
*         TRY TO FIT BLOCK IN THE PRIMARY VP REGION.
  
 ALVE2    SA1    A0-B1
          MX6    0           FLAG PRIMARY VP REGION SEARCH
          SA6    FG 
          SA5    X1 
          AX5    18 
          SA3    X5 
          PL     X3,ALVE16   IF HIGHEST REGION FREE 
          ID     X3,ALVE13   IF HIGHEST REGION IS A FIXED BLOCK 
          SB4    X5          (B4) = FWA OF VP REGION
          SB5    X3          (B5) = LWA+1 OF VP REGION
  
*         SEARCH A VP REGION FOR A LARGE ENOUGH GAP TO CONTAIN THE
*         NEW BLOCK.  (B4) = FWA OF VP REGION; (B5) = LWA+1.
  
 ALVE4    SA1    B4          BEGIN VP REGION SEARCH 
          AX1    36          (B6) = FWA 1ST BLOCK HEADER
          SB6    X1          (X3) = SIZE OF FREE SPACE BEFORE 1ST BLOCK 
          SX3    B6-B4
          SX3    X3-1 
          SA4    A0-TOTSIZE  (X4) = REQUIRED SPACE FOR NEW BLOCK
          EQ     ALVE7       ENTER LOOP 
  
 ALVE6    ZR     B6,ALVE9    IF ALL GAPS EXAMINED 
          SA1    B6          NEXT BLOCK HEADER
          SB6    X1 
          SB7    A1+4        FREE SPACE = FWD - (FWA+BLOCK+HDR) 
          AX1    36 
          SB7    B7+X1
          SX3    B6-B7
          NZ     B6,ALVE7    IF NOT AT LAST BLOCK IN REGION 
          SX3    B5-B7       USE REGION FWD, NOT BLOCK FWD
 ALVE7    IX7    X3-X4       (GAP SIZE) - (REQUIRED SIZE) 
          MI     X7,ALVE6    IF NOT ENOUGH ROOM HERE
          SX1    A1          (X1) = REGION OR BLOCK-FWA 
          EQ     ALVE22      GO INSERT BLOCK
  
 ALVE9    SA2    FG 
          NZ     X2,ALVE36   IF SEARCHING THRU SECONDARY VP REGIONS 
 ALVE13   SA1    A0-GIDENT
          PL     X1,ALVE30   IF GROUP-TYPE 0, DO SEC VP REGION SEARCH 
          EQ     ALVE60      GO TO FAILURE RETURN 
  
*         PRIMARY VP REGION NOT PRESENT.  FORM IT AND INSERT THE BLOCK
*         (PROVIDED THERE IS ROOM). 
  
 ALVE16   SX5    X5          (X5) = FREE REGION FWA 
          IX0    X1-X5       (X0) = FREE REGION SIZE
          SA2    A0-TOTSIZE  SIZE OF NEW BLOCK, INCLUDING HEADER
          SX2    X2+B1       INCLUDE NECESSARY REGION HEADER WORD 
          IX1    X0-X2       (FREE SPACE) - (NEEDED SPACE)
          MI     X1,ALVE13   IF NOT ENOUGH SPACE
  
*         FORM NEW VP REGION WITHIN AN EXISTING FREE REGION.
*         (X1) = RESULTING FREE SPACE; (X5) = FREE REGION FWA.
  
 ALVE18   MX0    1           VP REGION HEADER 
          BX2    X2-X2        ? (X2) = 0 - INCREASE ALREADY ACCOUNTED 
          RJ     =XCMM.CRD   -- COMPUTE REGION DISTRIBUTION --
          SA4    X5          CURRENT FREE REGION HEADER 
          SX1    X5          (X1) = REGION FWA
          NZ     X6,ALVE20   IF TO FORM SMALLER FREE REGION 
          BX7    X0+X4       MERELY CHANGE REGION HEADER TO VP
          SA7    A4 
          EQ     ALVE22 
  
 ALVE20   SA3    X4          ADVANCE BKD OF NEXT HEADER 
          LX6    18 
          IX7    X3+X6
          SX2    X4          (X2) = NEW VP REGION LWA+1 
          SA7    A3 
          IX3    X4-X2       ADJUST FWD IN HEADER 
          LX6    -18
          BX0    X0+X2       FORM NEW VP REGION HEADER
          IX1    X5+X6       (X1) = NEW VP REGION FWA 
          LX5    18 
          IX6    X3+X1
          SA6    A4 
          BX7    X0+X5
          SA7    X1 
  
*         INSERT NEW VP BLOCK IN VP REGION. 
*         (X1) = REGION FWA OR FWA OF BLOCK JUST BEFORE THE GAP IN
*         WHICH TO PLACE THE BLOCK. 
  
 ALVE22   RJ     IVB         -- INSERT VARIABLE BLOCK --
          SA1    X6+B1       (X1) = AUX1 OF NEW BLOCK 
          SA2    ALVESV      RESTORE X0 
          SX1    X1 
          BX0    X2 
          NZ     X1,ALVE23   IF AUX1 IS POSSIBLY UNIQUE-ID
          SX1    B1          (X1) = NZ IN ANY CASE
 ALVE23   SA5    A2+B1       RESTORE X5 
          EQ     ALVE        RETURN, (X1) = NZ
  
*         TRY TO FIND SPACE IN A SECONDARY VP REGION, BEGINNING WITH
*         THE LOWEST. 
  
 ALVE30   MX6    30          FLAG SECONDARY VP REGION SEARCH
          SA6    FG 
          SA1    RA65 
          BX1    -X1
          SB6    X1+B1       (B6) = REGION POINTER FOR SEARCH 
          SB4    X1+B1       (B4) = FWA OF 1ST REGION 
          SA2    TA          (B7) = HIGHEST ADDRESS FOR LWA+1 VP REGION 
          SB7    X2 
 ALVE32   SA3    B6 
          SB5    A3 
          SB6    X3 
          GE     B5,B7,ALVE40  IF NO VP REGIONS BELOW TA
          MX7    3
          BX7    X7*X3
          MX6    1
          BX6    X6-X7
          NZ     X6,ALVE32   IF NOT A VP REGION 
  
*         IT IS NOW KNOWN THAT AT LEAST ONE SECONDARY VP REGION 
*         EXISTS BELOW LOCATION *TA*.  TRY TO FIND ROOM FOR THE NEW 
*         BLOCK IN ONE OF THEM. 
  
 ALVE34   ZR     B4,ALVE50   IF NO MORE VP REGIONS
          SA2    TA 
          SB7    X2 
          GE     B4,B7,ALVE50  IF ALL POSSIBLE VP REGIONS SEARCHED
          SA1    B4          FIND NEXT SECONDARY VP REGION
          SB5    X1 
          MX7    3
          BX7    X7*X1
          MX6    1
          BX6    X6-X7
          ZR     X6,ALVE4    IF A SECONDARY VP REGION 
 ALVE36   SB4    B5          ADVANCE REGION POINTER 
          EQ     ALVE34      LOOP 
  
*         TRY TO FIND A FREE REGION LARGE ENOUGH TO FORM A SECONDARY
*         VP REGION CONTAINING THE BLOCK. 
  
 ALVE40   GE     B4,B7,ALVE50  IF ALL POSSIBLE FREE REGIONS SEARCHED
          SA1    B4 
          SB5    X1 
          MI     X1,ALVE42   IF NOT A FREE REGION 
          SA2    A0-TOTSIZE  (X2) = VP SPACE NEEDED 
          SX2    X2+B1
          SX3    B5-B4       TOTAL FREE REGION SIZE 
          IX1    X3-X2       (X1) = RESULTING FREE SPACE
          SX5    A1          (X5) = REGION FWA
          MI     X1,ALVE42   IF NOT LARGE ENOUGH
          GT     B5,B7,ALVE50  IF THIS REGION EXTENDS ABOVE TA
          SA3    B5 
          ID     X3,ALVE18   IF NEXT REGION IS A FIXED BLOCK - SUCCESS
 ALVE42   SB4    B5          ADVANCE TO NEXT REGION 
          EQ     ALVE40 
  
 ALVE50   SA3    A0-GIDENT
          MI     X3,ALVE2    IF GROUP-TYPE1, DO PRI VP REGION SEARCH
 ALVE60   MX1    0           (X1) = 0 FOR FAILURE 
          SA2    ALVESV      RESTORE X0 
          BX0    X2 
          SA5    A2+B1       RESTORE X5 
          EQ     ALVE        RETURN 
  
 GETWEAK  VFD    42/0,18/=XCMM.RLS  TO FORCE THE LOADING OF ROUTINES
          VFD    42/0,18/=XCMM.VAF   REFERENCED ELSEWHAER BY WEAK 
          VFD    42/0,18/=XCMM.VFA   EXTERNALS
          VFD    42/0,18/=XCMM.VGF
          VFD    42/0,18/=XCMM.VSQ
 ALVESV   EQU    GETWEAK     X0, X5 SAVE AREA 
 FG       EQU    GETWEAK+2   PRI/SEC VP REGION SEARCH FLAG
 TA       EQU    GETWEAK+3   HIGHEST ADDRESS CONTROL FOR REGION SEARCH
 ALVH     SPACE  4,10 
**        ALVH - HARD CASE SUBROUTINE FOR ALLOCATE VARYING. 
* 
* 
*              THIS ROUTINE TRYS TO FIT THE REQUESTED BLOCK INTO A
*         VP REGION BY DOING WHATEVER IS NECESSARY (I.E., BLOCK MOVES 
*         AND/OR FL INCREASE).  THIS IS DONE BY THE SERVICES OF THE 
*         ROUTINE *PMV*, WHICH MAY COMBINE MORE THAN ONE VP REGION
*         INTO ONE IF THERE ARE MORE THAN ONE WHICH ARE NOT SEPARATED 
*         BY FIXED BLOCKS.  IF THE REQUESTED BLOCK IS GROUP-TYPE 0, 
*         THE GENERAL SEARCH IS DOWNWARDS, SO AS TO GIVE PREFERENCE TO
*         THE PRIMARY VP REGION.  IF GROUP-TYPE 1, THE SEARCH IS
*         UPWARDS SO AS TO GIVE THE GREATEST CHANCE OF PLACING THE
*         BLOCK BELOW HHA.
* 
*         ENTRY  ARGUMENTS ARE IN SAVE AREA.
*                (B1) = 1.
*                (A0) = FL. 
* 
*         EXIT   (X1) = NZ IF SUCCESS (UNIQUE-ID IF TYPE-CODE = 4 
*                            AND AUX1 = 0). 
*                       0 IF FAILURE. 
*                (B1) = 1.
*                (A0) = FL. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 5, 6, 7. 
  
  
 ALVH     EQ     *+400000B   ENTRY / EXIT 
          BX6    X0          SAVE X0
          LX7    X5          SAVE X5
          SA6    ALVHSV 
          SA7    A6+B1
          SA1    A0-GIDENT
          MI     X1,ALVH20   IF GROUP-TYPE 1
  
*         GROUP-TYPE 0 - SEARCH DOWNWARDS THRU EACH VP REGION GROUP 
*         (I.E., ONE OR MORE FREE AND/OR VP REGIONS NOT SEPARATED 
*         BY FIXED BLOCKS) AND USE *PVB* TO FIND ONE WHICH HAS ENOUGH 
*         SPACE FOR THE BLOCK.
  
          SA2    A0-B1       (X0) = REGION POINTER FOR DOWNWARD SEARCH
          BX0    X2 
          SB7    B0          (B7) = NON-FIXED POS. REGION COUNT 
 ALVH2    SA2    X0          (X0) = FWA OF NEXT-LOWER REGION
          SX1    X0           ? (X1) = FWA PREVIOUS REGION FOR PVB
          AX2    18 
          SX0    X2 
          SA3    X0          NEXT-LOWER REGION HEADER 
          ID     X3,ALVH4    IF FIXED BLOCK 
          SB7    B7+B1       ADVANCE CONSECUTIVE NON-FIXED REGION COUNT 
          EQ     ALVH2       LOOP 
  
 ALVH4    ZR     B7,ALVH6    IF 2 CONSECUTIVE FIXED BLOCKS
          RJ     PVB         -- PLACE VARIABLE BLOCK -- 
          NZ     X6,ALVH10   IF SUCCESS 
          SB7    B0          RESET CONSECUTIVE NON-FIXED REGION COUNT 
 ALVH6    SB6    X0          CHECK IF LAST FIXED BLOCK AT DABA
          SA4    RA65 
          BX4    -X4
          MX1    0           (X1) = 0 FOR FAILURE 
          SB4    X4 
          NE     B4,B6,ALVH2  IF NOT ALL REGIONS SEARCHED 
          EQ     ALVH11      RETURN WITH FAILURE
  
*         SUCCESS.  BLOCK HAS BEEN ALLOCATED.  (X6) = HEADER FWA OF 
*         NEW BLOCK.
  
 ALVH10   SA1    X6+B1       (X1) = AUX1 OF NEW BLOCK 
          SX1    X1 
          NZ     X1,ALVH11   IF AUX1 IS POSSIBLY UNIQUE-ID
          SX1    B1          (X1) = NZ IN ANY CASE
 ALVH11   SA2    ALVHSV      RESTORE X0 
          BX0    X2 
          SA5    A2+B1       RESTORE X5 
          EQ     ALVH        RETURN, (X1) ALREADY SET 
  
*         GROUP-TYPE 1 - SAME EXCEPT THE SEARCH THRU REGION GROUPS
*         IS UPWARD.
  
 ALVH20   SA1    RA65        (X0) = REGION POINTER FOR UPWARD SEARCH
          BX1    -X1
          SX0    X1+B1
          SB7    B0          (B7) = NON-FIXED-POS REGION COUNT
 ALVH22   SA1    X0          (X5) = NEXT REGION HEADER ADDRESS
          SX5    X1 
          ZR     X5,ALVH28   IF AT TRAILER
          ID     X1,ALVH24   IF AT A FIXED BLOCK
          SB7    B7+B1       ADVANCE NON-FIXED COUNT
 ALVH24   SA2    X5          NEXT REGION HEADER 
          DF     X2,ALVH26   IF NEXT REGION NOT A FIXED BLOCK 
          ZR     B7,ALVH26   IF CONSECUTIVE FIXED BLOCKS
          SX1    X0           ? (X1) = FREE OR VP REGION FWA
          RJ     PVB         -- PLACE VARIABLE BLOCK -- 
          SB7    B0          RESET NON-FIXED COUNT
          NZ     X6,ALVH10   IF SUCCESS 
 ALVH26   SX0    X5          ADVANCE TO NEXT REGION 
          EQ     ALVH22      LOOP 
  
 ALVH28   MX1    0           RETURN, (X1) = 0 FOR FAILURE 
          EQ     ALVH11 
  
 ALVHSV   EQU    ALVESV      2-WORD REGISTER SAVE AREA
 PVB      SPACE  4,10 
**        PVB - PLACE VARIABLE BLOCK. 
* 
* 
*              THIS ROUTINE ATTEMPTS TO INSERT A NEW VARIABLE BLOCK IN A
*         SPECIFIED VARIABLE OR FREE REGION.
* 
*         ENTRY  (X1) = FWA OF VP OR FREE REGION. 
*                (B1) = 1.
*                (A0) = FL. 
* 
*         EXIT   (X6) = FWA OF NEW BLOCK HEADER IF SUCCESSFUL.
*                       0 IF UNSUCCESSFUL.
*                (B1) = 1.
*                (A0) = FL. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 5, 6, 7. 
  
  
 PVB      EQ     *+400000B   ENTRY / EXIT 
                              ? (X1) = REGION FWA 
                              ? (B1) = 1 - FL INCREASE ALLOWED
          SA2    A0-TOTSIZE   ? (X2) = SIZE INCLUDING HEADER
          SX2    X2+1                + ONE WORD IN CASE NEW REGION
          RJ     =XCMM.PMV   -- PROCESS MULTIPLE VARIABLE REGIONS --
          ZR     X6,PVB      IF FAILURE 
          SA6    PVBNFWA     SAVE RESULTING VP REGION FWA 
          BX1    X7           ? (X1) = TOTAL FREE WORDS 
          MX2    0            ? (X2) = 0 - INCREASE ALREADY ACCOUNTED 
          RJ     =XCMM.CRD   -- COMPUTE REGION DISTRIBUTION --
          SA6    PVBFP       SAVE FIXED BLOCK SHARE OF FREE SPACE 
          SA1    PVBNFWA      ? (X1) = FWA VP REGION
          SA4    X1 
          AX4    36 
          SX4    X4 
          BX2    X6           ? (X2) = SPACE FOR POTENTIAL FIXED BLOCKS 
          ZR     X4,PVB2     IF NO BLOCKS IN REGION 
          SA3    A0-TOTSIZE   ? (X3) = SPACE FOR NEW BLOCK
          RJ     =XCMM.RVR   -- REARRANGE VARIABLE REGION --
 PVB2     SA1    PVBNFWA      ? (X1) = FWA VP REGION
          SA2    PVBFP        ? (X2) = SPACE FOR POTENTIAL FIXED BLOCKS 
          IX6    X1+X2       SET FWA OF VP REGION TO WHAT IT WILL BE
          SA6    A1           AFTER FREE REGION IS ADDED
          RJ     =XCMM.AFR   -- ADD FREE REGION --
          SA1    PVBNFWA      ? (X1) = FWA OF VP REGION 
          RJ     IVB         -- INSERT VARIABLE BLOCK --
          EQ     PVB         RETURN 
  
 PVBNFWA  BSS    1           FWA OF RESULTING VP REGION 
 PVBFP    BSS    1           RE-DISTRIBUTION AMOUNT FOR FIXED BLOCKS
  
 IVB      SPACE  4,10 
**        IVB - INSERT VARIABLE BLOCK.
* 
* 
*              THIS ROUTINE FINDS THE OPTIMUM LOCATION INSIDE A 
*         SPECIFIED FREE GAP WITHIN A VARIABLE POSITION REGION AND
*         INSERTS A NEWLY-ALLOCATED BLOCK THERE.  THE SELECTION OF
*         LOCATION IS BASED ON THE GROW BITS IN THE SIZE-CODE OF THE
*         NEW BLOCK AND ALSO THOSE OF THE ADJACENT BLOCKS.
*              IT IS ALREADY DETERMINED THAT THE BLOCK WILL FIT.
* 
*         ENTRY  (X1) = ADDRESS OF BLOCK (OR REGION) HEADER JUST
*                       BEFORE THE GAP TO DO THE INSERT.
*                (B1) = 1.
*                (A0) = FL. 
* 
*         EXIT   (X6) = BLOCK HEADER FWA. 
*                (B1) = 1.
*                (A0) = FL. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 5, 6, 7. 
*                A - 1, 2, 3, 4, 6, 7.
  
  
 IVB      EQ     *+400000B   ENTRY / EXIT 
          SA2    X1          BLOCK OR REGION HEADER 
          LX6    X2,B1
          LX2    -36
          SB5    X2          (B5) = FWD 
          SX7    X2          SET (X7) = FWD = 1ST BLOCK HDR FWA 
          SB6    B1          SET K = 1 FOR REGION HEADER
          PL     X6,IVB2     IF REGION HEADER 
          LX2    36          SET FWD = FWD FROM BLOCK HDR 
          SB6    X7+4        SET K = BLOCK SIZE + HDR SIZE
          SX7    X2 
          SB5    X7          (B5) = 0 IF INSERTING AFTER LAST BLOCK 
          NZ     X7,IVB3     IF NOT AFTER LAST BLOCK
          LX2    -18         GET FWD FROM REGION HDR
 IVB1     SA2    X2          NEXT HEADER DOWN 
          LX3    X2,B1
          SX7    X2          (X7) = FWD WHEN THERE
          LX2    -18
          MI     X3,IVB1     LOOP TO REGION HDR 
          EQ     IVB3        THIS NOT NEEDED, BUT OK
  
 IVB2     NZ     X7,IVB3     IF NOT EMPTY VP REGION 
          SA2    X1          SET FWD FROM HEADER
          SB5    B0          (B5) = 0 - INSERT AT END OF REGION 
          SX7    X2 
 IVB3     SB7    X1          (B7) = A = HEADER FWA
          SA4    A0-SC
          LX4    59-0 
          MI     X4,IVB6     IF LWA GROWTH IN SIZE-CODE 
          ZR     B5,IVB4     IF LAST BLOCK IN THE REGION
          SA3    B5+B1       WORD 1 OF NEXT BLOCK HEADER
          LX3    59-57
          MI     X3,IVB6     IF FWA END GROWTH PRESENT
  
*         PLACE BLOCK AS HIGH AS POSSIBLE.
  
 IVB4     SA1    A0-TOTSIZE  LENGTH + HEADER SIZE 
          IX4    X7-X1       (X4) = FWA = FWD - (LENGTH+HDR+SIZE) 
          EQ     IVB12
  
 IVB6     LX4    0-3
          MI     X4,IVB10    IF FWA GROWTH IN SIZE-CODE 
          SA3    B7+B1       BLOCK HEADER WORD 1
          EQ     B6,B1,IVB8  IF START OF REGION 
          LX3    59-57+3
          MI     X3,IVB10    IF LWA GROWTH IN PREVIOUS BLOCK
  
*         PLACE BLOCK AS LOW AS POSSIBLE. 
  
 IVB8     SX4    B7+B6       (X4) = FWA = PREVIOUS HDR FWA + K
          EQ     IVB12
  
*         PLACE BLOCK IN THE MIDDLE OF THE GAP. 
  
 IVB10    SA1    A0-TOTSIZE  SIZE 
          SX2    B7+B6       A + K
          IX3    X1+X2       A + K + SIZE 
          IX3    X7-X3       FWD - (A+K+SIZE) 
          AX3    1           [FWD-(A+K+SIZE)]/2 
          IX4    X7-X1       FWD - SIZE 
          IX4    X4-X3       (X4) = FWD - SIZE - [FWD-(A+K+SIZE)]/2 
  
*         FORM BLOCK HEADER.  (X4) = FWA FOR HEADER OF NEW BLOCK. 
  
 IVB12    SX1    B5          FWD = FWD FROM PREVIOUS HEADER 
          SX2    B7          BKD = ADR OF PREVIOUS HEADER 
          LX2    18 
          BX1    X1+X2
          SA2    A0-TOTSIZE  BLOCK-SIZE 
          BX6    X2 
          MX3    3           HEADER CODE = 7
          SA6    X4+3        SET GROWTH HIST. IN WD 3 = TOTAL SIZE
          SX6    X6-4 
          LX6    36 
          BX6    X1+X6       STORE HEADER WORD 0
          BX6    X3+X6
          SA6    X4 
          SA1    A0-TC       TYPE-CODE
          SX1    X1-1        (TYPE-CODE) - 1
          SA3    A0-AUX1     AUX1 
          SX6    X1-2 
          NZ     X6,IVB13    IF NOT TYPE-CODE 3 
          SA2    X3          INCREASE AUX2 OF TYPE 1 BLOCK BY 1 
          SA2    X2-3 
          SX7    B1 
          LX7    18 
          IX7    X2+X7
          SA7    A2 
 IVB13    SA2    A0-SC       SIZE-CODE
          LX1    58 
          LX2    54 
          BX6    X1+X2
          SA2    A0-AUX2     AUX2 
          LX2    18 
          BX6    X6+X2       STORE HEADER WORD 1
          BX6    X6+X3
          SA6    A6+B1
          MX6    0           SET HDR WORD 2 FOR NO GROUP-ID 
          SA6    A6+B1
          SA1    B7          SET PREVIOUS FWD = NEW HEADER ADDRESS
          LX2    X1,B1
          SX6    B5 
          IX6    X4-X6
          MI     X2,IVB14    IF NOT REGION HEADER 
          LX6    36 
 IVB14    IX6    X1+X6
          SA6    A1 
          SA2    X4 
          SX2    X2          SET NEXT BKD = NEW HEADER ADDRESS
          ZR     X2,IVB16    IF NEW BLOCK IS LAST BLOCK IN REGION 
          SX6    B7 
          IX6    X4-X6
          SA1    X2 
          LX6    18 
          IX6    X1+X6
          SA6    A1 
  
*         ADJUST GROUP-ID CHAIN IF BLOCK IS PART OF A BLOCK-GROUP.
  
 IVB16    SA1    A0-GIDENT
          ZR     X1,IVB20    IF NO GROUP-ID 
          SA2    A0-P.GID    FIND P.GID ENTRY 
          SA2    X2+B1
          MX6    42 
          LX6    36 
          BX1    -X6*X1 
 IVB17    SA2    A2-B1
          BX3    -X6*X2 
          IX3    X3-X1
          SX7    X2 
          NZ     X3,IVB17 
          SX3    X4+2        (X3) = HEADER WORD 2 ADDRESS 
          IX7    X2-X7       ADJUST FWD TO MAKE NEW ENTRY THE 1ST 
          IX7    X7+X3
          SA7    A2 
          SX2    X2          FORM NEW ENTRY IN HEADER WORD 2
          BX6    X2+X1        WITH FWD FROM P.GID 
          SX1    52B           AND WITH BKD = 0 
          LX1    54             AND WITH CODE = 52B 
          BX6    X6+X1
          SA6    X3 
          ZR     X2,IVB20    IF NEW ENTRY IS THE ONLY ONE 
          SA1    X2          SET BKD OF NEXT ENTRY = ADR OF NEW ENTRY 
          LX1    -18
          IX7    X1+X3
          LX7    18 
          SA7    A1 
  
*         MISCELLANEOUS TASKS TO COMPLETE.
  
 IVB20    SA1    A0-TOTSIZE  ADVANCE TOTAL SPACE ALLOCATED
          SA2    A0-CURALL    BY SIZE + HEADER
          IX6    X1+X2
          SA6    A2 
          BX1    X4           ? (X1) = CURRENT HEADER FWA 
          BX2    X4           ? (X2) = NEW HEADER FWA (SAME)
          RJ     =XCMM.PPM   -- PROCESS POINTER MAINTENANCE --
          BX6    X1          RETURN, (X6) = HEADER FWA
          EQ     IVB
  
