Retro1.org codex

          IDENT  BLANK,BLANK 
          ABS
          SST
          ENTRY  BLANK
          ENTRY  ARG=
          ENTRY  RFL=
          ENTRY  SSJ=
          SYSCOM B1
*COMMENT  BLANK - BLANK TAPE LABELING PROGRAM.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  BLANK - BLANK TAPE LABELING PROGRAM.
          SPACE  4
***       BLANK - BLANK TAPE LABELING PROGRAM.
*         M. E. MADDEN.      73/04/01.
*         J. L. LARSON.      76/04/21.
          SPACE  4
***       *BLANK* WRITES AND VERIFIES *VOL1*, *HDR1*, AND *EOF1* LABELS
*         (ASCII OR EBCDIC) ON AN UNLABELED MAGNETIC TAPE.  IF THE
*         TAPE HAD BEEN BLANK LABELED WITH LABEL ACCESSIBILITY=BLANK
*         A LABELED TAPE MAY HAVE NEW BLANK TAPE LABELS WRITTEN.
*
*
*         THE FOLLOWING IS WRITTEN ON THE TAPE--
*
*                VOL1 HDR1 * * EOF1 * *
*
*         WHERE * IS A TAPE MARK.
*
*         AFTER THE TAPE HAS BEEN BLANKED LABELED, IT IS UNLOADED,
*         IF SPECIFIED, AND RETURNED.
          SPACE  4,10
***       BLANK COMMAND.
*
*         BLANK,VSN=VVVVVV,VA=X,OWNER=USER/FAMILY,LSL=X,FA=X,OFA=X,
*           D=DENSITY,CV=MODE,MT,NT,CT,AT,U,EVSN=EEEEEE).
*
*         VSN    VOLUME SERIAL NUMBER (1 - 6 CHARACTERS)
*
*                  DEFAULT IS *      *
*
*         VA     VOLUME ACCESSIBILITY (1 CHARACTER)
*
*                  DEFAULT IS * * (VOL1 LABEL CAN BE REWRITTEN)
*
*         OWNER  OWNER IDENTIFICATION (USER/FAMILY)
*
*                  DEFAULT IS CURRENT USER NAME AND FAMILY OF JOB
*
*         LSL    LABEL STANDARD LEVEL (1 CHARACTER)
*
*                  DEFAULT IS *1*
*
*         FA     FILE ACCESSIBILITY (1 CHARACTER)
*
*                  DEFAULT IS * * (UNLIMITED ACCESS)
*
*         OFA    OLD FILE ACCESSIBILITY (1 CHARACTER)
*
*                  DEFAULT IS * *
*
*         D      TAPE DENSITY (200, 556, 800, 1600, 6250, 38000, LO,
*                  HI, HY, HD, PE, GE, CE, AE)
*
*                  200 = 200 BPI (MT DEVICE)
*                  556 = 556 BPI (MT DEVICE)
*                  800 = 800 BPI (MT OR NT DEVICE)
*                  1600 = 1600 CPI (NT DEVICE)
*                  6250 = 6250 CPI (NT DEVICE)
*                  38000 = 38000 CPI CARTRIDGE (CT OR AT DEVICE)
*                  LO = 200 BPI (MT DEVICE)
*                  HI = 556 BPI (MT DEVICE)
*                  HY = 800 BPI (MT DEVICE)
*                  HD = 800 BPI (NT DEVICE)
*                  PE = 1600 CPI (NT DEVICE)
*                  GE = 6250 CPI (NT DEVICE)
*                  CE = 38000 CPI CARTRIDGE (CT DEVICE)
*                  AE = 38000 CPI ACS CARTRIDGE (AT DEVICE)
*
*                  DEFAULT IS JOB DEFAULT VALUE FOR DEVICE TYPE
*
*         CV     CONVERSION MODE (AS, US, EB)
*
*                  EB = EBCDIC
*                  AS = ASCII
*                  US = ASCII
*
*                  DEFAULT IS JOB DEFAULT VALUE FOR DEVICE TYPE
*
*         DT     TAPE DEVICE TYPE
*
*                MT = 7 TRACK
*                NT = 9 TRACK
*                CT = CARTRIDGE
*                AT = ACS CARTRIDGE
*
*         MT     BLANK LABEL 7 TRACK TAPE (OBSOLETE)
*
*         NT     BLANK LABEL 9 TRACK TAPE (OBSOLETE)
*
*         U      UNLOAD UNIT AFTER BLANKING TAPE
*
*                  DEFAULT IS NOT SELECTED (DO NOT UNLOAD UNIT)
*
*         EVSN   EXTERNAL VSN (1 - 6 ALPHANUMERIC CHARACTERS)
*
*                  REQUIRED WHEN LABELING *AT* TAPE
*                  NOT ALLOWED WHEN NOT LABELING *AT* TAPE
          SPACE  4,10
***       ERROR MESSAGES.
*
*         * BLANK LABELS DO NOT VERIFY.*
*                LABELS READ DO NOT MATCH THOSE WRITTEN.  FOR
*                SYSTEM ORIGIN JOBS, THIS MESSAGE WILL FLASH AT
*                THE JOB-S CONTROL POINT.  ENTERING THE CONSOLE
*                COMMAND *GO,JSN* WILL RETRY THE REQUEST.
*
*         * ERROR IN ARGUMENTS.*
*                ONE OR MORE ARGUMENTS WERE INCORRECT, OR
*                REQUIRED ARGUMENTS WERE MISSING.
*
*         * EXTERNAL VSN NOT ALLOWED FOR TAPE DEVICE TYPE.*
*                AN EXTERNAL VSN WAS SPECIFIED FOR A TAPE DEVICE TYPE
*                OTHER THAN *AT*.
*
*         *EXTERNAL VSN NOT SPECIFIED FOR AT TAPE.*
*                AN EXTERNAL VSN WAS NOT SPECIFIED WHEN BLANK LABELING
*                AN *AT* TAPE.
*
*         * INCORRECT DENSITY FOR TAPE DEVICE TYPE.
*                THE SPECIFIED DENSITY IS NOT SUPPORTED BY THE
*                SPECIFIED TAPE DEVICE TYPE.
*
*         * SYSTEM ERROR.*
*                *RSB* MONITOR FUNCTION FAILS.
*
*         * TAPE BLANK LABELED.*
*                BLANK LABEL OPERATION WAS SUCCESSFUL.
*
*         * TAPE READ/WRITE ERROR (BLANK).*
*                AN ERROR OCCURRED WHILE ATTEMPTING TO READ OR WRITE
*                THE TAPE LABELS.  FOR SYSTEM ORIGIN JOBS, THIS MESSAGE
*                WILL FLASH AT THE JOB-S CONTROL POINT.  ENTERING THE
*                CONSOLE COMMAND *GO,JSN* WILL RETRY THE REQUEST.
          SPACE  4,10
