Retro1.org codex

*DECK     NMI=UPC 
          IDENT  SETUPC 
          ENTRY  SETUPC,SETUPC2 
          USE    /PACKING/
LINE      BSS    18 
LINEND    VFD    6/76B,54/9L
KBUF      BSS    80 
 UPCSTAT  BSS    1
 UPCOUNT  BSS    1
          USE 
 
 
**        SETUPC
*         SET UP THE DATA LINE TO BE CRACKED FOR THE
*         PROCESS UPC 
* 
SETUPC    EQ     *+1S17       ENTRY FOR 8 WORD UPC
          SA1    LINEND 
          BX6    X1 
          SA6    LINE+8       SET UP TERMINATOR 
SET1      SB1    1
          SB7    KBUF 
          SA5    LINE 
          RJ     =XUPC
          SA6    UPCSTAT     SAVE STATUS
          SX7    B6-B1       SAVE 
          SA7    UPCOUNT      PARAMETER COUNT 
          EQ     SETUPC 
 
SETUPC2   EQ     *+1S17       ENTRY FOR 16 WORD UPC 
          SA1    SETUPC2
          BX6    X1           RESET RETURN ADDRESS
          SA6    SETUPC 
          EQ     SET1 
          END 
          IDENT   UPC 
          ENTRY   UPC 
          TITLE   UPC - UNPACK CONTROL CARD 
 UPC      SPACE  4,10 
          BASE   D
*         COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1994. 
 UPC      SPACE  4,10 
***       UPC - UNPACK CONTROL CARD.
* 
*         G. R. MANSFIELD.   70/12/12.
*         P. C. TAM.         77/05/25.
* 
*         ******************************************************* 
*         * THIS COMMON DECK IS PART OF THE COMMON COMMON DECKS * 
*         * RESIDING ON THE COMPASS PROGRAM LIBRARY, AND BEING  * 
*         * MAINTAINED BY THE COMPASS PROJECT.  ANY CHANGES     * 
*         * REQUIRED SHOULD BE DIRECTED TO THE COMPASS PROJECT  * 
*         * THROUGH THE PROPER PROCEDURE.                       * 
*         ******************************************************* 
* 
* 
*         UPC UNPACKS A CONTROL/DATA STREAM INTO
*         INDIVIDUAL PARAMETERS 
 UPC      SPACE  4,10 
***       UPC UNPACKS A CONTROL CARD TO INDIVIDUAL PARAMETERS.
*         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 SPECIAL (NON A/N) CHARACTERS CONSIDERED AS PARAMETER
*                SEPARATORS.
*         (3.)  THE CHARACTER 76B IS CONSIDERED AS THE TERMINATION OF 
*                THE CONTROL CARD.
*         (4.)  CHARACTER WITH DISPLAY CODE VALUES 00B
*                IS 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 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. 
* 
*         ENTRY  (X5) = FIRST WORD OF CONTROL CARD. 
*                (A5) = ADDRESS OF FIRST WORD.
*                (B7) = ADDRESS FOR FIRST PARAMETER IF (B7) IS POSITIVE 
*                       COMPLEMENT OF ADDRESS FOR FIRST PARAMETER IF
*                       (B7) IS NEGATIVE. 
*                (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, 3, 5, 6, 7.
* 
*         CALLS  NONE.
 
 
 UPC      SUBR               ENTRY/EXIT 
          SB2    B7 
          PL     B2,UPC1     IF (B7) IS NEGATIVE ON ENTRY 
          SB2    -B7         IF NEGATIVE, RESET 
 UPC1     SA6    B2          PRESET A6 FOR WRITE
          SA3    TERMCHR     (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
          EQ     UPC3        ENTER LOOP 
 
 UPC2     LX6    6           ADVANCE ASSEMBLY 
          SB2    B2-6 
          BX6    X6+X7
 UPC3     LX5    6           NEXT CHARACTER 
          BX7    -X0*X5 
          NZ     X7,UPC3A 
          SX7    76B       CHANGE 00B TO 76B (TERMINATOR) 
UPC3A     SB3    X7-1R9      CHECK CHARACTER
          LX4    6           ADVANCE DISASSEMBLY
          PL     X4,UPC4
 
*         00 CHARACTER IS ILLEGAL AND * IS ALPHANUMERIC.
 
          SA5    A5+B1
 UPC4     ZR     X7,UPC7     IF CHARACTER = 00
          LT     B3,B1,UPC2  IF ALPHA/NUMERIC 
*         SB4    X7-66B      CHARS. 66-77B ARE ILLEGAL
*         GE     B4,UPC7
          SB4    X7-1R* 
          ZR     B4,UPC2     IF CHARACTER = * 
 
*         CHECK FOR BLANK AS SEPARATOR. 
 
          SB4    X7-1R       CHECK CHARACTER
          NZ     B4,UPC5     NOT BLANK, MUST BE SEPARATOR 
          PL     B7,UPC3     (B7) POSITIVE, BLANK IGNORED 
          NZ     B6,UPC3     NOT JUST AFTER KEYWORD, BLANK IGNORED
 
*         CHECK FOR PARAMETER .GT. 7 CHARACTERS.
 
 UPC5     BX1    X2*X6       CHECK ASSEMBLY 
          LX6    X6,B2       LEFT JUSTIFY ASSEMBLY
          NZ     X1,UPC7     IF .GT. 7 CHARACTERS ASSEMBLED 
          AX1    X3,B3       CHECK FOR TERMINATOR 
*         EQ     B4,B1,UPC6  IF SEPARATOR = *,* 
          BX6    X6+X7       INSERT SEPARATOR 
 UPC6     SA6    A6 
          SB2    B5          RESET ASSEMBLY 
          BX6    X6-X6
          LX1    59 
          SB6    B6+B1
          SA6    A6+B1       CLEAR LAST + 1 
          PL     X1,UPC3     LOOP IF NOT TERMINATOR 
          SA2    A6-B1       CLEAR TERMINATOR 
          MX3    42 
          BX7    X3*X2
          SA7    A2 
          EQ     UPCX        RETURN 
 
 UPC7     SX6    B1          RETURN ERROR 
          SB6    B0 
          EQ     UPCX        RETURN 
 
 
TERMCHR   VFD    60/400000000B   WAS 4100B FOR .) NOW 76B 
 UPC      SPACE  4,10 
          BASE   *
          END