BLANK 
          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 
