COMCCPA 
COMMON
          CTEXT  COMCCPA - CONVERT POSITIONAL ARGUMENTS.
 CPA      SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMCCPA
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4
***       CPA - CONVERT POSITIONAL ARGUMENTS. 
*         S. L. KSANDER.     75/08/16.
          SPACE  4
***       CPA - CONVERT POSITIONAL ARGUMENTS. 
*         AN INPUT STRING BUFFER IS EXAMINED AND ALL POSITIONAL 
*         ARGUMENTS ARE TRANSLATED TO KEYWORD ARGUMENTS IN AN 
*         OUTPUT STRING. MEANING OF AN ARGUMENT POSITION IS GOVERNED BY 
*         POSITION OF KEYWORD IN ARGUMENT TABLE.
* 
*         ENTRY  (B1) = 1.
*                (B2) = LENGTH OF ARGUMENT TABLE. 
*                (B3) = ADDRESS OF ARGUMENT TABLE.
*                (B4) = ADDRESS TO STORE RESULT.
*                (B6) = FIRST ADDRESS OF INPUT STRING.
* 
*         EXIT   (B5) .LT. 0 IF ERROR.
*                (B5) = LWA OF RESULT STRING. 
*                (X1) .GT. 0 IF NO ARGUMENTS CONVERTED
* 
*         USES   B - 4, 5, 6, 7.
*                A - 1, 2, 3, 6, 7. 
*                X - ALL. 
* 
*         CALLS  POP, TRA.
  
  
 CPA10    SB5    -1          SET ERROR
  
  
 CPA      SUBR               ENTRY/EXIT 
  
*         INITIALIZATION. 
  
 CPA1     SX6    B4          SET NEXT OUTPUT ADDRESS
          SX0    B2          SET ARGUMENT TABLE LENGTH
          SA6    CPAA 
          BX5    X5-X5       CLEAR POSITION INDICATOR 
          BX6    X6-X6       INITIALIZE *CPAB*
          SA6    CPAB 
  
*         PICK OUT NEXT ARGUMENT. 
  
 CPA2     SX4    B6+         SAVE START ADDRESS 
          LE     B6,B0,CPA9  IF END OF STRING 
          RJ     POP         PICK OUT PARAMETER 
          NG     B5,CPAX     IF ERROR 
          NG     X5,CPA4     IF VALUE OF EQUIVALENCE
          NZ     B5,CPA6     IF MORE THAN ONE WORD ARGUMENT 
          SA3    POPA 
          ZR     X3,CPA8     IF EMPTY ARGUMENT
  
*         CHECK FOR KEYWORD SPECIFICATION.
  
          SA2    B3 
          MX3    12          CHECK ARGUMENT IS KEYWORD
          SB5    12 
 CPA3     ZR     X2,CPA6     IF NOT A KEYWORD 
          BX2    X3*X2
          LX7    X2,B5
          SX7    X7-77B 
          NZ     X7,CPA3.1   IF KEYWORD .LT. 3 CHARACTERS 
          SA2    A2+B1
 CPA3.1   BX7    X2-X6
          SA2    A2+B1
          NZ     X7,CPA3     IF NOT FOUND 
          SX7    X1-1R=      CHECK FOR EQUIVALENCE
          NZ     X7,CPA6     IF NOT EQUIVALENCED, PROCESS AS POSITIONAL 
  
*         PROCESS *KEY=* OR *=VALUE*. 
  
 CPA4     BX5    -X5         REVERSE EQUIVALENCED VALUE FLAG
 CPA5     RJ     TRA         TRANSMIT ARGUMENT
          NG     X5,CPA2     IF PROCESSING *KEY=* 
          MX7    12 
          SA3    CPAB 
          SX3    X3+B3
          SB5    X5 
          SA3    X3+B5
          BX3    X7*X3
          SB5    12 
          LX7    X3,B5
          SX7    X7-77B 
          NZ     X7,CPA5.1   IF KEYWORD .LT. 3 CHARACTERS 
          SA3    CPAB 
          SX7    X3+B1
          SA7    CPAB 
 CPA5.1   SX5    X5+B1       ADVANCE POSITION 
          SA3    CPAB 
          IX7    X5-X0
          IX7    X7+X3
          SX3    1
          IX7    X7-X3
          PL     X7,CPA10    IF POSITION OUT OF RANGE 
          EQ     CPA2        LOOP FOR ALL ARGUMENTS 
  
