*COMDECK COMCMCS
 MCS      CTEXT  MCS - MERGE CODED STRINGS. 
 MCS      SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMCMCS
 MCS      SPACE  4
***       MCS - MERGE CODED STRINGS.
* 
*         D.C. DILLON   75/07/01
*         D.C. DILLON   77/02/22
 MCS      SPACE  4
**        MCS - MERGE CODED STRINGS.
* 
*                CONCATENATES NEW CHARACTER STRING IN (X1) WITH OLD 
*         STRING AT (B7).  STORES RESULT AT (B7) AND, IF NEW STRING 
*         LENGTH REQUIRES, AT (B7)+1.  BOTH OLD AND NEW STRINGS ARE 
*         ASSUMED TO BE LEFT JUSTIFIED WITH ZERO FILL.  EITHER MAY BE 
*         NULL OR FULL. 
* 
*                ***  LIMITATION -- TRAILING COLONS ARE IDENTICAL TO
*         ZERO FILL, AND WILL BE LOST.
* 
* 
*         ENTRY  (X1) = *NEW* STRING. 
*                (B1) = 1 IF SYMBOL B1=1 IS DEFINED.
*                (B7) = ADDRESS OF *OLD* STRING.
* 
*         EXIT   MERGED STRING STORED AT (B7) AND, POSSIBLY, AT (B7)+1. 
*                (X1) = UNCHANGED.
*                (X2) = ORIGINAL *OLD* STRING.
*                (X6) = *OLD* .AND. UPPER *NEW*.
*                (X7) = LOWER *NEW*, IF ANY, ELSE = 0.
*                (B1) = 1 IF SYMBOL B1=1 IS NOT DEFINED.
*                (B7) = ADDRESS OF *OLD*, UPDATED IF LOWER *NEW* .NZ. 
* 
*         USES   X - 2, 3, 6, 7 
*                A - 2, 3, 6, 7 
*                B - 1, 2, 7
* 
*         CALLS  NONE 
  
  
 MCS      SUBR               ** ENTRY/EXIT ** 
  
          IF     -DEF,B1=1,1
          SB1    1
  
          SA2    B7          (X2) = *OLD* STRING
          MX7    -1 
          SA3    MCSA 
          IX6    X2+X7       BORROW RIPPLES LEFT TO 1ST NON-ZERO CHAR 
          BX7    -X2*X6      EXTRACT BORROWS
          SB2    55D
          BX7    X3*X7       EXTRACT NULL BYTES = 40
          LX3    X7,B2       EACH NULL BYTE     = 01
          IX6    X7-X3                          = 37
          BX7    X6+X7       EACH NULL BYTE     = 77 ... EXTRACTION MASK
          CX6    X7 
          SB2    X6 
          LX3    X1,B2       ALIGN *NEW* WITH NULL PART OF *OLD*
          BX6    X7*X3
          BX7    -X7*X3      (X7) = LOWER *NEW* 
          BX6    X2+X6       (X6) = *OLD* .OR. UPPER *NEW*
          SA6    B7+0 
          NZ     X7,MCS2     IF LOWER *NEW* NOT EMPTY 
          PL     X7,EXIT. 
 MCS2     SA7    B7+B1
          SB7    B7+B1       (B7) = UPDATED STRING ADDRESS
          EQ     EXIT.
  
  
 MCSA     DATA   40404040404040404040B   NULL CHARACTER BYTE MASK 
 MCS      SPACE  4
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 MCS      =      /COMCMCS/MCS 
 QUAL$    ENDIF 
          ENDX
