COMPUPS 
COMMON
          CTEXT  COMPUPS - UNPACK STATEMENT.
 UPS      SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMPUPS
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 UPS      SPACE  4
***       UPS - UNPACK STATEMENT. 
*         G. R. MANSFIELD.   70/10/18.
*         D. A. HIVELEY.     73/12/07.
*         R. A. LARSEN.      76/05/20.
 UPS      SPACE  4
***              UPS UNPACKS A STATEMENT FROM A WORD BUFFER TO A
*         CHARACTER BUFFER. 
* 
*         CHARACTER PROCESSING WITHOUT LITERALS - 
*                IMBEDDED SPACES ARE DELETED. 
*                THE STRING TERMINATES WITH A BYTE OF 0000. 
*                THE TERMINATION CONDITION IS A *.* OR *)*. 
* 
*         CHARACTER PROCESSING WITH LITERALS -
*                LITERALS ARE DELIMITED BY A *$*. 
*                A *$$* IS VALID WITHIN A LITERAL AND IS NOT CONSIDERED 
*                A DELIMITER. 
*                A *.*, *)*, OR * * WITHIN A LITERAL HAS NO SPECIAL 
*                MEANING. 
*                OUTSIDE THE LITERAL IMBEDDED SPACES ARE DELETED. 
*                THE STRING TERMINATES WITH A BYTE OF 0000. 
* 
*         ERROR CONDITIONS -
*                NO TERMINATOR FOUND. 
*                BYTE VALUE = 0 (DOUBLE COLON). 
*                UNDELIMITED LITERAL. 
* 
*         ENTRY  (STMT - STMT+N) = STATEMENT TERMINATED WITH A 0 WORD.
* 
*         EXIT   (A) = 0, IF N0 ERROR FOUND.
*                (T1) = ADDRESS OF LAST BYTE GOTTEN FROM (STMT).
*                (T2) = ADDRESS OF LAST CHARACTER STORED IN (CHAR). 
*                (T3) = CHARACTER POSITION INDICATOR
*                       (1 = UPPER, 0 = LOWER). 
*                (CHAR - CHAR+N) = UNPACKED STATEMENT.
* 
*         USES   T1 - T3. 
* 
*         CALLS  GNC. 
  
  
 UPS      SUBR               ENTRY/EXIT 
          LDN    0           CLEAR CHARACTER POSITION INDICATOR 
          STD    T3 
          LDC    STMT-1      SET STATEMENT ADDRESS
          STD    T1 
          LDC    CHAR        SET CHARACTER ADDRESS
          STD    T2 
  
*         CHECK FIRST CHARACTER, DELETING IMBEDDED BLANKS.
  
 UPS1     RJM    GNC         GET NEXT CHARACTER 
          ZJN    UPS7        IF COLON 
          SBN    1R$
          ZJN    UPS8        IF *$* 
          SBN    1R -1R$
          ZJN    UPS1        IF BLANK 
          ADN    -1RZ-1+1R
          MJN    UPS8        IF ALPHABETIC
          SBN    1R9+1-1RZ-1
          PJN    UPS7        IF NON-NUMERIC 
  
*         SKIP SEQUENCE NUMBER, DELETING IMBEDDED BLANKS. 
  
 UPS2     AOD    T2          ADVANCE CHARACTER ADDRESS
 UPS3     RJM    GNC         GET NEXT CHARACTER 
          ZJN    UPS5        IF COLON 
          SBN    1R9+1
          MJN    UPS2        IF ALPHANUMERIC
          SBN    1R)-1R9-1
          ZJN    UPS4        IF *)* 
          SBN    1R -1R)
          ZJN    UPS3        IF BLANK 
          SBN    1R.-1R 
          NJN    UPS5        IF NOT *.* 
 UPS4     STI    T2          TERMINATE BUFFER 
          LJM    UPSX        RETURN 
  
*         CHECK FIRST CHARACTER AFTER SEQUENCE NUMBER TERMINATOR. 
  
 UPS5     AOD    T2          ADVANCE CHARACTER ADDRESS
 UPS6     RJM    GNC         GET NEXT CHARACTER 
          LMN    1R 
          ZJN    UPS6        IF BLANK 
          LMN    1R$&1R 
          ZJN    UPS8        IF *$* 
 UPS7     LDI    T2          GET CURRENT CHARACTER
          UJN    UPS10       SEARCH FOR TERMINATOR
  
*         SEARCH FOR TERMINATOR, DELETING IMBEDDED BLANKS.
  
 UPS8     AOD    T2          ADVANCE CHARACTER ADDRESS
 UPS9     RJM    GNC         GET NEXT CHARACTER 
 UPS10    LMN    1R 
          ZJN    UPS9        IF BLANK 
          LMN    1R.&1R 
          ZJN    UPS4        IF *.* 
          LMN    1R)&1R.
          ZJN    UPS4        IF *)* 
          LMN    1R$&1R)
          NJN    UPS8        IF NOT *$* 
  
*         PROCESS LITERAL CHARACTER STRING. 
  
 UPS11    AOD    T2          ADVANCE CHARACTER ADDRESS
          RJM    GNC         GET NEXT CHARACTER 
          LMN    1R$
          NJN    UPS11       IF NOT *$* 
          AOD    T2          ADVANCE CHARACTER ADDRESS
          RJM    GNC         GET NEXT CHARACTER 
          LMN    1R$
          ZJN    UPS11       IF *$$*
          UJN    UPS7        END OF LITERAL STRING
 GNC      SPACE  4,15 
**        GNC - GET NEXT CHARACTER. 
* 
*         ENTRY  (T1) = ADDRESS OF NEXT BYTE OF CONTROL CARD - 1. 
*                (T2) = ADDRESS TO STORE NEXT CHARACTER.
*                (T3) = NEXT CHARACTER INDICATOR. 
* 
*         EXIT   (A) = NEXT CHARACTER.
*                (T1) ADVANCED IF NEW BYTE NEEDED.
*                ((T2)) = NEXT CHARACTER. 
*                (T3) = TOGGLED TO INDICATE NEXT CHARACTER. 
*                TO *UPSX* IF ERROR ENCOUNTERED.
* 
*         USES   T1, T2, T3.
  
  
 GNC2     SHN    -6          POSITION UPPER CHARACTER 
          UJN    GNC4        STORE CHARACTER
  
 GNC3     LDI    T1          GET LOWER CHARACTER
          LPN    77 
 GNC4     STI    T2          STORE CHARACTER
  
 GNC      SUBR               ENTRY/EXIT 
          LDD    T3          DETERMINE UPPER/LOWER CHARACTER
          LMN    1
          STD    T3 
          ZJN    GNC3        IF LOWER CHARACER
          AOD    T1          ADVANCE STATEMENT ADDRESS
          LMC    STMT+9D*5
          ZJN    GNC1        IF END OF STATEMENT
          LDI    T1          GET NEXT WORD OF STATEMENT 
          NJN    GNC2        IF NOT DOUBLE COLON OR END OF STATEMENT
 GNC1     STI    T2          TERMINATE STRING BUFFER
          LDN    1           INDICATE ERROR 
          LJM    UPSX        RETURN 
          SPACE  4
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 UPS      EQU    /COMPUPS/UPS 
 QUAL$    ENDIF 
          ENDX