****      ASSEMBLY CONSTANTS.
 
 
 BUFL     EQU    101B        CIO BUFFER LENGTH
 BUFFL    EQU    12          SCRATCH BUFFER LENGTH
 COUNT    EQU    3           LABEL ERROR RETRY COUNT
 
 
****
          SPACE  4,10
*         MICRO DEFINITIONS.
 
 
 VERNUM   MICRO  6,3,+"VER170"+
          TITLE    COMMON DECKS.
*         COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMSPRD
*CALL     COMSSSD
          QUAL   COMSSSJ
*CALL     COMSSSJ
          QUAL   *
          TITLE    MACRO  DEFINITIONS.
 RDSB     SPACE  4,10
**        RDSB.
*
*         READ SUB-SYSTEM BLOCK.
*
*         STATUS WORD *SS* IS USED.
*
*         RDSB   QUEUE,WC,FROM,TO
 
          PURGMAC RDSB
 
 RDSB     MACRO  Q,W,F,T
          MACREF RDSB
          R= X5,W
          R= X6,T
          R= X7,F
          R= X1,Q
          RJ RSB
          ENDM
 BLANK    SPACE  4
          TITLE  MAIN PROGRAM.
          ORG    110B
 
 
**        BLANK - MAIN PROGRAM.
 
 
 BLANK    SB1    1           (B1) = 1
          SB2    CCDR        UNPACK COMMAND
          RJ     USB
 BLK1     SA5    =0LBLANK    CHECK FOR *BLANK*
          RJ     POP
          NG     B5,ERR      IF COMMAND ERROR
          ZR     X2,ERR      IF ILLEGAL SEPARATOR
          BX7    X6-X5
          NZ     X7,BLK1     IF NOT *BLANK*
          SX1    X1-1R=
          ZR     X1,ERR      IF ILLEGAL SEPARATOR
 
*         RESTORE USER NAME AND USER INDEX IN CONTROL POINT AREA.
 
          SA1    SSJ=+/COMSSSJ/UIDS  USER NAME AND USER INDEX
          BX6    X1
          SA6    BLKA+2
          SX6    3           SET USER NAME AND USER INDEX FLAGS
          SA6    BLKA
          SETPFP BLKA        CHANGE USER NAME AND USER INDEX IN CP AREA
 
*         INITIALIZE LABELS.
 
          RJ     BOP         PROCESS OPTIONAL PARAMETERS
          SA1    HDR
          SA2    HDR1        BUILD HDR1 FIRST WORD
          MX0    -36
          SA3    EOF1        BUILD EOF1 FIRST WORD
          BX1    -X0*X1
          BX6    X1+X2
          SA6    A2
          BX6    X1+X3
          SA6    A3
          UNLOAD F,R
 
*         ENTER HERE TO RETRY AFTER OPERATOR *GO*.
 
 BLK2     SA1    F+1         CLEAR ERROR PROCESSING BIT
          MX0    -1
          LX0    44
          BX6    X0*X1
          SA6    A1
          LABEL  F           REQUEST TAPE ASSIGNMENT
          SA1    F+1         SET ERROR PROCESSING BIT
          SX0    B1
          LX0    44
          BX6    X0+X1
          SA6    A1
 
*         INSERT EST ORDINAL INTO *HDR1* / *EOF1* LABELS.
 
          STATUS F,P
          SA1    F+6         READ FST FROM FET+6
          MX0    -9
          LX1    12
          MX2    -3
          BX5    -X0*X1      EST ORDINAL
          SB2    1R0
          BX4    -X2*X5
          MX0    18
          LX5    -3
          SX4    X4+B2
          BX7    -X2*X5
          LX5    -3
          SX7    X7+B2
          BX5    -X2*X5
          SA3    HDR+7       ENTER EST ORDINAL IN HDR1
          SX5    X5+B2
          LX4    -18
          BX3    -X0*X3
          LX5    -6
          BX6    X4+X5
          LX7    -12
          BX6    X6+X7
          BX6    X6+X3
          SA6    A3+
          SA2    DBS         SET DEFAULT BLOCK SIZE IN FET
          BX6    X6-X6
          LX7    X2
          SA6    F+5         CLEAR FNT/FST FROM FET
          SA7    A6+1        SET MLRS FIELD
 
*         WRITE LABELS.
*         ENTER HERE TO RETRY IF ERROR DETECTED AND RETRY COUNT
*         NOT YET EXHAUSTED.
 
 BLK3     REWIND F
          MOVE   10,VBUF,BUF      VOL1
          SA1    HDR1        SET *HDR1*
          BX6    X1
          SA6    HDR
          MOVE   10,HBUF,BUF+10   HDR1
          MOVE   2,EOT,BUF+20     TAPE MARK
          MOVE   2,EOT,BUF+22     TAPE MARK
          SA1    EOF1        SET *EOF1*
          BX6    X1
          SA6    HDR
          MOVE   10,HBUF,BUF+24  EOF1
          MOVE   2,EOT,BUF+34     TAPE MARK
          MOVE   2,EOT,BUF+36     TAPE MARK
          RECALL F
          SX6    BUF+38
          SA6    F+2         SET IN
          WRITECW F,R        WRITE LABELS ONTO TAPE
          RJ     CTS         CHECK TAPE STATUS
 
