*DECK CMMEC 
          IDENT  CMM.EC 
  
          TITLE  COMMON MEMORY MANAGER, V1.0, SAFE VERSION SUBROUTINES
*CALL CMMCOM
          COMMENT  "SUBSYS"SAFE VERSION SUBROUTINES.
          B1=1
 CMM.CAB  TITLE  CMM.CAB - CHECK ACTIVE BLOCK 
**        CMM.CAB - CHECK ACTIVE BLOCK. 
* 
* 
*              THIS ROUTINE VERIFIES THAT A GIVEN ADDRESS IS, IN FACT,
*         THAT OF A BLOCK.  NOTE THAT THIS IS A PART OF THE ERROR-
*         CHECKING VERSION ONLY.
* 
*         ENTRY  (X1) = BLOCK FWA (THE ACTUAL, NOT THE HEADER). 
*                (B1) = 1.
*                (B7) = 0 - CHECK FOR FIXED BLOCK.
*                       1 - CHECK FOR VARIABLE BLOCK. 
*                (A0) = FL. 
* 
*         EXIT   BLOCK IS OK, AS OTHERWISE, THE ROUTINE ISSUES AN ERROR.
*                (X6) = SIZE-CODE.
*                (B1) = 1.
*                (A0) = FL. 
* 
*         USES   X - 6, 7.
*                B - NONE.
*                A - 2, 3, 4, 6, 7. 
  
  
          ENTRY  CMM.CAB
 CMM.CAB  EQ     *+400000B   ENTRY / EXIT 
          BX6    X1          SAVE X1
          LX7    X2          SAVE X2
          SA6    CABSV
          SA7    A6+B1
          BX6    X3          SAVE X3
          LX7    X4          SAVE X4
          SA6    A7+B1
          SA7    A6+B1
          SA2    RA65        (X2) = DABA+1 = REGION FWA 
          BX2    -X2
          SX7    X2          (X7) = INITIAL VALUE FOR BKD CHECK 
          SX2    X2+B1
          PL     X7,CAB2     IF DABA POSITIVE, IT IS MESSED UP
 CAB1     SB2    X2          (B2) = ADDRESS OF A BAD POINTER
          UERR   CMEPTR,0    BLOCK POINTERS MESSED UP 
  
 CAB2     SX4    A0          VERIFY THAT FWD < FL 
          IX6    X2-X4
          PL     X6,CAB1
          SA3    X2          (X3) = REGION HEADER 
          LX3    -18         VERIFY THAT CURRENT BKD POINTS TO
          SX4    X3           PREVIOUS HEADER 
          IX6    X4-X7
          LX3    18 
          NZ     X6,CAB1
          SX7    A3          (X7) = VALUE FOR NEXT BKD CHECK
          SX2    X3          (X2) = NEXT REGION FWA 
          NZ     X2,CAB3     IF MORE REGIONS
          UERR   CMEBFWA,0   BLOCK FWA ERROR
  
 CAB3     IX4    X7-X2       VERIFY THAT FWD POINTS ABOVE CURRENT HEADER
          PL     X4,CAB1
          MX6    3
          BX4    X6*X3       CHECK REGION TYPE
          LX4    3
          NZ     B7,CAB5     IF CHECKING A VARIABLE BLOCK 
          SX4    X4-6 
          NZ     X4,CAB2     IF NOT A FIXED BLOCK 
          SX6    A3+B1       SET BLOCK-FWA ACCORDING TO HEADER LENGTH 
          LX3    -44
          SX4    B1 
          BX4    X4*X3
          IX4    X4+X6
          IX6    X4-X1
          NZ     X6,CAB2     IF NOT THE DESIRED BLOCK 
          LX3    44-45       ISOLATE SIZE-CODE FOR RETURN 
          MX6    -3 
          BX6    -X6*X3 
          EQ     CAB10       RETURN 
  
 CAB5     SX4    X4-4 
          NZ     X4,CAB2     IF NOT A VARIABLE REGION 
          AX3    36 
          SX4    A3          (X4) = INITIAL VALUE FOR BKD CHECK 
          SX3    X3          FWD TO 1ST BLOCK IN REGION 
 CAB6     SX6    A0          VERIFY THAT FWD < FL 
          IX6    X3-X6
          PL     X6,CAB7
          SA3    X3          NEXT BLOCK HEADER WORD 0 
          LX3    -18         VERIFY THAT CURRENT BKD POINTS TO
          SX6    X3           PREVIOUS HEADER 
          IX6    X6-X4
          LX3    18 
          SX4    A3          (X4) = VALUE FOR NEXT BKD CHECK
          ZR     X6,CAB8
 CAB7     SX2    A3          ERROR EXIT, (X2) = VALUE FOR B2
          EQ     CAB1 
  
 CAB8     SX6    A3+4        BLOCK FWA
          IX6    X1-X6
          SX3    X3          FWD
          ZR     X6,CAB9     IF DESIRED BLOCK 
          ZR     X3,CAB2     IF LAST BLOCK IN VP REGION 
          IX6    X4-X3       VERIFY THAT FWD POINTS ABOVE CURRENT HEADER
          MI     X6,CAB6
          EQ     CAB7 
  
 CAB9     SA4    A3+B1       GET SIZE-CODE
          LX4    -54
          MX6    -4 
          BX6    -X6*X4 
  
