*DECK CMM$SYP 
          IDENT  CMM$SYP
CMM$SYP   TITLE  CMM$SYP - *CMM* INTERFACE ROUTINE FOR *SYMPL* PROGRAMS.
  
          MACHINE  ANY,I
          COMMENT  *CMM* INTERFACE FOR *SYMPL* PROGRAMS 
          SST 
          B1=1
          SPACE  4
**        *************************************** 
*         * CMM$SYP - *SYMPL* INTERFACE ROUTINE * 
*         *************************************** 
* 
* 
*              THIS PROGRAM PROVIDES THE INTERFACE TO *CMM* FROM
*         PROGRAMS WRITTEN IN *SYMPL*.  FOR EACH ENTRY POINT IN *CMM* 
*         WHICH CAN BE CALLED FROM *SYMPL* PROGRAMS, IT CONTAINS AN 
*         ENTRY POINT WHICH DIFFERS ONLY BY THE PERIOD (.) BEING A
*         DOLLAR SIGN ($).
* 
*              IT CONVERTS THE STANDARD (A1) CALLING SEQUENCE PASSED
*         TO IT TO THE CALLING SEQUENCE (VARIOUS REGISTERS) EXPECTED
*         BY *CMM*.  UPON RETURN, ANY NECESSARY CONVERSION OF THE 
*         FORMAT FOR RETURN INFORMATION IS DONE.
* 
*              CURRENTLY, ONLY THOSE FUNCTIONS THAT WILL BE NEEDED BY 
*         COBOL 5 ARE PROVIDED.  EXAMPLES OF THE USAGE OF EACH ARE
*         SHOWN BELOW.
* 
*              REFER TO THE IMS OF *CMM* FOR MORE DESCRIPTION OF
*         THE FUNCTIONS - 
* 
*              THE ROUTINES PREFIXED WITH CMM USE THE POINTER WORD
*         DIRECTLY, THE ONES PREFIXED WITH CMI USE IT INDIRECTLY. 
*         FOR EXAMPLE, CMI$FRV (POINTERAD) WOULD HAVE THE POINTER TO THE
*         BASED ARRAY IN POINTERAD.  CMM$FRV (P<ARRAY>) WOULD BE USED 
*         TO DIRECTLY ADDRESS THE POINTER WORD. 
* 
*         TRACECM CAN BE CHANGED TO TRACE CMM CALLS AND MAP CMM AREA
*         SET IT TO 1 TO DO SO, 0 IF NOT. 
*         THE TRACE INFO IS WRITTEN ON THE FILE CMMTRAC 
*         IF ON, IT WILL SIGNIFICANTLY INCREASE COMPILER SIZE AND SLOW
*         IT DOWN.
* 
 TRACECM  EQU    0           SET OFF
* 
* 
*         THE VARIANT OF CMM (FAST OR SAFE) CALLED IS CONTROLLED BY THE 
*         MICRO CMM, WHICH IS CONTROLED BY DEBUGC.
 DBG1     IFNE   DEBUGC,0 
 CMM      MICRO  1,,/CMM./   SAFE VERSION (USED ON DEBUG SYSTEM)
 DBG1     ELSE
 CMM      MICRO  1,,/CMM./   FAST VERSION (USED ON NON-DEBUG SYSTEM)
*  ****** NOTE THAT FAST AND SAFE ARE SAME AND WILL BE TIL FDL
          ENDIF 
* 
*         +++++ BLOCK MANIPULATING CALLS +++++
* 
*         CMI$ALV OR CMM$ALV - ALLOCATE VARYING POISTION BLOCKS 
* 
*                FUNC CMM$ALV OR CMI$ALV
*                NOTHING=CMM$ALV(SIZE,TYPE$CODE,SIZE$CODE,GID,AUX1,AUX2)
  
          ENTRY  CMI$ALV
 CMI$ALV  DATA   0
          MX6    1
          SA6    INDFLG      SET INDIRECT FLAG
          SA2    CMI$ALV
          BX6    X2 
          SA6    CMM$ALV     SET EXIT FOR THIS ONE
          EQ     CMM$ALV+1
  
          ENTRY  CMM$ALV
 CMM$ALV  DATA   0           ENTRY/EXIT 
          SA5    INDFLG      GET INDIRECT FLAG
          MX6    0
          SA6    A5          CLEAR IT 
          SB1    1
          SA2    X1          (X2) = BLOCK-SIZE
          SA1    A1+B1       (X3, BITS 0-5) = POSITION-CODE 
          MX7    -6 
          SA3    X1 
          BX3    -X7*X3 
          SA1    A1+B1       (X3, BITS 6-11) = SIZE-CODE
          SA4    X1 
          BX4    -X7*X4 
          SA1    A1+B1       (X3, BITS 12-28) = GROUP-ID
          LX4    6
          BX3    X3+X4
          SA4    X1 
          SX4    X4 
 TCM0     IFEQ   TRACECM,1
          BX6    X4 
          SA6    GID
 TCM0     ENDIF 
          LX4    12 
          BX3    X3+X4
          SA1    A1+B1       (X4, BITS 0-17) = AUX1 
          PL     X5,ALVNI    JUMP IF NOT AN INDIRECT ACCESS 
          SA4    X1 
          BX1    X4 
 ALVNI    BSS    0
          SX4    X1          ADDR OF POINTER
          SA1    A1+B1       (X4, BITS 18-35) = AUX2
          SA1    X1 
          SX1    X1 
          LX1    18 
          BX6    X4 
          SA6    POINTER     SAVE POINTER ADDRESS 
          MX7    1
          SA7    =XCMM.NOL   TELL CMM NOT TO RETURN LENGTH IN PTRS
 TCM1     IFEQ   TRACECM,1
          BX7    X2 
          SA7    LENGTH      SAVE LENGTH FOR TRACE
 TCM1     ENDIF 
          BX4    X4+X1
          RJ     =X"CMM"ALV   CALL CMM
 TCM2     IFEQ   TRACECM,1
          SB5    CMM$ALV
          RJ     ALLOCV      WRITE TRACE LING 
 TCM2     ENDIF 
          SA1    POINTER     GET POINTER ADDRESS
          SA2    X1          GET POINTER WORD 
          SX6    X2          RETURN ADDRESS OF BLOCK
          EQ     CMM$ALV     EXIT 
 INDFLG   DATA   0           NEGATIVE IF INDIRECT, POS IF NOT 
          SPACE  2,1