*         PROCESS POSITIONAL VALUE. 
  
 CPA6     SA1    A1+         CHECK EQUIVALENCE
          SX7    X1-1R= 
          ZR     X7,CPA10    IF EQUIVALENCED
          MX7    12 
          SA3    CPAB 
          SX3    X3+B3
          SB5    X5 
          SA3    X3+B5
          SB5    2
          SB7    2
          BX2    X7*X3
          LX2    12 
          SX2    X2-77B 
          NZ     X2,CPA6.1   IF KEYWORD .LT. 3 CHARACTERS 
          SA3    A3+B1
          SB7    7
 CPA6.1   MX7    -6 
          SA2    CPAA        READ NEXT OUTPUT ADDRESS 
          LX3    6
          BX6    -X7*X3 
          LX3    6
          SA6    X2+
 CPA6.2   GT     B5,B7,CPA7  IF NO MORE CHARACTERS
          BX6    -X7*X3 
          ZR     X6,CPA7     IF KEYWORD END 
          SA6    X2+B1
          SX2    X2+B1
          LX3    6
          SB5    B5+B1
          EQ     CPA6.2      CHECK FOR NO MORE CHARACTERS 
 CPA7     SX6    1R=
          SA6    X2+B1
          SX7    A6+B1
          SA7    A2 
          RJ     TRA         TRANSMIT ARGUMENT
 CPA8     MX7    12 
          SA3    CPAB 
          SX3    X3+B3
          SB5    X5 
          SA3    X3+B5
          BX3    X7*X3
          SB5    12 
          LX7    X3,B5
          SX7    X7-77B 
          NZ     X7,CPA5.1   IF KEYWORD .LT. 3 CHARACTERS 
          SA3    CPAB 
          SX7    X3+B1
          SA7    CPAB 
          SX5    X5+B1       ADVANCE POSITION 
          EQ     CPA2        LOOP TO END OF ARGUMENTS 
  
*         NORMAL COMPLETION.
  
 CPA9     SA1    CPAA        RETURN LWA OF RESULT 
          SX7    1R.         ENSURE TERMINATOR
          SB5    X1 
          PL     X1,CPA9.1   IF NO ARGUMENTS PROCESSED
          SB5    B5-B1       ADJUST LWA FOR LAST ARGUMENT 
 CPA9.1   SA7    B5 
          EQ     CPAX        RETURN 
  
 CPAA     CON    0           1/ARGUMENTS PROCESSED,59/NEXT OUTPUT ADDR. 
 CPAB     CON    0           NUMBER OF EXTRA ARG TABLE WORDS
 TRA      SPACE  4
**        TRA - TRANSMIT ARGUMENT TO OUTPUT STRING. 
* 
*         ENTRY  (B1) = 1.
*                (X4) = FWA OF SOURCE.
*                (A1) = LWA OF SOURCE.
*                (CPAA) = NEXT OUTPUT ADDRESS.
* 
*         USES   A - 1, 2, 6. 
*                X - 1, 2, 3, 6.
  
  
 TRA      SUBR               ENTRY/EXIT 
          SX3    A1+B1       FIND WORD COUNT
          SA1    X4-1        INITIALIZE SOURCE ADDRESS
          IX3    X3-X4
          SA2    CPAA        SET NEXT OUTPUT ADDRESS
 TRA1     SA1    A1+B1       MOVE 
          SX3    X3-1 
          BX6    X1 
          SA6    X2 
          SX2    X2+B1
          NZ     X3,TRA1     IF MOVE NOT COMPLETE 
          MX1    1           SET ARGUMENTS PROCESSED
          BX6    X2+X1       UPDATE NEXT OUTPUT ADDRESS 
          SA6    A2+
          EQ     TRAX        RETURN 
          SPACE  4
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 CPA      EQU    /COMCCPA/CPA 
          ENDIF 
          ENDX