*         VERIFY LABELS.
 
          REWIND F,R
          READCW F,17B       READ EXPECTED LABELS
          RJ     CTS         CHECK TAPE STATUS
          SA0    VBUF
          RJ     VYL         VERIFY VOLUME LABEL
          SA1    HDR1        SET *HDR1*
          BX6    X1
          SA6    HDR
          SA0    HBUF
          RJ     VYL         VERIFY HEADER LABEL
          RJ     VTM         VERIFY TAPE MARK
          READCW F,17B
          RJ     CTS         CHECK TAPE STATUS
          RJ     VTM         VERIFY TAPE MARK
          READCW F,17B
          RJ     CTS         CHECK TAPE STATUS
          SA1    EOF1        SET *EOF1*
          BX6    X1
          SA6    HDR
          SA0    HBUF
          RJ     VYL         VERIFY TRAILER LABEL
          RJ     VTM         VERIFY TAPE MARK
          READCW F,17B
          RJ     CTS         CHECK TAPE STATUS
          RJ     VTM         VERIFY TAPE MARK
          UNLOAD F
          MESSAGE (=C* TAPE BLANK LABELED.*),3
          ENDRUN
 
 
 BLKA     BSSZ   3           *SETPFP* BLOCK
 IEE      SPACE  4,15
**        IEE - I/O ERROR EXIT.
*
*         ENTRY  FROM *CTS* IF ERROR STATUS DETECTED IN FET.
*                FROM *VER* (AT *IEE1*) IF VERIFY ERROR RETRY COUNT
*                EXHAUSTED.
*
*         EXIT   TO *BLK3* IF RETRY COUNT NOT YET EXHAUSTED.
*                TO *ABT* IF RETRY COUNT EXHAUSTED AND NOT *SYOT*.
*                TO *BLK2* IF OPERATOR ENTERS *GO* TO FLASHING REQUEST.
*
*         USES   X - 1, 2, 6.
*                A - 1, 6.
*                B - 2.
*
*         MACROS FLASH, MESSAGE, RECALL, REWIND, WRITEF, UNLOAD.
 
 
 IEE      BSS    0           ENTRY
          SA1    IEEA
          SX6    X1-1
          SA6    A1
          NZ     X1,BLK3     IF RETRY COUNT NOT EXHAUSTED
          SX6    COUNT       RESET RETRY COUNT
          SA6    A1
          REWIND F
          WRITEF X2          ERASE LABELS
          UNLOAD X2
          SB2    =C* TAPE READ/WRITE ERROR (BLANK).*
 
*         CHECK FOR SYSTEM ORIGIN PROCESSING.
 
 IEE1     SA1    JOPR        CHECK ORIGIN TYPE
          AX1    24
          MX2    -12
          BX1    -X2*X1
          ERRNZ  SYOT        CODE DEPENDS ON VALUE
          NZ     X1,ABT      IF NOT SYSTEM ORIGIN
 
*         DISPLAY ERROR MESSAGE ON CONSOLE, WAIT FOR OPERATOR ACTION,
*         AND RETRY THE REQUEST IF OPERATOR ENTERS *GO,JSN*.
 
          MESSAGE B2,1       DISPLAY MESSAGE
          SA1    B0          SET PAUSE FLAG IN RA+0
          MX2    1
          LX2    12-59
          BX6    X1+X2
          SA6    A1
          FLASH
 IEE2     RECALL
          SA1    B0          CHECK PAUSE FLAG IN RA+0
          LX1    59-12
          NG     X1,IEE2     IF PAUSE FLAG STILL SET
          EQ     BLK2        RETRY REQUEST
 
 IEEA     CON    COUNT       READ/WRITE ERROR RETRY COUNT
 VER      SPACE  4,10
**        VER - VERIFY ERROR EXIT.
 
 
 VER      BSS    0
          SA1    VERA
          SX6    X1-1
          SA6    A1
          NZ     X1,BLK3     IF RETRY COUNT NOT EXHAUSTED
          SX6    COUNT       RESET RETRY COUNT
          SA6    A1
          REWIND F
          WRITEF X2          ERASE LABELS
          UNLOAD X2
          SB2    =C* BLANK LABELS DO NOT VERIFY.*
          EQ     IEE1        RETRY OR ISSUE MESSAGE AND ABORT
 
 VERA     CON    COUNT       VERIFY ERROR RETRY COUNT
          TITLE  SUBROUTINES.
 CTS      SPACE  4,10
**        CTS - CHECK TAPE STATUS.
*
*         ENTRY  (F) = TAPE FET.
*
*         EXIT   TO *IEE* IF TAPE READ/WRITE ERRORS.
*
*         USES   A - 1.
*                X = 1, 6.
 
 
 CTS      SUBR               ENTRY/EXIT
          SA1    F           CHECK ERROR CODE
          AX1    9
          MX6    -5
          BX1    -X6*X1
          ZR     X1,CTSX     IF NO ERROR
          EQ     IEE         PROCESS ERROR
 RSB      SPACE  4,15
**        RSB - MAKE *RSB* REQUEST.
*
*         ENTRY  (X1) = SUBSYSTEM QUEUE PRIORITY.
*                (X5) = WORD COUNT.
*                (X6) = ADDRESS TO SEND TO.
*
*         EXIT   TO *ERR2*, IF SYSTEM ERROR.
*
*         USES   A - 1, 2, 7.
*                X - 1, 2, 5, 6, 7.
*
*         CALLS  SYS=.
 
 
 RSB      SUBR               ENTRY/EXIT
          SA2    RSBA
          LX5    36
          LX7    18
          BX6    X6+X5
          LX1    18
          BX7    X7+X6
          BX6    X1+X2
          SA7    X6
          RJ     =XSYS=
          SA1    SS          CHECK ERROR RESPONSE
          PL     X1,ERR2     IF ERROR CONDITION
          EQ     RSBX        RETURN
 
 RSBA     VFD    18/3LRSB,12/2000B,12/0,18/SS
 SS       CON    0           RDSB MACRO STATUS WORD
 VTM      SPACE  4,10