**        CMM$ALF - ALLOCATE FIXED BLOCK
* 
*                   FUNC CMM$ALF; 
*                P<PLK>=CMM$ALF(SIZE,SIZE$CODE,GRPID) 
  
          ENTRY  CMM$ALF
  
CMM$ALF   EQ     *+400000B   ENTRY/EXIT 
          SA2    X1          (X2) = BLOCK-SIZE
          SA3    A1+1        GET SIZE CODE ADDRESS
          MX6    -6 
          SA4    X3          GET SIZE CODE
          BX3    -X6*X4 
          LX3    6           (X3) BITS 11-6 = SIZE CODE 
          SA4    A3+1        GET GROUP-ID 
          SA4    X4 
          MX5    -17
          BX5    -X5*X4 
          LX5    12 
          BX3    X5+X3       (X3) BITS 28-12 = GROUP-ID 
 TCM3     IFEQ   TRACECM,1
          BX6    X2 
          SA6    LENGTH 
          BX7    X4 
          SA7    GID
 TCM3     ENDIF 
          RJ     =X"CMM"ALF   CALL *CMM*
 TCM4     IFEQ   TRACECM,1
          SB5    CMM$ALF
          RJ     ALLOCF      WRITE TRACE LINE 
 TCM4     ENDIF 
          BX6    X1          RETURN, (X6) = BLOCK-FWA 
          EQ     CMM$ALF
          SPACE  2,1
**        CMM$FRF - FREE FIXED BLOCK
  
*                PROC CMM$FRF 
*                CMM$FRF(BLK) 
  
          ENTRY  CMM$FRF
 CMM$FRF  DATA   0           ENTRY/EXIT 
          SA1    X1 
 TCM4A    IFEQ   TRACECM,1
          SX7    X1 
          SA7    POINTER
          SA2    X1-1        GET HEADER WORD
          SX3    X1 
          LX2    6
          MX5    60-6 
          BX5    -X5*X2 
          SX5    X5-25B 
          AX2    6           REPOSITION 
          NZ     X5,FRFNGI   JP IF JP IF NOT GID HDR (25B IDENT)
          AX2    18+18
          SX6    X2 
          SA6    GID
          SA2    A2-1        GET FIRST HEADER 
 FRFNGI   BSS    0
          SX2    X2 
          IX6    X2-X3
          SA6    LENGTH 
 TCM4A    ENDIF 
                             (X1) = BLOCK FWA 
          RJ     =X"CMM"FRF   CALL CMM
 TCM5     IFEQ   TRACECM,1
          SB5    CMM$FRF
          RJ     FREEF       WRITE TRACE LINE 
 TCM5     ENDIF 
          EQ     CMM$FRF     RETURN 
          SPACE  2
**        CMI$FRV AND CMM$FRV - FREE VARIABLE BLOCK 
* 
*                CALLED AS CMM$FRF
* 
          ENTRY  CMI$FRV
 CMI$FRV  DATA   0           ENTRY/EXIT 
          SA1    X1          GET ADDR OF POINTER
          SA1    X1          INDIRECT - (X1) = BLOCK FWA
 TCM6     IFEQ   TRACECM,1
          SA2    CMI$FRV
          BX6    X2 
          SA6    CMM$FRV
          EQ     CMM$FRV+1
 TCM6     ELSE
          RJ     =X"CMM"FRV   CALL CMM
          EQ     CMI$FRV     RETURN 
 TCM6     ENDIF 
  
          ENTRY  CMM$FRV
 CMM$FRV  DATA   0           ENTRY/EXIT 
                             (X1) = BLOCK FWA 
 TCM6A    IFEQ   TRACECM,1
          RJ     SETVAR      SET VARIABLE BLOCK INFO
 TCM6A    ENDIF 
          RJ     =X"CMM"FRV   CALL CMM
 TCM7     IFEQ   TRACECM,1
          SB5    CMM$FRV
          RJ     FREEV       WRITE TRACE LINE 
 TCM7     ENDIF 
          EQ     CMM$FRV     RETURN 
          SPACE  2
