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