**        VTM - VERIFY TAPE MARK.
*
*         EXIT   TO VER IF ERRORS.
*
*         MACRO  READW.
 
 
 VTM      SUBR               ENTRY/EXIT
          READW  F,BUFF,1
          NG     X1,VTMX     IF EOF ENCOUNTERED
          EQ     VER         ERROR
 VYL      SPACE  4,15
**        VYL - VERIFY LABEL.
*
*         ENTRY  (A0) = FWA EXPECTED LABEL CONTENTS.
*
*         EXIT   TO VER IF ERRORS.
*
*         USES   A - 1, 2.
*                B - 2.
*                X - 0, 1, 2, 3.
*
*         MACRO  READW.
 
 
 VYL      SUBR               ENTRY/EXIT
          READW  F,BUFF,10
          NZ     X1,VER      IF EOR/EOF
          SA1    A0
          MX0    -30
          SA2    BUFF
          BX3    X1-X2
          BX3    -X0*X3
          NZ     X3,VER      IF INCORRECT UBC OR BLOCK LENGTH
          SB2    8
 VYL1     SA1    A1+B1
          SA2    A2+B1
          BX3    X1-X2
          SB2    B2-B1
          NZ     X3,VER      IF LABEL CONTENT ERROR
          NZ     B2,VYL1     IF MORE WORDS TO VERIFY
          SA2    A2+B1
          AX2    48
          NZ     X2,VER      IF NOT LEVEL ZERO
          EQ     VYLX        RETURN
          TITLE  PARAMETER PROCESSING SUBROUTINES.
 AOP      SPACE  4,15
**        AOP - ANALYZE OPTIONAL PARAMETERS.
*
*         ENTRY  (B3) = PARAMETER OPTION TABLE ADDRESS.
*                (B6) = ADDRESS TO BEGIN PARAMETER ASSEMBLY.
*
*         EXIT   (X1) = SEPARATOR.
*                (X2) = OPTION TABLE ENTRY.
*                (X5) = PARAMETER.
*                TO ERR IF ERROR.
*
*         USES   A - 2.
*                X - 2, 3, 6.
*
*         CALLS  CLP.
 
 
 AOP      SUBR               ENTRY/EXIT
          RJ     CLP         GET PARAMETER
          SA2    B3-B1       READ OPTION TABLE
          MX3    30
 AOP1     SA2    A2+B1
          BX6    X3*X2
          ZR     X2,ERR      IF END OF OPTIONS
          BX6    X6-X5
          NZ     X6,AOP1     IF NO MATCH
          EQ     AOPX        RETURN
 BOP      SPACE  4,20
**        BOP - BLANK OPTIONAL PARAMETER PROCESSOR.
*
*         ENTRY  USBB CONTAINS UNPACKED COMMAND.
*                (B6) = STRING BUFFER POINTER.
*
*         EXIT   FET HAS TAPE DESCRIPTORS.
*                *VBUF* AND *HBUF* BUILT.
*                TO *ERR* IF PARAMETER ERROR.
*
*         USES   X - ALL.
*                A - 1, 3, 4, 5, 6, 7.
*                B - 2, 3.
*
*         CALLS  AOP, SDT, SOI.
*
*         MACROS GETPFP, JDATE.
 
 
 BOP      SUBR               ENTRY/EXIT
 
*         SET DEFAULT OWNERSHIP AND TAPE DESCRIPTORS.
 
          SA4    DTD         DEFAULT TAPE DESCRIPTORS
          BX7    X4
          BX6    X6-X6
          SA7    F+10B       SET DEFAULT TAPE DESCRIPTORS IN FET
          SA6    A7+B1       CLEAR VSN FIELD
          GETPFP BOPA        GET FAMILY NAME
          SA5    BOPA
          MX0    42
          BX5    X0*X5       FAMILY NAME
          SA4    SSJ=+/COMSSSJ/UIDS
          BX4    X0*X4       USER NUMBER
          RJ     SOI         SET OWNER IDENTIFICATION
          JDATE  BOPA        BUILD CREATION/RETENTION DATES
          SA1    BOPA
          BX2    X1
          AX2    24
          SX2    X2-1R7
          SX5    1R          SET 20TH CENTURY FILL CHARACTER
          PL     X2,BOP0     IF DATE IS BEFORE THE YEAR 2000
          SX5    1R0         SET 21ST CENTURY FILL CHARACTER
 BOP0     BX2    X1
          LX2    6
          BX2    X2+X5
          LX5    6*6
          BX2    X2+X5
          LX2    12
          LX1    -18
          MX5    -12
          BX0    -X5*X1
          BX2    X0+X2
          MX5    6
          SA3    HDR+4
          BX3    X5*X3
          BX6    X3+X2
          SA6    A3
          MX5    18
          SA3    A3+B1
          BX1    X5*X1
          BX3    -X5*X3
          BX6    X1+X3
          SA6    A3
 
*         PROCESS OPTIONAL PARAMETERS.
*         REENTER HERE FROM COMMAND PARAMETER PROCESSORS.
 
 BOP1     ZR     B6,BOP4     IF COMMAND EXHAUSTED
          SB3    TCCP
          SX6    B0+
          SA6    LIT         DISABLE LITERAL PROCESSING
          RJ     AOP         ANALYZE OPTION
          SB2    X2          PROCESSOR ADDRESS
          LX2    59-28
          SX3    X1-1R=
          PL     X2,BOP2     IF NOT EQUIVALENCED PARAMETER
          NZ     X3,ERR      IF NOT CORRECT SEPARATOR
          EQ     BOP3        CONTINUE
 
 BOP2     ZR     X3,ERR      IF NOT CORRECT SEPARATOR
 BOP3     MX6    -1
          BX6    -X6*X2
          SA6    LIT         ENABLE/DISABLE LITERAL PROCESSING
          LX2    0-18-59+28
          JP     B2          JUMP TO PROCESSOR
 
