COMCPOP 
COMMON
          CTEXT  COMCPOP - PICK OUT PARAMETER.
          SPACE  4
 QUAL$    IF     -DEF,QUAL$,1 
          QUAL   COMCPOP
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 POP      SPACE  4
***       COMCPOP - PICK OUT PARAMETER. 
*         K. E. ZINNEL.      71/12/01.
*         D. A. HIVELEY.     72/06/01.
*         M. E. MADDEN.      73/04/10.
*         S. R. MCPHERSON.   74/09/30.
*         A. D. FORET        74/12/04. RESEQUENCE.
 POP      SPACE  4
***       POP - PICK OUT PARAMETER FROM STRING BUFFER.
* 
*                A LITERAL PARAMETER IS DELIMITED BY *$*.  IF THE 
*         LITERAL IS TO CONTAIN A *$*, *$$* MUST BE USED. 
*         EG. - $A B/C$$E$  YIELDS  A B/C$E 
* 
*         IF *RCC* IS DEFINED IN THE USERS PROGRAM, WHEN THE
*         STRING BUFFER IS EXHAUSTED, THE NEXT CONTROL CARD IS
*         READ FROM THE CONTROL CARD BUFFER.  HOWEVER, LITERALS 
*         MAY NOT BE CONTINUED ON THE NEXT CONTROL CARD.
* 
*         LITERALS WILL BE PROCESSED IF *LIT* IS DEFINED AND
*         (LIT) .NE. 0.  OTHERWISE, A *$* WILL BE TREATED AS A BLANK. 
* 
*         AN ASTERISK (*) IS CONSIDERED A VALID 
*         PARAMETER CHARACTER, NOT A SEPARATOR. 
* 
*         *POPL* DEFINES THE MAXIMUM PARAMETER LENGTH IN WORDS. 
* 
*         ENTRY  (B6) = ADDRESS TO BEGIN ASSEMBLY.
*                (USBC) = ADDRESS OF LAST CHARACTER IN STRING BUFFER. 
*                            IF NOT DEFINED IN THE USER PROGRAM 
*                            THIS SYMBOL IS DEFINED IN *COMCUSB*. 
* 
*         EXIT   (X6) = LAST PART OF ASSEMBLED PARAMETER OR PARAMETER 
*                            IF .LT. 10 CHARACTERS. 
*                (B5) = PARAMETER LENGTH (IN WORDS) - 1.
*                     = NEGATIVE IF BUFFER EXHAUSTED OR ERROR.
*                (B6) = 0 IF *.* OR *)* ENCOUNTERED.
*                     = POSITIVE, NEXT STRING BUFFER ADDRESS. 
*                (A1) = ADDRESS OF SEPARATOR. 
*                (X1) = SEPARATOR.
*                (X2) = NEGATIVE IF *.* OR *)* ENCOUNTERED
*                     AND NO ERRORS.
*                     = 0 IF CHARACTER ENCOUNTERED WITH 
*                     DISPLAY CODE GREATER THAN 57B (.).
* 
* 
*         USES   A - 1, 6, 7. 
*                X - 1, 2, 3, 6, 7. 
*                B - 1, 2, 3, 4, 5, 6, 7. 
* 
*         CALLS  AVC. 
  
  
 POP13    SB5    -B1         SET ERROR FLAG 
          EQ     POP         RETURN 
  
 POP14    SX3    4100B       CHECK FOR VALID TERMINATOR 
          BX7    X7-X7
          AX2    X3,B2
          SA6    POPA+B5     STORE PARAMETER WORD 
          SB2    B4-60       CHECK FOR EMPTY ASSEMBLE REGISTER
          EQ     B2,B0,POP15 IF EMPTY ASSEMBLY REGISTER 
          SB2    B5-POPL     CHECK PARAMETER SIZE 
          PL     B2,POP13    IF PARAMETER TOO LONG
          SA7    A6+1 
 POP15    LX2    59          CHECK TERMINATOR 
          PL     X2,POP16    IF NOT *.* OR *)*
          SB6    B0          SET TERMINATOR ENCOUNTERED 
 POP16    SB4    B4-60
          NE     B4,B0,POP   IF NOT EMPTY ASSEMBLY REGISTER 
          EQ     B5,B0,POP   IF .LT. 11D CHARACTERS 
          SB5    B5-1 
  
 POP      PS                 ENTRY/EXIT 
          SB5    -1          SET PARAMETER LENGTH INDEX 
          LE     B6,POP      IF NO ASSEMBLY POINTER 
          SA1    USBC        GET LAST CHARACTER LOCATION
          SB7    X1+1 
 POP1     SB4    60          POSITION INDEX 
          BX6    X6-X6       CLEAR ASSEMBLY REGISTER
          SB5    B5+B1
 POP2     SA1    B6 
          LT     B6,B7,POP3  IF MORE CHARACTERS IN STRING BUFFER
 RC1      IF     DEF,RCC
          RJ     AVC         ADVANCE CONTROL CARD 
          ZR     X2,POP13    IF NO CONTINUATION CARD
          EQ     POP2        CONTINUE PROCESSING PARAMETER
  
 RC1      ELSE
          SB3    POPL 
          GT     B5,B3,POP13 IF BUFFER FULL 
          SA6    POPA+B5
          EQ     POP13       SET ERROR FLAG - NO TERMINATOR 
  
 RC1      ENDIF 
 POP3     SX2    X1-1R
          NZ     B4,POP4     IF ASSEMBLY REGISTER NOT FULL
          SA6    POPA+B5     STORE FULL WORD
          SB2    B5-POPL
          NG     B2,POP1     IF PARAMETER NOT TOO LONG
          EQ     POP13       SET ERROR FLAG - PARAMETER TOO LONG
  
 POP4     SX3    X1-1R$ 
          SB6    B6+1 
          SB2    X1-1R9 
 LT1      IF     DEF,LIT
          ZR     X3,POP6     IF LITERAL PARAMETER 
 LT1      ELSE
          ZR     X3,POP2     IF CHARACTER = $ 
 LT1      ENDIF 
          SX3    X1-1R* 
          ZR     X3,POP5     IF CHARACTER = * 
          ZR     X2,POP2     IF CHARACTER = * * 
          GT     B2,POP14    IF NOT ALPHANUMERIC
          ZR     X1,POP14    IF CHARACTER 00
 POP5     SB4    B4-6 
          LX7    X1,B4
          BX6    X7+X6
          EQ     POP2        CHECK NEXT CHARACTER 
  
 LT2      IF     DEF,LIT
 POP6     SA1    LIT
          ZR     X1,POP2     IF LITERALS NOT PERMITTED
          SX7    B4-60       CHECK FOR DELIMITER AS FIRST CHARACTER 
          SX3    X7+B5
          NZ     X3,POP13    IF DELIMITER NOT FIRST CHARACTER 
 POP7     SA1    B6 
          SX3    X1-1R$ 
          SB6    B6+B1
          GT     B6,B7,POP13 IF NO MORE CHARACTERS IN STRING BUFFER 
          NZ     X3,POP11    IF NO DELIMITER
          SA1    B6 
          SX3    X1-1R$ 
          SB6    B6+B1
          GT     B6,B7,POP10 IF NO MORE CHARACTERS IN STRING BUFFER 
          ZR     X3,POP11    IF DOUBLE DELIMITER
 POP8     SX3    X1-1R* 
          SB2    X1-1R$ 
          ZR     X3,POP13    IF ILLEGAL SEPARATOR 
          ZR     B2,POP13    IF ILLEGAL SEPARATOR 
          ZR     X1,POP14    IF 00 CHARACTER
          SB2    X1-1R9 
          SX3    X1-1R
          LE     B2,POP13    IF ALPHANUMERIC CHARACTER
          NZ     X3,POP14    IF NOT BLANK 
 POP9     SA1    B6 
          SB6    B6+B1
          LE     B6,B7,POP8  IF MORE CHARACTERS IN STRING BUFFER
 POP10    BSS    0
 RC2      IF     -DEF,RCC 
          EQ     POP13       SET ERROR FLAG - NO TERMINATOR 
  
 RC2      ELSE
          RJ     AVC         ADVANCE CONTROL CARD 
          ZR     X2,POP13    IF NO CONTINUATION CARD
          EQ     POP9        CHECK FOR SEPARATOR
  
 RC2      ENDIF 
  
 POP11    NZ     B4,POP12    IF ASSEMBLY WORD NOT FULL
          SA6    POPA+B5     STORE ASSEMBLY WORD
          SB2    B5-POPL
          PL     B2,POP13    IF PARAMETER TOO LONG
          SB4    60 
          BX6    X6-X6
          SB5    B5+B1
 POP12    SB4    B4-6 
          LX7    X1,B4
          BX6    X6+X7
          EQ     POP7        CHECK NEXT CHARACTER 
 LT2      ENDIF 
  
          IF     -DEF,POPL,1
 POPL     EQU    3           MAXIMUM PARAMETER LENGTH IN WORDS
 POPA     BSS    POPL+1      ASSEMBLY BUFFER
 RC3      IF     DEF,RCC
 AVC      SPACE  4,20 
