COMPACS 
COMMON
          CTEXT  COMPACS - ASSEMBLE CHARACTER STRING. 
 ACS      SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMPACS
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 ACS      SPACE  4
***       ACS - ASSEMBLE CHARACTER STRING.
*         P. D. HAAS         75/08/07.
 ACS      SPACE  4
***              ACS GENERATES A CHARACTER STRING FROM A PARAMETER
*         BLOCK, SUITABLE FOR USE IN DAYFILE MESSAGES.
*         ITS PURPOSE IS TO ASSEMBLE A MESSAGE CONTAINING 
*         SEVERAL VARIABLE LENGTH PARAMETERS. 
* 
*         ENTRY  (A) = ADDRESS OF PARAMETER BLOCK.
*                (T1) = ADDRESS FOR ASSEMBLY. 
*                ((T1)) = END OF STRING IN *C* FORMAT.
* 
*         EXIT   (A) = 0. 
*                (T1) ADVANCED. 
*                ((T1)) = END OF STRING IN *C* FORMAT.
*                ((T2)) = END OF PARAMETER BLOCK IN *Z* FORMAT. 
*                ASSEMBLY TERMINATES ON 6 BITS OF ZERO. 
* 
*         USES   T2.
  
  
 ACS2     RAI    T1          ADD LOWER CHARACTER
          AOD    T2          ADVANCE PARAMETER ADDRESS
          AOD    T1 
 ACS3     LDI    T2          SET UPPER CHARACTER
          SCN    77 
          STI    T1 
          ZJN    ACSX        IF END OF ASSEMBLY 
          LMI    T2 
          NJN    ACS2        IF LOWER CHARACTER PRESENT 
 ACS4     STM    1,T1 
  
 ACS      SUBR               ENTRY/EXIT 
          STD    T2          SET PARAMETER ADDRESS
          LDI    T1 
          ZJN    ACS3        IF ASSEMBLY ON BYTE BOUNDARY 
          SOD    T2 
 ACS1     AOD    T2          ADVANCE PARAMETER ADDRESS
          LDI    T2          UNPACK PARAMETER BLOCK 
          SHN    14 
          RAI    T1          SET LOWER CHARACTER
          LPN    77 
          ZJN    ACS4        IF END OF ASSEMBLY 
          AOD    T1          ADVANCE ASSEMBLY ADDRESS 
          LDI    T2 
          LPN    77 
          SHN    6           SET UPPER CHARACTER
          STI    T1 
          NJN    ACS1        IF NOT END OF PARAMETER BLOCK
          UJN    ACSX        RETURN 
 ACS      SPACE  4
          IF     -DEF,QUAL$ 
          QUAL   *
 ACS      EQU    /COMPACS/ACS 
          ENDIF 
          ENDX