*         CHECK FOR DEVICE TYPE CONFLICT.
 
 BOP4     RJ     SDT         SET DEVICE TYPE IN FET
          SA2    F+11B       CHECK EXTERNAL VSN SPECIFIED
          LX1    12
          SX1    X1-2RAT
          MX0    36
          BX2    X0*X2
          NZ     X1,BOP5     IF NOT *AT* TAPE DEVICE TYPE
          SB2    =C* EXTERNAL VSN NOT SPECIFIED FOR AT TAPE.*
          ZR     X2,ABT      IF EXTERNAL VSN NOT SPECIFIED
          EQ     BOPX        RETURN
 
 BOP5     SB2    =C* EXTERNAL VSN NOT ALLOWED FOR TAPE DEVICE TYPE.*
          NZ     X2,ABT      IF EXTERNAL VSN SPECIFIED
          EQ     BOPX        RETURN
 
 
 BOPA     BSS    3           TEMPORARIES
 TCCP     SPACE  4,10
**        TCCP - TABLE OF COMMAND PARAMETERS.
*
*T        30/KEYW,1/L,1/E,10/PARAM,18/PRAD
*
*         KEYW   1 - 5 CHARACTER COMMAND KEYWORD
*         L      LITERAL PROCESSING FOR ARGUMENT VALUE (1 = ENABLE,
*                0 = DISABLE)
*         E      PARAMETER EQUIVALENCE (1 = EQUIVALENCED,
*                0 = NOT EQUIVALENCED)
*         PARAM  PARAMETER FOR ARGUMENT PROCESSOR
*         PRAD   PROCESSOR ADDRESS
 
 
 TCCP     BSS    0
          VFD    30/0LVSN,1/1,1/1,10/0,18/VSN    VSN
          VFD    30/0LVA,1/1,1/1,10/0,18/PVA     VA
          VFD    30/0LOWNER,1/0,1/1,10/0,18/OWN  OWNER
          VFD    30/0LLSL,1/0,1/1,10/0,18/LSL    LSL
          VFD    30/0LFA,1/1,1/1,10/0,18/PFA     FA
          VFD    30/0LOFA,1/1,1/1,10/0,18/OFA    OFA
          VFD    30/0LD,1/0,1/1,10/0,18/DEN      D
          VFD    30/0LCV,1/0,1/1,10/0,18/PCV     CV
          VFD    30/0LMT,1/0,1/0,10/0,18/PDT1    MT
          VFD    30/0LNT,1/0,1/0,10/2,18/PDT1    NT
          VFD    30/0LDT,1/0,1/1,10/3,18/PDT     DT
          VFD    30/0LU,1/0,1/0,10/0,18/UNL      U
          VFD    30/0LEVSN,1/0,1/1,10/0,18/EVS   EVSN
          CON    0           END OF TABLE
 TTDV     SPACE  4,10
**        TTDV - TABLE OF TAPE DEVICE MNEMONICS.
*
*         T      12/ MNEMONIC,48/0
*
*         THIS TABLE MUST BE IN THE ORDER OF THE TAPE DEVICE TYPE CODES
*         IN THE *LABEL* FET.
 
 
 TTDV     BSS    0
          VFD    60/0LMT     7 TRACK
          VFD    60/0LCT     CARTRIDGE
          VFD    60/0LNT     9 TRACK
          VFD    60/0LAT     ACS CARTRIDGE
 CLP      SPACE  4,15
**        CLP - CALL POP (PICK OUT PARAMETER).
*
*         ENTRY  (B6) = PARAMETER BEGINNING ADDRESS IN STRING BUFFER.
*
*         EXIT   (X1) = SEPARATOR.
*                (X5) = PARAMETER.
*                TO ERR IF ERROR.
*
*         USES   X - 5.
*
*         CALLS  POP.
 
 
 CLP      SUBR               ENTRY/EXIT
          RJ     POP         PICK OUT PARAMETER
          NG     B5,ERR      IF NO PARAMETER
          ZR     X2,ERR      IF ILLEGAL TERMINATION
          GE     B5,B1,ERR   IF PARAMETER TOO LONG
          BX5    X6
          EQ     CLPX        RETURN
 ERR      SPACE  4,10
**        ERR - ERROR PROCESSOR.
 
 
 ERR      SB2    =C* ERROR IN ARGUMENTS.*
          EQ     ABT         ISSUE MESSAGE AND ABORT
 
 
 ERR2     SB2    =C* SYSTEM ERROR.*
*         EQ     ABT         ISSUE MESSAGE AND ABORT
 
 
 ABT      BSS    0
          MESSAGE B2,0
          ABORT
 SDT      SPACE  4,15
**        SDT - SET TAPE DEVICE TYPE IN FET.
*
*         EXIT   TAPE DEVICE MNEMONIC AND DEVICE TYPE SET IN *LABEL*
*                  FET IF NO ERROR.
*                (X1) = TAPE DEVICE MNEMONIC LEFT JUSTIFED IF NO ERROR.
*                TO *ABT* IF DENSITY AND DEVICE TYPE CONFLICT.
*
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2, 6.
*                B - 2.
*
*         MACROS RDSB.
 
 
 SDT      SUBR               ENTRY/EXIT
 