**        CMI$GLV AND CMM$GLV - GROW AT LAST FOR VARYING BLKS 
* 
*                PROC CMI$GLV 
*                CMI$GLV(BLK,NUM) 
  
          ENTRY  CMI$GLV
 CMI$GLV  DATA   0           ENTRY/EXIT 
          SA2    A1+1        (X2) = NUM 
          SA1    X1          GET ADDR OF POINTER
          SA1    X1          (X1) = BLOCK FWA (INDIRECT)
          SA2    X2          GET NUM
 TCM8     IFEQ   TRACECM,1
          SA3    CMI$GLV
          BX6    X3 
          SA6    CMM$GLV
          EQ       CMMGLVA
 TCM8     ELSE
          RJ     =X"CMM"GLV   CALL CMM
          EQ     CMI$GLV     RETURN 
 TCM8     ENDIF 
  
          ENTRY  CMM$GLV
 CMM$GLV  DATA   0           ENTRY/EXIT 
          SA2    A1+1        (X2) = NUM 
                             (X1) = BLOCK-FWA  (NOTE - NOT INDIRECT)
          SA2    X2 
 TCM8A    IFEQ   TRACECM,1
 CMMGLVA  BSS      0
          RJ     SETVAR      SET VARIABLE BLOCK INFO
          BX6    X2 
          SA6    LENGTH 
 TCM8A    ENDIF 
          RJ     =X"CMM"GLV   CALL CMM
 TCM9     IFEQ   TRACECM,1
          SB5    CMM$GLV
          RJ     GROWV       WRITE TRACE LINE 
 TCM9     ENDIF 
          EQ     CMM$GLV
          SPACE  2
**        CMI$SLV AND CMM$SLV - SHRINK AT LAST - VARIABLE POS BLKS
* 
*                PROC CMI$SLV 
*                CMI$SLV(BLK,NUM) 
  
          ENTRY  CMI$SLV
 CMI$SLV  DATA   0           ENTRY/EXIT 
          SA2    A1+1        ADDR OF NUM
          SA1    X1          GET ADDR OF POINTER
          SA1    X1          (X1) = BLOCK FWA (INDIRECT)
          SA2    X2          (X2) = NUM 
 TCM10    IFEQ   TRACECM,1
          SA3    CMI$SLV
          BX6    X3 
          SA6    CMM$SLV
          EQ     CMMSLV2
 TCM10    ELSE
          RJ     =X"CMM"SLV   CALL CMM
          EQ     CMI$SLV     RETURN 
 TCM10    ENDIF 
  
          ENTRY  CMM$SLV
 CMM$SLV  DATA   0           ENTRY/EXIT 
          SA2    A1+1        (X2) = NUM 
                             (X1) = BLOCK-FWA  (NOTE - NOT INDIRECT)
          SA2    X2 
 TCM10A   IFEQ   TRACECM,1
 CMMSLV2  BSS    0
          RJ     SETVAR      SET VARIABLE BLOCK INFO
          BX7    X2 
          SA7    LENGTH 
 TCM10A   ENDIF 
          RJ     =X"CMM"SLV   CALL CMM
 TCM11    IFEQ   TRACECM,1
          SB5    CMM$SLV
          RJ     SHRINKV     WRITE TRACE LINE 
          SA1    SVLEN       GET LENGTH SAVED FROM OVERFLOW 
          ZR     X1,CMM$SLV  JP IF NONE 
          BX6    X1 
          SA6    LENGTH 
          MX7    0
          SA7    A1          ZERO OUT SAVED AND RESTORE SAVED 
          SA2    SVGID
          SA7    A2 
          BX6    X2 
          SA6    SVGID
          SA1    SVADDR 
          SA7    A1 
          BX6    X1 
          SA6    ADDR 
          SA2    SVPTR
          SA7    A2 
          BX6    X2 
          SA6    POINTER
 TCM11    ENDIF 
          EQ     CMM$SLV     RETURN 
 POINTER  DATA   0
          SPACE  2