**        AVC - ADVANCE CONTROL CARD. 
* 
*         ENTRY  (X6) = PARAMETER ASSEMBLY. 
* 
*         EXIT   (X2) = 0, IF NO CONTINUATION CARD WAS FOUND. 
*                IF A CONTINUATION CARD WAS FOUND ((X2) .NE. 0),
*                THE FOLLOWING EXIT CONDITIONS ARE RETURNED - 
*                (X6) = PARAMETER ASSEMBLY. 
*                (B6) = FWA STRING BUFFER.
*                (B7) = LWA+1 DATA IN STRING BUFFER.
* 
*         USES   A - 2, 6.
*                B - 2, 7.
*                X - 2, 6.
* 
*         CALLS  SYS=, USB. 
  
  
 AVC      PS                 ENTRY/EXIT 
          SA6    AVCA        SAVE PARAMETER ASSEMBLY REGISTER 
          CONTROL  CCDR,RSS,LF  GET NEXT CONTROL CARD 
          SA2    CCDR 
          ZR     X2,AVC      IF NO CONTINUATION CONTROL CARD
          CONTROL CCDR       ADVANCE POINTERS 
          SB2    CCDR 
          RJ     USB         UNPACK TO STRING BUFFER
          SA2    AVCA        RESTORE PARAMETER ASSEMBLY REGISTER
          BX6    X2 
          SB7    B7+B1       SET LWA+1 DATA IN STRING BUFFER
          MX2    1
          EQ     AVC         RETURN 
  
  
 AVCA     BSS    1           ASSEMBLY REGISTER TEMPORARY
 RC3      ENDIF 
          SPACE  4
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 POP      EQU    /COMCPOP/POP 
 POPA     EQU    /COMCPOP/POPA
 QUAL$    ENDIF 
          BASE   *
          ENDX
