*COMDECK  COMCUPC 
          CTEXT  COMCUPC - UNPACK CONTROL CARD. 
 UPC      SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMCUPC
          BASE   D
*         COMMENT COPYRIGHT CONTROL DATA CORP. 1970.
 UPC      SPACE  4
***       UPC - UNPACK CONTROL CARD.
*         G. R. MANSFIELD.  70/12/12. 
 UPC      SPACE  4
***              UPC UNPACKS A CONTROL CARD TO INDIVIDUAL PARAMETERS. 
*         THE FOLLOWING CONDITIONS ARE NOTED. 
*         (1.)  IMBEDDED SPACES 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. 
*         (5.)  THE PARAMETER MUST CONTAIN 7 OR LESS CHARACTERS.
*         (6.)  THE PARAMETERS ARE STORED LEFT JUSTIFIED WITH ZERO
*                FILL.
*         (7.)  THE CHARACTER = WILL BE PLACED IN THE LOWER 18 BITS 
*                OF THE PRECEDING PARAMETER.
*         (8.)  TWO SUCCESSIVE SEPARATORS OR A SEPARATOR FOLLOWED BY
*                A TERMINATOR RESULTS IN A PARAMETER OF ALL ZERO. 
* 
*         ENTRY  (X5) = FIRST WORD OF CONTROL CARD. 
*                (A5) = ADDRESS OF FIRST WORD.
*                (B7) = ADDRESS FOR FIRST PARAMETER.
*                (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 - 5, 6.
* 
*         CALLS  NONE.
  
  
 UPC      PS                 ENTRY/EXIT 
          SX3    4100B       (X3) = MASK FOR TERMINATORS
          SB5    60          (B5) = CONSTANT 60 
          MX0    -6          (X0) = CHARACTER MASK
          BX6    X6-X6       CLEAR ASSEMBLY 
          SB2    B5          CLEAR CHARACTER COUNT
          MX2    18          (X2) = EXCESS CHARACTER MASK 
          MX4    1           (X4) = CHARACTER COUNTER 
          SB6    B0          (B6) = ASSEMBLY INDEX
*                                                                        SC46097
*         IGNORE LEADING BLANKS.                                         SC46097
*                                                                        SC46097
UPC0      LX5    6                 SHIFT CHARACTER LOW                   SC46097
          BX7    -X0*X5            MASK OUT CHARACTER                    SC46097
          SB4    X7-1R             CHECK FOR BLANK                       SC46097
          LX4    6                 ADVANCE DISASSEMBLY                   SC46097
          PL     X4,UPC0.A                                               SC46097
          SA5    A5+B1                                                   SC46097
UPC0.A    ZR     B4,UPC0            CHECK NEXT CHARACTER                 SC46097
  
 UPC1     LX6    6           ADVANCE ASSEMBLY 
          SB2    B2-6 
          BX6    X6+X7
 UPC2     LX5    6           NEXT CHARACTER 
          BX7    -X0*X5 
          SB3    X7-1R9      CHECK CHARACTER
          LX4    6           ADVANCE DISASSEMBLY
          PL     X4,UPC3
          SA5    A5+B1
 UPC3     ZR     X7,UPC5     IF CHARACTER = 00
          LT     B3,B1,UPC1  IF ALPHA/NUMERIC 
  
          ZR     B6,UPC33    BLANK OK FOR FIRST SEPARATOR ONLY
          SB4    X7-1R       CHECK CHARACTER
          ZR     B4,UPC2     IF CHARACTER = * * 
 UPC33    SB4    X7-1R* 
          ZR     B4,UPC1       * IS NOT A SEPARATOR 
          BX1    X2*X6       CHECK ASSEMBLY 
          LX6    X6,B2       LEFT JUSTIFY ASSEMBLY
          NZ     X1,UPC5     IF > 7 CHARACTERS ASSEMBLED
          AX1    X3,B3       CHECK FOR TERMINATOR 
          EQ     B4,B1,UPC4  IF SEPARATOR = *,* 
          BX6    X6+X7       INSERT SEPARATOR 
 UPC4     SA6    B7+B6       STORE ASSEMBLY 
          SB2    B5          RESET ASSEMBLY 
          BX6    X6-X6
          LX1    59 
          SB6    B6+B1
          SA6    A6+B1       CLEAR LAST + 1 
          PL     X1,UPC2     LOOP IF NOT TERMINATRO 
          SA1    B7          CLEAR FIRST SEPARATOR
          SA2    A6-1        CLEAR TERMINATOR 
          MX3    42 
          BX7    X3*X1
          SA7    A1 
          BX7    X3*X2
          SA7    A2 
          EQ     UPC         RETURN 
  
 UPC5     SX6    B1          RETURN ERROR 
          SB6    B0 
          EQ     UPC
          SPACE  4
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 UPC      EQU    /COMCUPC/UPC 
 QUAL$    ENDIF 
          ENDX