*         CHECK SPECIFIED TAPE DEVICE TYPE.
 
          SA1    EDT
          SA2    DDT
          NG     X1,SDT1     IF DEVICE TYPE NOT EXPLICITLY SPECIFIED
          NG     X2,SDT2     IF DEVICE TYPE NOT SELECTED BY DENSITY
          BX2    X1-X2
          ZR     X2,SDT2     IF NO DENSITY AND DEVICE TYPE CONFLICT
          SB2    =C* INCORRECT DENSITY FOR TAPE DEVICE TYPE.*
          EQ     ABT         ABORT
 
 SDT1     BX1    X2
          PL     X1,SDT2     IF DEVICE TYPE SELECTED BY DENSITY
 
*         GET DEFAULT TAPE DEVICE TYPE.
 
          MX6    1           GET INSTALLATION DEFAULTS
          SA6    SDTA
          RDSB   0,1,IPRL,A6
          SA1    SDTA
          LX1    0-4
          MX0    -2
          BX1    -X0*X1      DEFAULT TAPE DEVICE TYPE
 
*         SET DEVICE MNEMONIC AND DEVICE TYPE IN FET.
 
 SDT2     SA2    F+10B       GET TAPE DESCRIPTORS
          MX0    58
          LX0    55-0
          LX1    55-0
          BX2    X0*X2
          BX6    X2+X1
          SA6    A2
          SA2    F+1
          LX1    0-0-55+0
          MX0    -48
          SA1    TTDV+X1     GET DEVICE MNEMONIC
          BX6    -X0*X2
          BX6    X6+X1
          SA6    A2          SET DEVICE MNEMONIC IN FET
          EQ     SDTX        RETURN
 
 
 SDTA     BSSZ   3           *RSB* BUFFER
 SOI      SPACE  4,15
**        SOI - SET OWNER IDENTIFICATION IN VOL1.
*
*         ENTRY  (X4) = USER NUMBER, LEFT-JUSTIFIED, ZERO FILLED.
*                (X5) = FAMILY NAME, LEFT-JUSTIFIED, ZERO FILLED.
*
*         EXIT   FAMILY NAME CONCATENATED WITH USER NUMBER STORED IN
*                CHARACTER POSITIONS 38 - 51 OF VOL1 LABEL
*                (7 CHARACTERS EACH, LEFT-JUSTIFIED, BLANK FILLED).
*
*         USES   A - 1, 3, 6.
*                X - 0, 1, 2, 3, 4, 5, 6.
*
*         CALLS  SFN.
 
 
 SOI      SUBR               ENTRY/EXIT
          MX0    42
          BX1    X5
          RJ     SFN         SPACE FILL FAMILY NAME
          BX5    X0*X6
          LX1    X4
          RJ     SFN         SPACE FILL USER NUMBER
          BX4    X0*X6
          MX0    -18
          SA1    VOL1+3      PRESERVE CHARACTERS 31 - 37 OF VOL1
          LX5    18
          BX1    X0*X1
          BX2    -X0*X5      FIRST 3 CHARACTERS OF FAMILY NAME
          LX4    36
          BX5    X0*X5       LAST 4 CHARACTERS OF FAMILY NAME
          MX0    -42
          BX6    X1+X2
          BX2    -X0*X4      FIRST 6 CHARACTERS OF USER NUMBER
          SA6    A1
          BX4    X0*X4       LAST CHARACTER OF USER NUMBER
          SA3    VOL1+5      PRESERVE CHARACTERS 52 - 60 OF VOL1
          BX6    X5+X2
          MX0    -54
          SA6    A6+B1
          BX3    -X0*X3
          BX6    X3+X4
          SA6    A3
          EQ     SOIX        RETURN
          TITLE  OPTION PROCESSORS.
 DEN      SPACE  4,10
**        DEN - PROCESS DENSITY.
*
*         D=DENSITY.
 
 
 DEN      BSS    0           ENTRY
          SB3    TDEN
          RJ     AOP         ANALYZE DENSITY OPTIONS
          SX1    X1-1R=
          ZR     X1,ERR      IF ILLEGAL SEPARATOR
          MX0    3
          LX2    51-0
          SA3    F+10B       SET DENSITY IN FET
          LX0    -6
          BX1    X0*X2
          BX3    -X0*X3
          LX2    59-5-51+0
          BX6    X1+X3
          MX0    -2
          SA6    A3+
          PL     X2,BOP1     IF NOT UNIQUE DEVICE TYPE FOR SELECTION
          LX2    0-3-59+5
          BX6    -X0*X2      IMPLICIT TAPE DEVICE TYPE
          SA6    DDT         SET IMPLICIT DEVICE TYPE
          EQ     BOP1        RETURN
 TDEN     SPACE  4,10
**        TDEN - TABLE OF DENSITY OPTIONS.
*
*T        30/OP, 24/, 1/T, 2/DT, 3/DC
*
*         OP     1 - 5 CHARACTER DENSITY OPTION
*         T      IF SET, IMPLICITLY SELECT TAPE DEVICE TYPE
*         DI     INDEX INTO *TTDV* TABLE IF *T* FLAG IS SET
*         DC     DENSITY CODE FOR FET
 
 
 TDEN     BSS    0
          VFD    30/0L556,24/0,1/1,2/0,3/1   556 BPI MT
          VFD    30/0L200,24/0,1/1,2/0,3/2   200 BPI MT
          VFD    30/0L800,24/0,1/0,2/0,3/3   800 BPI MT, NT
          VFD    30/0L1600,24/0,1/1,2/2,3/4  1600 CPI NT
          VFD    30/0L6250,24/0,1/1,2/2,3/5  6250 CPI NT
          VFD    30/0L38000,24/0,1/0,2/0,3/6 38000 CPI CT, AT
          VFD    30/0LHI,24/0,1/1,2/0,3/1    556 BPI MT
          VFD    30/0LLO,24/0,1/1,2/0,3/2    200 BPI MT
          VFD    30/0LHY,24/0,1/1,2/0,3/3    800 BPI MT
          VFD    30/0LHD,24/0,1/1,2/2,3/3    800 BPI NT
          VFD    30/0LPE,24/0,1/1,2/2,3/4    1600 CPI NT
          VFD    30/0LGE,24/0,1/1,2/2,3/5    6250 CPI NT
          VFD    30/0LCE,24/0,1/1,2/1,3/6    38000 CPI CT
          VFD    30/0LAE,24/0,1/1,2/3,3/6    38000 CPI AT
          CON    0           END OF TABLE
 EVS      SPACE  4,10
