*COMDECK GBI
          TITLE  COMMON MEMORY MANAGER, V1.0, CMM.GBI - GET BLOCK INFORM
,ATION
*CALL CMMCOM
          COMMENT  "SUBSYS"GET BLOCK INFORMATION. 
          B1=1
 CMM.GBI  SPACE  4
***       CMM.GBI - GET BLOCK INFORMATION.
* 
* 
*              THE CURRENT TYPE-CODE, SIZE-CODE, GROUP-ID, GROUP-TYPE,
*         AUX1, AUX2, AND BLOCK-SIZE OF THE BLOCK WHOSE CURRENT FWA IS
*         BLOCK-FWA ARE RETURNED.  FIXED-POSITION BLOCKS ARE DENOTED
*         BY A TYPE-CODE OF ZERO.  NON-RELEVANT PORTIONS OF AUX1 AND
*         AUX2 ARE RETURNED AS ZERO.
* 
*         ENTRY  (X1) = BLOCK-FWA.
* 
*         EXIT   (X2) = BLOCK-SIZE. 
*                (X3) BITS 59-30 -- ZERO. 
*                     BIT  29    -- GROUP-TYPE. 
*                     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. 
*                (B1) = 1.
* 
*         SAVES  X - 0, 5.
*                B - 2, 3.
*                A - 0. 
  
  
          CMMENT  GBI 
 CMM.GBI  EQ     *+400000B   ENTRY / EXIT 
          SB1    1
          SX1    X1 
          SX6    A0          SAVE A0
          SA3    RA65 
          BX3    -X3
  
 IS       IFSAFE
          SX3    X3 
          PL     X3,GBI102
          UERR   CMEFST,0,3RGBI  ILLEGAL 1ST CALL TO CMM
  
 GBI102   BSS    0
 IS       ENDIF 
  
          SA4    X3          (A0) = FL
          SA0    X4 
          SA6    A0-MNSAVEA0  SAVE A0 
  
 IS       IFSAFE
          SX7    3RGBI       SAVE FUNCTION NAME 
          SA7    A0-MNFNAME 
          SA4    CMM.GBI     SAVE RETURN ADDRESS
          LX4    30 
          BX6    X4 
          SA6    A0-MNRETURN
          IX7    X3-X1       VERIFY (BLOCK-FWA) > DABA
          PL     X7,GBI106
          SA3    A0-IMAPM 
          ZR     X3,GBI104
          UERR   CMEPMR,0    CALLED FROM POINTER-MAINTENANCE ROUTINE
  
 GBI104   BSS    0
 IS       ENDIF 
  
          SB7    X1-1        (B7) = ADDRESS OF HEADER WORD 0
          SA2    B7          (X2) = HEADER WORD 0 
          MX4    3
          BX7    X4*X2
          ZR     X7,GBI4     IF VARIABLE BLOCK
  
*         FIXED BLOCK.
  
          ID     X2,GBI2     IF ONE-WORD HEADER 
          SB7    B7-B1       TWO-WD, FETCH HEADER WORD 0
          SA2    B7 
  
          IFSAFE  1 
          DF     X2,GBI106   IF ILLEGAL HEADER CODE 
 GBI2     SX7    X2          (B4) = SIZE = FWD - FWA
          IX7    X7-X1
          SB4    X7 
          LX2    -45         SIZE-CODE
          MX6    -3 
          BX3    -X6*X2 
          LX3    6
          MX4    0           AUX1/AUX2 = 0
          PL     X2,GBI12    IF NO GROUP-ID 
          SB6    B7+B1       SET ADDRESS OF HEADER WORD 1 
          EQ     GBI8        GO GET GROUP-ID
  
*         VARIABLE BLOCK. 
  
 GBI4     SB7    B7-3        SET HEADER WORD 0 ADDRESS
          SA2    B7          FETCH HEADER WORD 0
  
 IS       IFSAFE
          MX7    3
          BX3    X7*X2
          BX7    X7-X3
          ZR     X7,GBI108   IF HEADER CODE = 7 
 GBI106   UERR   CMEBFWA,0   ILLEGAL HEADER CODE
  
 GBI108   BSS    0
 IS       ENDIF 
  
          LX2    -36         (B4) = SIZE
          SB4    X2 
          SA2    A2+B1       HEADER WORD 1
          MX7    -36         SET AUX2/AUX1
          BX4    -X7*X2 
          LX2    2           SET TYPE-CODE
          MX6    -2 
          BX3    -X6*X2 
          SX3    X3+B1
          MX6    4           SET SIZE-CODE
          BX6    X6*X2
          LX6    4+6
          BX3    X3+X6
          SB6    B7+2        SET ADDRESS OF HEADER WORD 2 
  
*         COMMON PROCESSING FOR GROUP-ID. 
  
 GBI8     SA2    B6 
          AX2    36          (B6) = GROUP-ID
          SX2    X2 
          SB6    X2 
          ZR     B6,GBI12    IF NO GROUP-ID 
          LX2    12          SET GROUP-ID 
          BX3    X3+X2
          SA1    A0-P.GID 
          SA2    X1+B1
          MX7    1
 GBI10    SA2    A2-B1       FIND P.GID ENTRY 
          AX2    36 
          SB5    X2 
          NE     B5,B6,GBI10
          BX7    X7*X2       SET GROUP-TYPE 
          LX7    1+29 
          BX3    X3+X7
  
*         SET RETURN. 
  
 GBI12    SX2    B4          (X2) = SIZE
          SA1    A0-MNSAVEA0  RESTORE A0
          SA0    X1 
          EQ     CMM.GBI     RETURN 
  
