*COMDECK  COMCUCS            UNPACK CONTROL STATEMENT.
 UCS      CTEXT  COMCUCS - UNPACK CONTROL STATEMENT.
 UCS      SPACE  4,10 
          IF     -DEF,QUAL$,1 
          QUAL   COMCUCS
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC. 1994.
 UCS      SPACE  4,10 
***       UCS - UNPACK CONTROL STATEMENT. 
* 
*         J. SEUFERT         22JUN82
* 
*         UCS UNPACKS A CONTROL CARD TO INDIVIDUAL PARAMETERS.
*         UCS IS A REVISED VERSION OF THE UPC ROUTINE IN COMDECK
*         COMCUPC ON PL2. CODE HAS BEEN ADDED TO THE UCS ROUTINE
*         TO PROCESS THE PREFIX CHARACTER PARAMETER, PC=N 
*         WHERE N = ANY DISPLAY CODE CHARACTER EXCEPT )$. AND 00. 
* 
*         THE FOLLOWING CONDITIONS ARE NOTED. 
*         (1.)  IF (B7) IS NEGATIVE ON ENTRY, A BLANK AFTER THE KEYWORD 
*                IS A SEPARATOR, OTHERWISE BLANKS ARE IGNORED.
*         (2.)  THE CHARACTERS +-/=,($ ARE CONSIDERED AS PARAMETER
*                SEPARATORS.
*         (3.)  THE CHARACTERS ). ARE CONSIDERED AS THE TERMINATION OF
*                THE CONTROL CARD.
*         (4.)  CHARACTERS WITH DISPLAY CODE VALUES 0, OR 60B - 77B 
*                ARE ILLEGAL BEFORE THE TERMINATOR. 
*                PREFIX CHARACTER IS AN EXCEPTION.
*         (5.)  THE PARAMETER MUST CONTAIN 7 OR LESS CHARACTERS.
*         (6.)  THE PARAMETERS ARE STORED LEFT JUSTIFIED WITH ZERO
*                FILL.
*         (7.)  THE SEPARATOR CHARACTER WILL BE PLACED IN THE 
*                LOWER 18 BITS OF THE PARAMETER UNLESS IT IS A *,*
*                IN WHICH CASE THE LOWER 18 BITS WILL BE ZERO 
*         (8.)  TWO SUCCESSIVE SEPARATORS OR A SEPARATOR FOLLOWED BY
*                A TERMINATOR RESULTS IN A PARAMETER OF ALL ZERO. 
*         (9.)  THE PARAMETER FOLLOWING PC= MAY BE ANY DISPLAY CODE 
*                CHARACTER EXCEPT ) $ . AND DISPLAY CODE 00.
* 
*         ENTRY  (X5) = FIRST WORD OF CONTROL CARD. 
*                (A5) = ADDRESS OF FIRST WORD.
*                (B7) = POSITIVE -- ADDRESS FOR STORING FIRST PARAMETER,
*                                   BLANK SEPARATOR IGNORED.
*                       NEGATIVE -- COMPLEMENT OF ADDRESS FOR STORING 
*                                   FIRST PARAMETER, ALLOW INITIAL
*                                   BLANK SEPARATOR.
*                (B1) = 1.
* 
*         EXIT   (X6) = 0 IF NO ERROR DURING UNPACK.
*                (B6) = PARAMETER COUNT.
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6, 7.
*                B - 2, 3, 4, 5, 6. 
*                A - 1, 2, 5, 6, 7. 
* 
*         CALLS  NONE.
  
  
 UCS      SUBR               ENTRY/EXIT 
          SB2    B7 
          PL     B2,UCS1     IF (B7) IS NEGATIVE ON ENTRY 
          SB2    -B7         IF NEGATIVE, RESET 
 UCS1     SA6    B2          PRESET A6 FOR WRITE
          SX3    4100B       (X3) = MASK FOR TERMINATORS
          SB5    60          (B5) = CONSTANT 60 
          MX0    -6          (X0) = CHARACTER MASK
          BX6    X6-X6       CLEAR ASSEMBLY 
          SB2    B5          INITIALIZE REMAINING BIT COUNT 
          MX2    18          (X2) = EXCESS CHARACTER MASK 
          MX4    1           (X4) = DISASSEMBLY CHARACTER COUNTER 
          SB6    B0          (B6) = ASSEMBLED PARAMETER COUNT 
          LX5    6           CHECK FIRST CHARACTER
          BX7    -X0*X5 
          SB3    X7-1R$ 
          ZR     B3,UCS1.1   IF *$* 
          SB3    X7-1R/ 
          ZR     B3,UCS1.1   IF */* 
          LX5    -6          REPOSITION 
          EQ     UCS3        ENTER LOOP 
  
 UCS1.1   LX4    6           IGNORE FIRST CHARACTER 
          SB2    B2-6 
          EQ     UCS3        ENTER LOOP 
  
 UCS2     LX6    6           ADVANCE ASSEMBLY 
          SB2    B2-6        DECREMENT REMAINING BIT COUNT
          BX6    X6+X7
 UCS3     LX5    6           NEXT CHARACTER 
          BX7    -X0*X5 
          SB3    X7-1R9      SETUP FOR ALPHANUMERIC/TERMINATOR CHECK
          LX4    6           ADVANCE DISASSEMBLY
          PL     X4,UCS4     IF DISASSEMBLY OF THIS WORD NOT COMPLETE 
  
*         00 CHARACTER IS ILLEGAL AND * IS ALPHANUMERIC.
  
          SA5    A5+B1
 UCS4     ZR     X7,UCS7     IF CHARACTER = 00
          LT     B3,B1,UCS2  IF CHARACTER = ALPHA/NUMERIC 
          SB4    X7-60B      CHARS. 60-77B ARE ILLEGAL
          GE     B4,UCS7
          SB4    X7-1R* 
          ZR     B4,UCS2     IF CHARACTER = ASTERISK
  
*         CHECK FOR BLANK AS SEPARATOR. 
  
          SB4    X7-1R       CHECK CHARACTER
          NZ     B4,UCS5     IF NOT BLANK, MUST BE SEPARATOR
          PL     B7,UCS3     IF (B7) POSITIVE, BLANK IGNORED
          NZ     B6,UCS3     IF NOT JUST AFTER KEYWORD, BLANK IGNORED 
          ZR     X6,UCS3     IF LEADING BLANK, IGNORE 
  
*         CHECK FOR PARAMETER .GT. 7 CHARACTERS.
  
 UCS5     BX1    X2*X6       CHECK ASSEMBLY LENGTH
          LX6    X6,B2       LEFT JUSTIFY ASSEMBLY
          NZ     X1,UCS7     IF .GT. 7 CHARACTERS ASSEMBLED 
          EQ     B4,B1,UCS6  IF SEPARATOR = COMMA 
          BX6    X6+X7       INSERT SEPARATOR 
 UCS6     SA1    UCSPC= 
          SA6    A6 
          BX1    X6-X1
          SB2    B5          REINITIALIZE REMAINING BIT COUNT 
          BX6    X6-X6
          SB6    B6+B1       INCREMENT PARAMETER COUNT
          SA6    A6+B1       CLEAR LAST + 1 
          ZR     X1,UCS10    IF PC= CHARACTER STRING
          AX1    X3,B3       CHECK FOR TERMINATOR 
          LX1    59 
          PL     X1,UCS3     LOOP IF NOT TERMINATOR 
          SA2    A6-B1       CLEAR TERMINATOR 
          MX3    42 
          BX7    X3*X2
          SA7    A2 
          EQ     UCSX        RETURN 
  
 UCS7     SX6    B1          RETURN ERROR 
          SB6    B0 
          EQ     UCSX        RETURN 
  
* 
*         EXTRACT N VALUE FOR PC=N WHERE N = ANY DISPLAY CODE 
*         CHARACTER EXCEPT ) $ . AND DISPLAY CODE 00. 
* 
 UCS10    LX5    6           NEXT CHARACTER 
          BX7    -X0*X5 
          SB3    X7-1R9      SETUP FOR TERMINATOR CHECK 
          LX4    6           ADVANCE DISASSEMBLY
          PL     X4,UCS11    IF DISASSEMBLY OF THIS WORD NOT COMPLETE 
          SA5    A5+B1
 UCS11    ZR     X7,UCS7     IF CHARACTER = 00
          AX1    X3,B3       CHECK FOR TERMINATOR 
          LX1    59 
          PL     X1,UCS12    IF NOT TERMINATOR
* 
*         TERMINATOR FOUND, PC=. OR PC=)
* 
          EQ     UCSX        RETURN 
  
 UCS12    LX6    6           ADVANCE ASSEMBLY 
          SB2    B2-6        DECREMENT REMAINING BIT COUNT
          BX6    X6+X7
 UCS13    LX5    6
          BX7    -X0*X5      EXTRACT NEXT CHARACTER 
          SB3    X7-1R9      SETUP FOR ALPHANUMERIC/TERMINATOR CHECK
          LX4    6           ADVANCE DISASSEMBLY
          PL     X4,UCS14    IF DISASSEMBLY OF THIS WORD NOT COMPLETE 
          SA5    A5+B1
 UCS14    ZR     X7,UCS7     IF CHARACTER = 00
          LT     B3,B1,UCS12 IF CHARACTER = ALPHA/NUMERIC 
          SB4    X7-60B 
          GE     B4,UCS12    IF CHARACTER = 60-77B
          SB4    X7-1R* 
          ZR     B4,UCS12    IF CHARACTER = ASTERISK
          SB4    X7-1R
          NZ     B4,UCS15    IF CHARACTER NOT BLANK 
          EQ     UCS13       BLANK IGNORED
  
 UCS15    BSS    0
          LX6    X6,B2       LEFT JUSTIFY ASSEMBLY
          EQ     B4,B1,UCS6  IF SEPARATOR = COMMA, RETURN TO MAIN LOOP
          BX6    X6+X7       COMBINE PREFIX CHARACTER AND SEPARATOR 
          EQ     UCS6        RETURN TO MAIN LOOP
  
  
 UCSPC=   VFD    12/0LPC,42/0,6/0L=      UNPACKED PC= KEYWORD 
 UCS      SPACE  4,10 
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 UCS      EQU    /COMCUCS/UCS 
 QUAL$    ENDIF 
 UCS      ENDX