*         RESTORE REGISTERS AND RETURN. 
  
 CAB10    SA1    CABSV       RESTORE X1 
          SA2    A1+B1       RESTORE X2 
          SA3    A2+B1       RESTORE X3 
          SA4    A3+B1       RESTORE X4 
          EQ     CMM.CAB     RETURN, (X6) = SIZE-CODE 
  
 CABSV    BSS    4           SAVE AREA FOR X1, X2, X3, X4 
 CMM.UEP  TITLE  CMM.UEP - USER ERROR PROCESSOR 
**        CMM.UEP - USER ERROR PROCESSOR. 
* 
* 
*              THIS ROUTINE CAUSES A STANDARD ERROR MESSAGE, FOLLOWED 
*         BY A SELECTED ONE, TO BE DAYFILED.  THEN THE JOB IS ABORTED.
*         THIS ENTIRE ROUTINE IS ASSEMBLED ONLY IN THE ERROR-CHECKING 
*         VERSION OF CMM. 
* 
*         ENTRY  (X1) = 2ND MESSAGE NUMBER. 
*                (X2) = INSERTION CHARS FOR 2ND MESSAGE.
*                       ZERO IF NONE. 
*                (B1) = 1 - GET FUNCTION NAME FROM HIGH-CORE AREA.
*                     = FUNCTION NAME OTHERWISE.
* 
*         EXIT   NONE.
  
  
          ENTRY  CMM.UEP
 CMM.UEP  EQ     *+400000B   ENTRY / EXIT 
          SX4    X1-CMEFST
          ZR     X4,UEP1     IF 1ST CALL, HIGH CORE HAS NOT BEEN SET UP 
          SA3    A0-OWNFG 
          ZR     X3,UEP1     IF NOT IN USER ERROR EXIT MODE 
          MX6    0           RESET FOR NEXT CALL TO CMM 
          SA6    A3 
          SA6    A0-OVERFLOW  CLEAR OVERFLOW MODE IF SET
          SA4    A0-MNRETURN  FORM X1 = 
          LX1    36            VFD 12/0,12/(UERR NO.),18/0,18/(CALL ADR)
          SB7    X3          (B7) = USER ADDRESS
          BX1    X1+X4
          SA2    A0-MNSAVEA0  RESTORE A0
          SA0    X2 
          JP     B7          RETURN TO USER 
  
 UEP1     BX3    X1          GET 2ND MESSAGE PARAMETERS 
          BX4    X2 
          SX1    CMEUSER     1ST MESSAGE
          SX6    B1-1 
          SA2    A0-MNFNAME  NAME FROM HIGH-CORE AREA 
          ZR     X6,UEP2     IF TO USE NAME FROM HIGH-CORE AREA 
          SB1    1           (B1) = 1 
          SX2    X6+B1       NAME FROM B1 
 UEP2     RJ     =XCMM.ERR   ISSUE 2 MESSAGES 
          ABORT 
  
          END 