**        CMI$CSV AND CMM$CSV - CHANGE BLOCK SPECS - VARIABLE POS 
* 
*                PROC CMI$CSV 
*                CMI$CSV(BLK,NEWSC,NEWTC,NEWAUX1,NEWAUX2) 
  
          ENTRY  CMI$CSV
 CMI$CSV  DATA   0           ENTRY/EXIT 
          SB1    1
          SA2    A1+B1       ADDR OF NEW SIZE-CODE
          SA3    A2+B1       ADDR OF NEW TYPE-CODE
          SA4    A3+B1       ADDR OF NEW AUX1 
          SA5    A4+B1       ADDR OF NEW AUX2 
          SA1    X1          GET ADDR OF POINTER
          SA1    X1          (X1) = BLOCK FWA (INDIRECT)
          SA2    X2          (X2) = NEW-SIZE-CODE 
          SA3    X3          (X3) = NEW-TYPE-CODE 
          SA4    X4          (X4) = NEW-AUX1
          SA5    X5 
          BX6    X5          (X6) = NEW-AUX2
          RJ     =X"CMM"CSV   CALL CMM
          EQ     CMI$CSV     RETURN 
  
          ENTRY  CMM$CSV
 CMM$CSV  DATA   0           ENTRY/EXIT 
          SB1    1
          SA2    A1+B1       ADDR OF NEW-SIZE-CODE
          SA3    A2+B1       ADDR OF NEW-TYPE-CODE
          SA4    A3+B1       ADDR OF NEW-AUX1 
          SA5    A3+B1       ADDR OF NEW-AUX2 
                             (X1) = BLOCK-FWA (NOT INDIRECT)
          SA2    X2          (X2) = NEW-SIZE-CODE 
          SA3    X3          (X3) = NEW-TYPE-CODE 
          SA4    X4          (X4) = NEW-AUX1
          SA5    X5 
          BX6    X5          (X6) = NEW AUX2
          RJ     =X"CMM"CSV   CALL CMM
          EQ     CMM$CSV     RETURN 
          SPACE  3,2
**        +++++ MANIPULATING THE OVERFLOW-ACTION STACK +++++
* 
*         CMM$POE - STACK OVERFLOW ENTRY. 
* 
*                   FUNC CMM$POE; 
*                   OVID=CMM$POE(OVSUBR,TRIGGER,CWDSTRIG) 
  
          ENTRY  CMM$POE
  
CMM$POE   EQ     *+400000B   ENTRY/EXIT 
          BX4    X1          (X4) = OVERFLOW SUBROUTINE ADDR
          SB1    1
          SA2    A1+B1       ADDR OF TIRGGER
          SA3    A2+B1       ADDR OF CONTIG WORDS TRIGGER 
          SA2    X2          (X2) = TRIGGER VALUE 
          SA3    X3          (X3) = CONTIGUOUS WORDS TRIGGER
          RJ     =X"CMM"POE   CALL *CMM*
          BX6    X1          RETURN, (X6) = ENTRY-ID
          IFEQ   TRACECM,1,1
          STORE  CMMTRAC,FF=YES        SET FLUSH FLAG 
          EQ     CMM$POE
          SPACE  2,1
**        CMM$DOE - DELETE OVERFLOW ENTRY.
* 
*                   PROC CMM$DOE; 
*                   CMM$DOE(OVID);
  
          ENTRY  CMM$DOE
  
CMM$DOE   EQ     *+400000B   ENTRY/EXIT 
          SA1    X1          (X1) = ENTRY-ID
          RJ     =X"CMM"DOE   CALL *CMM*
          EQ     CMM$DOE     RETURN 
          SPACE  3,2
**        +++++ BLOCK GROUP CALLS +++++ 
* 
*         CMM$AGR - ACTIVATE BLOCK GROUP. 
* 
*                   FUNC CMM$AGR; 
*                   GID=CMM$AGR(GRPTYPE)
  
          ENTRY  CMM$AGR
  
CMM$AGR   EQ     *+400000B   ENTRY/EXIT 
          SA1    X1          (X1) = GROUP-TYPE
          RJ     =X"CMM"AGR   CALL *CMM*
          BX6    X2          RETURN, (X6) = GROUP-ID
 TCM11B   IFEQ   TRACECM,1
          SB5    CMM$AGR
          RJ     ASGNGR 
 TCM11B   ENDIF 
          EQ     CMM$AGR
          SPACE  2,1
**        CMM$FGR - FREE ALL BLOCKS OF A GROUP. 
* 
*                   PROC CMM$FGR; 
*                   CMM$FGR(GID); 
  
          ENTRY  CMM$FGR
  
CMM$FGR   EQ     *+400000B   ENTRY/EXIT 
          SA1    X1          (X1) = GROUP-ID
 TCM11A   IFEQ   TRACECM,1
          BX6    X1 
          SA6    GID
 TCM11A   ENDIF 
          RJ     =X"CMM"FGR   CALL *CMM*
 TCM12    IFEQ   TRACECM,1
          SB5    CMM$FGR
          RJ     FGR         WRITE TRACE LINE 
 TCM12    ENDIF 
          EQ     CMM$FGR     RETURN 
  
  
**        CMM$GSS            GENERATE STATS 
* 
*                FUNC CMM$GSS 
*                P<STATARRAY>=CMM$GSS;
  
          ENTRY  CMM$GSS
  
 CMM$GSS  DATA   0           ENTRY/EXIT 
          RJ     =X"CMM"GSS   CALL CMM
          BX6    X1          RETURN (X6) = ADDR OF ARRAY OF STATS 
          EQ     CMM$GSS     RETURN 
          SPACE  2