**        EVS - PROCESS *AT* TAPE EXTERNAL VSN.
*
*         EVSN=EEEEEE.
 
 
 EVS      BSS    0           ENTRY
          RJ     CLP         GET VSN
          SX1    X1-1R=
          ZR     X1,ERR      IF ILLEGAL SEPARATOR
          SA1    F+11B
          MX0    -24
          BX6    -X0*X5
          BX1    -X0*X1
          NZ     X6,ERR      IF VSN .GT. 6 CHARACTERS
          BX6    X1+X5       SET EXTERNAL VSN IN LABEL FET
          SA6    A1
          EQ     BOP1        RETURN
 PVA      SPACE  4,10
**        PVA - PROCESS VOLUME ACCESSIBLITY.
*
*         VA=X.
 
 
 PVA      BSS    0           ENTRY
          SA0    VBUF+2
          SB3    0
          EQ     PSC         PROCESS SINGLE CHARACTER
 OFA      SPACE  4,10
**        OFA - PROCESS OLD FILE ACCESSIBILITY (FA CURRENTLY ON TAPE).
*
*         OFA=X.
 
 
 OFA      BSS    0           ENTRY
          SA0    F+9
          SB3    24
          EQ     PSC         PROCESS SINGLE CHARACTER
 PFA      SPACE  4,10
**        PFA - PROCESS FILE ACCESSIBILITY.
*
*         FA=X.
 
 
 PFA      BSS    0           ENTRY
          SA0    HBUF+6
          SB3    42
          EQ     PSC         PROCESS SINGLE CHARACTER
 LSL      SPACE  4,10
**        LSL = PROCESS LABEL STANDARD LEVEL.
*
*         LSL=A.
 
 
 LSL      BSS    0           ENTRY
          SA0    VBUF+10B
          SB3    6
*         EQ     PSC         PROCESS SINGLE CHARACTER
 PSC      SPACE  4,10
**        PSC - PROCESS SINGLE CHARACTER.
 
 
 PSC      BSS    0           ENTRY
          RJ     CLP         GET PARAMETER
          SX1    X1-1R=
          ZR     X1,ERR      IF ILLEGAL SEPARATOR
          MX0    6
          BX1    -X0*X5
          SA2    A0
          LX0    B3
          NZ     X1,ERR      IF MORE THAN ONE CHARACTER
          NZ     X5,PSC1     IF NOT NULL PARAMETER
          SX5    1R
          LX5    -6
 PSC1     LX5    B3          SET VALUE IN LABEL
          BX2    -X0*X2
          BX6    X2+X5
          SA6    A2
          EQ     BOP1        RETURN
 OWN      SPACE  4,10