**        CMM$OPX - OPTIMIZATION CALLS - X = 1 THRU 4 
* 
*                CALL ALL AS PROCS WITH NO PARAMS 
* 
          ENTRY  CMM$OP1
 CMM$OP1  DATA   0
          RJ     =X"CMM"OP1 
          EQ     CMM$OP1
  
          ENTRY  CMM$OP2
 CMM$OP2  DATA   0
          RJ     =X"CMM"OP2 
 TCM13    IFEQ   TRACECM,1
          RJ     PRTCMM      PRINT A CMM MAP
 TCM13    ENDIF 
          EQ     CMM$OP2
  
          ENTRY  CMM$OP3
 CMM$OP3  DATA   0
          RJ     =X"CMM"OP3 
          EQ     CMM$OP3
  
          ENTRY  CMM$OP4
 CMM$OP4  DATA   0
          RJ     =X"CMM"OP4 
          EQ     CMM$OP4
 TCMALL   IFEQ   TRACECM,1
          TITLE  CMM TRACE ROUTINES 
* 
*         THESE ROUTINES ARE USED TO WRITE A TRACE OF CMM ACTIVITY
*         THE ROUTINE PRTCMM CAN BE CALLED AT ANY TIME TO WRITE A 
*         MAP OF THE CMM AREA - CALL AS A PROC OR BY AN RJ
*         THE TRACE INFO IS ON FILE CMMTRAC IN Z REC PRINTABLE DATA 
* 
 ALLOCF   DATA   0           ALLOCATE FIXED BLOCK 
          BX6    X1 
          SA6    POINTER
          SA4    LENMS
          SA5    ADDMS
          SA3    =10H ALLOC FX
          RJ     OPMSG
          EQ     ALLOCF 
 ALLOCV   DATA   0           ALLOCATE VARIABLE
          SA4    LENMS
          SA5    POINTMS
          SA3    =10H ALLOC VA
          MX6    1
          SA6    VARFLG      FLAG AS VARIABLE BLOCK 
          RJ     OPMSG
          EQ     ALLOCV 
 ASGNGR   DATA   0           ASSIGN GROUP ID
          SA3    =10H ASGN GR 
          SA4    SPACES 
          SA5    SPACES 
          BX1    X6          SAVE X6
          SA6    GID
          RJ     OPMSG
          BX6    X1          RESTORE X6 
          EQ     ASGNGR 
 FREEF    DATA   0
          SA3    =10H FREE FX 
          SA4    LENMS
          SA5    ADDMS
          RJ     OPMSG
          EQ     FREEF
 FREEV    DATA   0           FREE VARIABLE BLOCK
          SA3    =10H FREE VA 
          SA4    LENMS
          SA5    POINTMS
          RJ     OPMSG
          EQ     FREEV
 GROWV    DATA   0           GROW VARIABLE BLOCK
          RJ     SETNEWL     SET NEW LENGTH 
          SA3    =10H GROW VA 
          SA4    BYMS 
          SA5    POINTMS
          MX6    1
          SA6    VARFLG      FLAG AS VARIABLE BLOCK 
          RJ     OPMSG
          EQ     GROWV
 SHRINKV  DATA   0           SHRINK VARIABLE BLOCK
          RJ     SETNEWL     SET NEW LENGTH 
          SA3    =10H SHRINK
          SA4    BYMS 
          SA5    POINTMS
          MX6    1
          SA6    VARFLG      FLAG AS VARIABLE BLOCK 
          RJ     OPMSG
          EQ     SHRINKV
 FGR      DATA   0           FREE GROUP 
          SA3    =10H FREE GR 
          SA4    SPACES 
          SA5    SPACES 
          RJ     OPMSG
          EQ     FGR
 SETVAR   DATA   0           SET UP VARIABLE BLOCK INFO 
          SA3    X1-2        GET GID HEADER WORD
          AX3    18+18
          SX6    X3 
          SA6    GID
          SA3    X1-3        GET AUX1 HEADER (POINTER)
          SX7    X3          AUX1 (POINTER) 
          SA7    POINTER
          SA3    X1-4        GET FIRST HEADER WORD
          AX3    18+18
          SX6    X3          LENGTH 
          SA6    LENGTH 
          EQ     SETVAR 
 SETNEWL  DATA   0
          SA2    POINTER
          SA3    X2          GET HEADER 
          AX3    18+18
          SX6    X3 
          SA6    NEWBLL 
          EQ     SETNEWL
          SPACE  5
 OPMSG    DATA   0           WRITE THE TRACE LINE 
          SB1    1
          BX6    X1 
          SA6    =SSAVEX1    SAVE X1
          BX7    X3          MESSAGE 1
          SA7    MSGX 
          BX6    X4 
          SA6    MSGXLN      LENGTH MESSAGE 
          BX7    X5 
          SA7    MSGXPT      POINTER MESSAGE
          SA1    B5 
          AX1    30          ENTRY TO ROUTINE 
          SX1    X1-1        POINT TO CALL
          RJ     CONV        CONVERT TO OCTAL 
          SA2    =O06221715550000000000 
          MX7    30 
          BX6    -X7*X6 
          BX6    X6+X2
          SA6    MSGXFR      STORE CALL MSG 
          SA1    LENGTH 
          RJ     CONV 
          LX6    18 
          SA6    MSGXLNO
          SA1    65B         GET CMM POINTER WORD 
          SX1    X1          CMM WORD 
          BX1    -X1
          SA1    X1          GET WORD WITH FIELD LENGTH 
          RJ     CONV 
          LX6    24 
          SA6    MSGXFL 
          SA3    =10H,   FL = 
          BX6    X3 
          SA6    MSGXNFL
          SA1    POINTER
          RJ     CONV 
          LX6    24 
          SA6    MSGXPTO
          SA1    GID
          ZR     X1,OPMSG1   JP IF NO GROUP ID GIVEN
          RJ     CONV 
          SA6    MSGXGIO
          SA2    =10H GRP ID =
          BX6    X2 
          SA6    MSGXGID
 OPMSG1   BSS    0
          SA1    NEWBLL 
          ZR     X1,OPMSG2
          RJ     CONV 
          SA6    MSGXNLO
          SA2    =10H NEW BL =
          BX6    X2 
          SA6    MSGXNLL
 OPMSG2   BSS    0
          SA1    VARFLG 
          ZR     X1,OPMSG3   JP IF NO VARIABLE BLOCK LOCN TO BE PRINTED 
          MX6    0
          SA6    A1 
          SA1    POINTER
          SA1    X1          GET ADDRESS OF BLOCK 
          RJ     CONV 
          SA6    MSGXNLO
          SA2    ADDMS
          BX6    X2 
          SA6    MSGXNLL
 OPMSG3   BSS    0
          WRITEH PRINTF,MSGX,MSGXEND-MSGX  WRITE TRACE LINE 
          SA1    LASTFL      LAST KNOWN FIELD LENGTH
          SA2    65B
          BX3    -X2
          SA2    X3          GIVES CURRENT FL 
          SX6    X2 
          SA6    A1          SAVE CURRENT 
          IX4    X6-X1       CURRENT-LAST ONE 
          ZR     X4,OPMSG4   JP IF FL NOT CHANGED 
          BX1    X6 
          RJ     CONV 
          SA3    =10H NEW FL =
          LX6    18 
          SA6    MSGX+1 
          BX7    X3 
          SA7    MSGX 
          WRITEH PRINTF,MSGX,2     INDICATE NEW FIELD LENGTH
 OPMSG4   BSS    0
          SA2    SPACES 
          BX6    X2 
          SB7    9
          SB7    MSGXEND-MSGX-1 
 OPMSGL   BSS    0           BLANK OUT MESSAGE AREA 
          SA6    MSGX+B7
          SB7    B7-B1
          PL     B7,OPMSGL
          MX6    0
          SA6    POINTER
          SA6    GID
          SA6    LENGTH 
          SA6    NEWBLL 
          SA1    SAVEX1      RESTORE X1 
          EQ     OPMSG
 MSGX     DATA   10H
 MSGXFR   DATA   10H
 MSGXLN   DATA   10H
 MSGXLNO  DATA   10H
 MSGXPT   DATA   10H
 MSGXPTO  DATA   10H
 MSGXNFL  DATA   10H
 MSGXFL   DATA   10H
 MSGXGID  DATA   10H
 MSGXGIO  DATA   10H
 MSGXNLL  DATA   10H
 MSGXNLO  DATA   10H
 MSGXEND  BSS    0
 BYMS     DATA   10H,  BY 
 POINTMS  DATA   10H POINTER =
 LENMS    DATA   10H, LENGTH =
 ADDMS    DATA   10H BLK ADD =
 NEWBLL   DATA   0
          EJECT 
          ENTRY  PRTCMM 
 PRTCMM   DATA   0           PRINT A CMM MAP
          SB1    1
          SA1    65B         GET ADDR OF DABA COMPLIMENTED
          BX1    -X1         COMP 
          SX6    X1 
          SB2    X1          SAVE FIRST POINTER 
          SA6    POINTER     SAVE POINTER TO HDRS 
          RJ     CONV        CONVERT IT 
          LX6    24 
          SA6    HDRLNDO
          SA1    104B        GET HHA
          RJ     CONV 
          LX6    24 
          SA6    HDRLNHO
          SA1    B2 
          SX6    X1-1        FL - 1 
          SA6    =SFLMIN1    SAVE FL -1 
          RJ     CONV 
          LX6    24 
          SA6    HDRLNFO
          SA1    20B         OVERLAY NAME 
          MX5    60-18
          SA2    SPACES 
          NZ     X1,PRT1     JP IF FIRST OVERLAY
          SA1    =10HCOB5010
 PRT1     BSS    0
          BX2    -X5*X2 
          BX1    X5*X1
          BX6    X1+X2
          SA6    HDRLNO 
          SB6    HDRLN
          SB7    HDRLNE-HDRLN 
          WRITEH PRINTF,B6,B7      WRITE HEADER LINE
          WRITEH PRINTF,HDRLN2,HDRLN2E-HDRLN2 
          WRITEH PRINTF,SPACES,B1  WRITE BLANK LINE 
          SA2    POINTER     GET SAVED HEADER POINTER 
          SB2    X2+B1       POINT TO FIRST CMM HEADER
 BLKLOOP  BSS    0           BLOCK PROCESS LOOP 
          ZR     B2,DONE     JP IF ALL DONE 
          SA1    B2          GET HEADER 
          SB4    X1          SAVE FORWARD POINTER 
          LX1    3
          MX5    60-3 
          BX2    -X5*X1      GET TYPE 
          SX3    X2-6 
          ZR     X3,FBHDR    JP IF FIXED BLOCK HEADER 
          SX3    X2-4 
          ZR     X3,VARRHDR  JP IF VARIABLE REGION HEADER 
          SX3    X2-7 
          ZR     X3,VARBHDR  JP IF VARIABLE BLOCK HEADER
          ZR     X2,FSPHDR   JP IF FREE SPACE HEADER
          JP *+400000B       ERROR - NOT KNOWN TYPE 
 FBHDR    BSS    0
          SB2    B4          FORWARD POINTER
          ZR     B2,DONE     DONE IF NO FWD POINTER - AT TRAILER
          LX1    15 
          BX6    -X5*X1      GET SIZE CODE
          SA6    SC 
          MX2    0
          NG     X1,FBHDR1   JP IF GID WORD THERE 
          SA1    A1+B1       GET GID INFO 
          LX1    60-36       GID
          SX6    X1 
          SA6    GID
 FBHDR1   BSS    0
          SX7    A1+B1       ADDRESS OF BLOCK 
          SA7    ADDR 
          SX4    B2 
          IX6    X4-X7
          SA6    LENGTH 
          SX1    0LFL 
          RJ     PRTDL       PRINT DETAIL LINE
          EQ     BLKLOOP
 VARRHDR  BSS    0           VAR REGION HDR 
          LX1    21 
          SB2    X1          POINT TO FIRST VARIABLE BLOCK
          SB3    B4          POINT TO NEXT REGION HEADER
          ZR     B2,ENVARR   JP IF NO BLOCKS IN VAR REGION
          EQ     BLKLOOP
 VARBHDR  BSS    0           VARIABLE BLK HEADER
          SB2    B4          NEXT POINTER 
          LX1    21 
          SX6    X1          LENGTH 
          SA6    LENGTH 
          SA1    A1+B1
          SX7    X1          AUX1 - POINTER WORD
          SA7    AUX1 
          AX1    18 
          SX6    X1 
          SA6    AUX2 
          AX1    18+18
          MX5    60-3 
          BX7    -X5*X1      SIZE CODE
          SA7    SC 
          AX1    3
          BX6    -X5*X1      TYPE CODE - 1
          SX6    X6+B1       TYPE CODE
          SA6    TC 
          SA1    A1+B1       GID WORD 
          AX1    18+18
          SX7    X1 
          SA7    GID
          SX6    A1+2        ADDR OF BLOCK
          SA6    ADDR 
          SX1    0LVA 
          SX6    B3 
          SA6    =SSAVEB3     SAVE B3 
          RJ     PRTDL       PRINT DETAIL LINE
          SA1    SAVEB3 
          SB3    X1          RESTORE;B3 
          NZ     B2,BLKLOOP  JP IF MORE BLOCKS
 ENVARR   BSS    0
          SB2    B3          POINT TO NEXT REGION HEADER
          EQ     BLKLOOP
 FSPHDR   BSS    0           FREE SPACE HEADER
          SX6    A1+B1
          SA6    ADDR 
          SB2    B4          NEW POINTER
          SX5    B2 
          IX7    X5-X6
          SA7    LENGTH 
          SX1    2LFS 
          RJ     PRTDL
          EQ     BLKLOOP
 DONE     BSS    0           DONE 
          WRITEH PRINTF,TRLLN,2    WRITE TRAILER LINE 
          WRITEH PRINTF,SPACES,B1  WRITE BLANK LINE 
          MX6    0
          SA6    POINTER
          SA6    GID
          SA6    LENGTH      CLEAR
          EQ     PRTCMM      EXIT 
          SPACE  5
 CONV     DATA   0           CONVERT TO DISPLAY OCTAL (NBR IN X1 0-17)
          SX1    X1 
          LX1    60-15
          SB7    5
          SA2    =10H00000    0 
          BX6    X2 
          MX2    60-3 
 CONVLP   BSS    0
          BX7    -X2*X1 
          IX6    X7+X6
          ZR     B7,CONV     JP IF NOT DONE 
          LX6    6
          LX1    3
          SB7    B7-B1
          EQ     CONVLP 
          SPACE  5
 PRTDL    DATA   0           PRINT DETAIL LINE
          SX6    B2 
          SA6    POINTER     SAVE HDR POINTER 
          SA2    SPACES 
          SB5    X1          SAVE BLOCK TYPE
          SB7    DETLNL-1 
          BX6    X2 
 PRTDBL   BSS    0           BLANK OUT LINE 
          SA6    DETLN+B7 
          SB7    B7-B1
          PL     B7,PRTDBL
          SA1    ADDR 
          RJ     CONV 
          LX6    18 
          SA6    DETLN
          SA1    LENGTH 
          RJ     CONV 
          LX6    24 
          SX7    B5 
          MX5    12 
          LX5    18 
          BX6    -X5*X6 
          BX6    X7+X6       PUT IN TYPE OF BLOCK 
          SA6    DETLN+1
          SB6    2LFS 
          EQ     B6,B5,PRTDLX      JP IF FREE SPACE THING 
          SA1    SC 
          RJ     CONV 
          LX6    60-12
          BX5    X6 
          SA1    GID
          RJ     CONV 
          LX6    6
          MX4    12 
          BX5    X4*X5       SC 
          BX6    -X4*X6 
          BX6    X5+X6
          SA6    DETLN+2     SC AND GID 
          SB6    2LVB 
          EQ     B6,B5,PRTDLX 
          SA1    AUX1 
          RJ     CONV 
          LX6    18 
          SA6    DETLN+3
          SA1    AUX2 
          RJ     CONV 
          LX6    24 
          BX5    X6 
          SA1    TC 
          RJ     CONV 
          MX7    60-6 
          BX5    X7*X5
          BX6    -X7*X6 
          BX6    X5+X6
          SA6    DETLN+4
 PRTDLX   BSS    0
          SB6    DETLN
          SB7    DETLNL 
          WRITEH PRINTF,B6,B7      WRITE THE LINE 
          SA2    POINTER
          SB2    X2          RESTORE HEADER POINTER 
          EQ     PRTDL
 TCMALL   ENDIF 
          SPACE  5
          ENTRY  CLOSTF 
          ENTRY  OVFLO
 OVFLO    DATA   0           OVERFLOW HAPPENED
          IFNE   TRACECM,1,1
          EQ     OVFLO       DO NOTHING IF TRACE NOT ON 
 OVFIF1   IFEQ   TRACECM,1
          SA1    LENGTH 
          SA2    POINTER
          BX6    X1 
          SA6    SVLEN       SAVE FIELDS
          BX7    X2 
          SA7    SVPTR
          SA1    ADDR 
          SA2    GID
          BX6    X1 
          SA6    SVADDR 
          BX7    X2 
          SA7    SVGID
          WRITEH PRINTF,OVFM,OVFME-OVFM   WRITE OVF MESSAGE 
          RJ     PRTCMM      PRINT A MAP
          EQ     OVFLO
 OVFM     DATA   20H0*** OVERFLOW *** 
 OVFME    BSS    0
 OVFIF1   ENDIF 
 CLOSTF   DATA   0                 CLOSE TRACE FILE 
          IFNE   TRACECM,1,1
          EQ     CLOSTF      NO ACTION IF NO TRACE
 TCMFIN   IFEQ   TRACECM,1
          WRITEH PRINTF,ENDMS,ENDMSE-ENDMS   WRITE FINAL TERMINATION MSG
          WRITER PRINTF,0,RCL      FLUSH OUT BUFFER 
          CLOSE  PRINTF,NR,RCL
          EQ     CLOSTF 
 ENDMS    DATA   30H0****** END OF CMM TRACE *****
 ENDMSE   BSS    0
          SPACE  5
 PRINTF   BSS    0
 CMMTRAC  FILEC  BUFF,129 
 BUFF     BSS    129
 DETLNL   EQU    5
 DETLN    BSS    DETLNL 
 HDRLN    DATA   10H0**** MAP 
          DATA   10H  DABA =
 HDRLNDO  DATA   10H
          DATA   10H    HHA = 
 HDRLNHO  DATA   10H
          DATA   10H     FL = 
 HDRLNFO  DATA   10H
          DATA   10HOVERLAY = 
 HDRLNO   DATA   10H
 HDRLNE   BSS    0
 HDRLN2   DATA   50H ADDRESS  LENGTH TY SC    GID POINTER     AUX2  TC
 HDRLN2E  BSS    0
 SPACES   DATA   10H
 TRLLN    DATA   20H0**** END OF MAP
 ADDR     BSS    1
 LENGTH   BSS    1
 SC       BSS    1
 GID      BSS    1
 AUX1     BSS    1
 AUX2     BSS    1
 TC       BSS    1
 VARFLG   DATA   0
 LASTFL   DATA   0
 SVPTR    DATA   0
 SVADDR   DATA   0
 SVGID    DATA   0
 SVLEN    DATA   0
 TCMFIN   ENDIF 
          END 