**        OWN - PROCESS OWNER IDENTIFICATION.
*
*         OWNER=USERNUM/FAMILYN.
 
 
 OWN      BSS    0           ENTRY
          RJ     CLP         GET USER NUMBER
          MX0    -18
          SX1    X1-1R/
          BX7    -X0*X5
          NZ     X1,ERR      IF SEPARATOR NOT */*
          NZ     X7,ERR      IF USER NUMBER TOO LONG
          BX4    X5
          RJ     CLP         GET FAMILY NAME
          SX1    X1-1R=
          ZR     X1,ERR      IF ILLEGAL SEPARATOR
          BX7    -X0*X5
          NZ     X7,ERR      IF FAMILY NAME TOO LONG
          RJ     SOI         SET OWNER IDENTIFICATION
          JP     BOP1        RETURN
 PCV      SPACE  4,10
**        PCV - PROCESS CONVERSION MODE.
*
*         CV=MODE.
 
 
 PCV      BSS    0           ENTRY
          SB3    TCVM
          RJ     AOP         ANALYZE CONVERSION MODE OPTION
          SX1    X1-1R=
          ZR     X1,ERR      IF ILLEGAL SEPARATOR
          LX2    -12
          MX0    3
          SA3    F+10B       SET CONVERSION MODE IN FET
          LX0    -9
          BX3    -X0*X3
          BX2    X0*X2
          BX6    X3+X2
          SA6    A3
          EQ     BOP1        RETURN
 TCVM     SPACE  4,10
**        TCVM - TABLE OF CONVERSION MODE OPTIONS.
*
*T        30/OP,27/,3/CC
*
*         OP     1 - 5 CHARACTER CONVERSION MODE OPTION
*         CC     CONVERSION MODE CODE FOR FET
 
 
 TCVM     BSS    0
          VFD    30/0LAS,27/0,3/1  ASCII CONVERSION MODE
          VFD    30/0LUS,27/0,3/1  USASI (SAME AS ASCII)
          VFD    30/0LEB,27/0,3/2  EBCDIC CONVERSION MODE
          CON    0           END OF TABLE
 PDT      SPACE  4,10
**        PDT - PROCESS TAPE DEVICE TYPE SELECTION.
*
*         DT=TYPE
*         MT
*         NT
 
 
 PDT      BSS    0           ENTRY
          SB3    TDVT
          RJ     AOP         ANALYZE DEVICE TYPE OPTION
          SX1    X1-1R=
          ZR     X1,ERR      IF INCORRECT SEPARATOR
 
*         ENTRY FOR *MT* AND *NT* KEYWORDS.
 
 PDT1     SA1    EDT         GET PREVIOUS DEVICE TYPE SELECTION
          PL     X1,ERR      IF DEVICE TYPE PREVIOUSLY SPECIFIED
          MX0    -2
          BX6    -X0*X2      TAPE DEVICE TYPE
          SA6    A1+         SET DEVICE TYPE
          EQ     BOP1        RETURN
 TDVT     SPACE  4,10
**        TDVT - TABLE OF TAPE DEVICE TYPES.
*
*T        30/OP,28/,3/DT
*
*         OP     2 CHARACTER TAPE DEVICE TYPE MNEMONIC
*         DT     TAPE DEVICE TYPE FOR *LABEL* MACRO
 
 
 TDVT     BSS    0
          VFD    30/0LMT,28/0,2/0
          VFD    30/0LNT,28/0,2/2
          VFD    30/0LCT,28/0,2/1
          VFD    30/0LAT,28/0,2/3
          CON    0
 UNL      SPACE  4,10
**        UNL - PROCESS UNLOAD AFTER BLANKING.
*
*         U
 
 
 UNL      BSS    0           ENTRY
          MX0    1           CLEAR INHIBIT UNLOAD
          SA1    F+10B
          LX0    -18
          BX6    -X0*X1
          SA6    A1
          EQ     BOP1        RETURN
 VSN      SPACE  4,10
**        VSN - PROCESS VOLUME SERIAL NUMBER.
*
*         VSN=AAAAAA.
 
 
 VSN      BSS    0           ENTRY
          RJ     CLP         GET VSN
          SX1    X1-1R=
          ZR     X1,ERR      IF ILLEGAL SEPARATOR
          MX0    -24
          SA2    VSNA
          MX1    0
          BX7    X5-X2
          ZR     X7,VSN1     IF VSN=SCRATCH
          SA2    A2+B1
          BX7    X5-X2
          ZR     X7,VSN1     IF VSN=0
          BX2    -X0*X5
          NZ     X2,ERR      IF VSN .GT. 6 CHARACTERS
          BX1    X5
          MX0    -6          CHECK IF VSN IS A LEGAL FILE NAME
 VSN0     LX5    6
          BX3    -X0*X5
          SX2    X3-1R+
          PL     X2,VSN1     IF NOT ALPHANUMERIC
          NZ     X3,VSN0     IF MORE CHARACTERS TO CHECK
          SA2    F
          MX0    -18
          BX3    -X0*X2
          BX6    X3+X1       SET VSN INTO FET
          SA6    A2
 VSN1     MX0    -24         RESTORE VSN MASK
          RJ     SFN         SPACE FILL VSN
          BX6    X0*X6
          SA1    VBUF+1      ENTER VSN
          LX1    -36
          BX1    -X0*X1
          BX7    X6+X1
          LX7    36
          SA7    A1
          EQ     BOP1        RETURN
 
 VSNA     VFD    60/0LSCRATCH      SCRATCH VSNS
          VFD    60/0L0
          SPACE  4,10
**        GLOBAL DATA.
 
 
 EDT      CON    -1          EXPLICITLY SPECIFIED DEVICE TYPE
 DDT      CON    -1          DEVICE TYPE IMPLICITLY SET BY DENSITY
          TITLE  COMMON DECKS.
*         COMMON DECKS.
 
 
*CALL     COMCCIO
*CALL     COMCCPM
*CALL     COMCLFM
*CALL     COMCMVE
 RCC      SET    1           DEFINE COMMAND READ AHEAD
 LIT      CON    0           DEFINE LITERAL PROCESSING
*CALL     COMCPOP
*CALL     COMCRDW
*CALL     COMCSFN
*CALL     COMCSYS
*CALL     COMCUSB
          TITLE  BUFFERS.
*         FETS.
 
 
 F        BSS    0           FET
 BLKTAPE  FILEC  BUF,BUFL,(FET=14),EPR
          SPACE  4,10
**        VOLUME AND HEADER BUFFERS.
 
 VBUF     BSS    0           VOL1 BUFFER
          VFD    5/0,1/1,18/8,12/0,24/40  CONTROL WORD
 VOL1     BSS    0           VOLUME HEADER LABEL
          DATA   10HVOL1
          DATA   10H
          DATA   10H
          DATA   10H
          DATA   10H
          DATA   10H
          DATA   10H
          DATA   10H         1
          VFD    12/0,48/0   CONTROL WORD
 
 
 HBUF     BSS    0           HDR1 / EOF1 BUFFER
          VFD    5/0,1/1,18/8,12/0,24/40  CONTROL WORD
 HDR      BSS    0           FIRST FILE HEADER / FIRST EOF LABEL
          VFD    24/0,36/1H
          DATA   10H
          DATA   10H       000
          DATA   10H1000100010
          DATA   10H0
          DATA   10H    000000
          DATA   10HNOS   "VERNUM"-
          DATA   10H
          VFD    12/0,48/0   CONTROL WORD
 
 
 EOT      BSS    0           TAPE MARK CONTROL WORDS
          VFD    5/0,1/1,18/8,12/0,24/0
          VFD    12/17B,48/0
 
 
 HDR1     VFD    24/4HHDR1,36/0
 EOF1     VFD    24/4HEOF1,36/0
          SPACE  4,10
**        DEFAULT TAPE DESCRIPTORS.
 
 
 DTD      VFD    12/0,12/60B,6/3,6/0,24/0  DEFAULT TAPE DESCRIPTORS
 DBS      VFD    30/0,6/0,6/0,18/8  DEFAULT BLOCK SIZE
 
*                UNLABELED.
*                INHIBIT UNLOAD.
*                ENFORCE RING IN.
*                S (STRANGER) FORMAT.
*                8 WORD (80 CHARACTER) BLOCKS.
 SSJ      SPACE  4,10
**        SSJ PARAMETERS.
 
 
 SSJ=     BSS    0           DEFINE SSJ= ENTRY POINT
          VFD    12/0,24/-0,12/RXCS,12/IRSI
          VFD    42/0LSYSTEMX,18/377777B
          BSSZ   /COMSSSJ/SSJL-2
          SPACE  4,10
**        BUFFER AREA.
 
 
          USE    //
 BUF      EQU    *
 BUFF     EQU    BUF+BUFL
 RFL=     EQU    BUFF+BUFFL
 ARG=     EQU    *
          END