IDENT VERIFY,FETS
ABS
ENTRY VERIFY
ENTRY RFL=
ENTRY SSM=
SYSCOM B1 DEFINE (B1) = 1
SPACE 4,10
TITLE VERIFY - VERIFY FILES.
*COMMENT VERIFY - VERIFY FILES.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
SPACE 4,10
***** VERIFY - VERIFY FILES.
*
* G. R. MANSFIELD. 70/12/20.
*
* J. L. LARSON. 77/03/16.
*
* VERIFY EQUALITY OF RECORDS AND FILES ON TWO MEDIA,
* WORD BY WORD.
SPACE 4,10
*** VERIFY COMPARES RECORDS ON TWO MEDIA FOR EQUALITY WORD
* BY WORD. WHEN AN ERROR IS DETECTED THE RECORD NUMBER, WORD
* NUMBER, AND THE DATA FROM EACH MEDIA ARE LISTED ON THE
* OUTPUT FILE. THE LOGICAL DIFFERENCE WILL ALSO BE LISTED ON
* THE OUTPUT FILE IF THE OUTPUT FILE IS NOT ASSIGNED TO AN
* INTERACTIVE TERMINAL.
SPACE 4,10
*** CONTROL CARD CALL.
*
*
* VERIFY (FILE1,FILE2,P1,P2,...,PN)
*
* FILE1 FIRST FILE NAME.
*
* FILE2 SECOND FILE NAME.
*
* PN ANY OF FOLLOWING IN ANY ORDER.
*
* N=X VERIFY X FILES.
* IF X = 0, VERIFY WILL TERMINATE ON AN
* EMPTY FILE FROM EITHER MEDIA.
*
* N VERIFY TO EOI.
*
* E=X LIST FIRST X DATA ERRORS.
*
* L=FNAME LIST ON FILE *FNAME*.
*
* A ABORT IF ERRORS OCCUR.
*
* R REWIND BOTH FILES BEFORE AND AFTER VERIFY.
*
* C CODED MODE SET ON BOTH FILES.
*
* C1 CODED MODE SET ON FILE 1 ONLY.
*
* C2 CODED MODE SET ON FILE 2 ONLY.
*
* BS=BSIZE MAXIMUM BLOCK SIZE IN CM WORDS.
* APPLIES ONLY TO S AND L FORMAT TAPES.
*
* ASSUMED PARAMETERS.
* FILE1 = *TAPE1*
* FILE2 = *TAPE2*
* N=1
* E=100
* L=*OUTPUT*
* A NOT PRESENT (PROCESS ERRORS)
* R NOT PRESENT (NO REWIND)
* C, C1, C2 NOT PRESENT (BINARY)
* BS = 1000B FOR S FORMAT TAPE.
* BS = 2000B FOR L FORMAT TAPE.
SPACE 4,10
*** DAYFILE MESSAGES.
*
*
* * FILE NOT FOUND - LFN.* = WARNING MESSAGE INDICATING THAT
* LFN DID NOT EXIST PRIOR TO VERIFY.
*
* * FILE STRUCTURES NOT COMPATIBLE.* = WARNING MESSAGE ISSUED
* BEFORE VERIFICATION BEGINS, TO INDICATE THAT THE RESULTS
* OF THE VERIFY ARE NOT GUARANTEED SINCE THE LOGICAL
* STRUCTURES OF THE FILES BEING COMPARED ARE NOT COMPATIBLE.
*
* * VERIFY ARGUMENT ERROR.* = CONTROL CARD CONTAINS ILLEGAL
* PARAMETER.
*
* * VERIFY COMPLETE.* = VERIFY OPERATION COMPLETED WITH NO
* ERRORS.
*
* * VERIFY ERRORS.* = ERRORS DETECTED DURING VERIFY.
*
* * VERIFY FILE NAME CONFLICT - LFN.* = REQUESTED FILE NAMES
* THE SAME.
*
* * VERIFY FL ABOVE USER LIMIT.* = FIELD LENGTH REQUIRED
* TO PROCESS L OR F TAPE VERIFY EXCEEDS USERS CURRENT
* MAXIMUM FL.
SPACE 4,10
**** ASSEMBLY CONSTANTS.
BUFL EQU 4000B WORKING BUFFER LENGTH = MAX PRUSIZE (OD)
OBUFL EQU 1001B OUTPUT FILE BUFFER LENGTH
FBUFL EQU 30061B VERIFY FILES BUFFER LENGTH
FETODL EQU 16 OPTICAL DISK FET EXTENSION BUFFER
DSPS EQU 1000B DEFAULT S TAPE PRU SIZE
DLPS EQU 2000B DEFAULT L TAPE PRU SIZE
MSPS EQU 1000B MAXIMUM S TAPE PRU SIZE
MFLF EQU 70000B-2 MAXIMUM FIELD LENGTH FACTOR
****
* SPECIAL ENTRY POINT.
SSM= EQU 0 SUPPRESS DUMPS OF FIELD LENGTH
READW SPACE 4,10
** READW - REDEFINE READ WORDS MACRO TO USE CONTROL WORDS.
PURGMAC READW
READW MACRO F,S,N
R= B6,S
R= B7,N
R= X2,F
RJ RDA
ENDM
SPACE 4
*CALL COMCMAC
*CALL COMCCMD
*CALL COMSLFM
QUAL MTX
*CALL COMSMTX
QUAL *
*CALL COMSSRT
TITLE STORAGE ASSIGNMENTS.
* FETS.
ORG 110B
FETS BSS 0
O BSS 0
OUTPUT FILEC OBUF,OBUFL,(FET=8)
* INDEX TAGS FOR WORDS PRECEEDING FILE 1 AND FILE 2 FETS.
EFF EQU 8 EMPTY FILE FLAG
LWD EQU 7 LWA+1 DATA TRANSFERRED TO WORKING BUFFER
RST EQU 6 LAST READ STATUS
CWF EQU 5 CONTROL WORD FLAG
SLF EQU 4 S, L, OR F TAPE FLAG
UBC EQU 3 UNUSED BIT COUNT
WRB EQU 2 WORDS REMAINING IN BLOCK
ERF EQU 1 EOR FLAG
CON 0 ZERO IF EMPTY FILE ENCOUNTERED ON FILE 1
CON 0 LWA+1 DATA IN WORKING BUFFER FOR FILE 1
CON 0 FILE 1 LAST READ STATUS
CON 0 NONZERO IF CONTROL WORDS ENABLED ON FILE 1
CON 0 1= S TAPE, 2= L TAPE, -1= F TAPE, 0= OTHER
CON 0 UNUSED BIT COUNT FOR FILE 1 BLOCK
CON 0 WORDS REMAINING IN FILE 1 BLOCK
CON 0 EOR FLAG
F1 BSS 0
TAPE1 FILEB BUF1,FBUFL,(FET=9)
BSSZ FETODL TAPE1 OD FET EXTENSION BUFFER
CON 0 ZERO IF EMPTY FILE ENCOUNTERED ON FILE 2
CON 0 LWA+1 DATA IN WORKING BUFFER FOR FILE 2
CON 0 FILE 2 LAST READ STATUS
CON 0 NONZERO IF CONTROL WORDS ENABLED ON FILE 2
CON 0 1= S TAPE, 2= L TAPE, -1= F TAPE, 0= OTHER
CON 0 UNUSED BIT COUNT FOR FILE 2 BLOCK
CON 0 WORDS REMAINING IN FILE 2 BLOCK
CON 0 EOR FLAG
F2 BSS 0
TAPE2 FILEB BUF2,FBUFL,(FET=9)
BSSZ FETODL TAPE2 OD FET EXTENSION BUFFER
SPACE 4
* COMMON DATA.
EC CON 0 ERROR COUNT
EL CON 0L100 ERROR LIMIT
FC CON 0L1 FILE COUNT
DFN CON 0 DISPLAY FILE NUMBER
EOIF CON 0 NONZERO IF EOI ENCOUNTERED ON EIHER FILE
AB CON 0 ABORT FLAG
RW CON 0 REWIND FLAG
FN CON 1 FILE NUMBER
RN CON 1 RECORD NUMBER
ER CON 0 WORD NUMBER
CON 0 WORD FROM FILE 1
CON 0 WORD FROM FILE 2
CON 0 LOGICAL DIFFERENCE
TY CON 0 RECORD TYPE FROM FILE 1
CON 0 RECORD TYPE FROM FILE 2
* LIST DATA.
LC CON 99999,0 LINE COUNTER
LL EQU LC+1 LINE LIMIT - PAGE SIZE
PD CON 0 PRINT DENSITY
PN CON 1 PAGE NUMBER
PW CON 0 PAGE WIDTH
TITL DATA 50H VERIFY ERROR LIST.
DATE DATA 1H
TIME DATA 1H
DATA 30H
DATA 4APAGE
PAGE DATA 8L
TITLL EQU *-TITL
TITSL EQU TITLL-5 SHORT TITLE LENGTH
SBTL DATA 10H RECORD
DATA 10HWORD
DATA 10HDATA FROM
F1NM DATA 20H
DATA 10HDATA FROM
F2NM DATA 10H
DATA 2ALO
DATA 20CGICAL DIFFERENCE
DATA 2L
SBTLL EQU *-SBTL
SBTSL EQU SBTLL-5 SHORT SUBTITLE LENGTH
VERIFY TITLE MAIN PROGRAM.
** VERIFY - MAIN PROGRAM.
VERIFY SB1 1 (B1) = 1
RJ PRS PRESET PROGRAM
RECALL F1
RECALL F2
SA3 PW
ZR X3,VFY1 IF TERMINAL FILE
WRITEC O,PD WRITE PRINT DENSITY FORMAT CONTROL
VFY1 BX6 X6-X6 CLEAR EMPTY FILE FLAGS
SX7 B1 INITIALIZE RECORD NUMBER
SA6 F1-EFF
SX0 B0+ INDICATE INITIAL READ
SA6 F2-EFF
SA7 RN
SA6 LEWA CLEAR ERROR LINE RECORD NUMBER
VFY2 SX2 F1 INITIATE READ FUNCTION ON FILE 1
RJ IRF
SX2 F2 INITIATE READ FUNCTION ON FILE 2
RJ IRF
SX7 B0+ CLEAR WORD COUNT
SA7 ER
READW F1,SBF1,BUFL
SX4 X1+B1
ZR X4,VFY3 IF EOF ON FILE 1
SX7 B1+ INDICATE NOT EMPTY FILE
SA7 F1-EFF
VFY3 READW F2,SBF2,BUFL
SA3 F1-RST
SX4 X1+B1
ZR X4,VFY4 IF EOF ON FILE 2
SX7 B1 INDICATE NOT EMPTY FILE
BX4 X1+X3
SA7 F2-EFF
NG X4,VFY4 IF EOF OR EOI ON EITHER FILE
RJ SRM SEND RECORD MESSAGE
RJ CPR COMPARE RECORDS
SA1 RN ADVANCE RECORD NUMBER
SX0 B1 INDICATE NON-INITIAL READ
SX6 X1+B1
SA6 A1
EQ VFY2 CONTINUE RECORD COMPARISONS
* PROCESS EXCESS RECORDS OR FILES.
VFY4 SA4 EOIF CHECK EOI ENCOUNTERED FLAG
SA0 F2
SX4 X4-F1
SX2 SBF2
ZR X4,VFY6 IF EXTRA FILES ON FILE 2
PL X4,VFY5 IF EXTRA FILES ON FILE 1
BX6 X1*X3
NG X6,VFY7 IF EOF OR EOI ON BOTH FILES
NG X3,VFY6 IF EXTRA RECORDS ON FILE 2
VFY5 SA0 F1
SX2 SBF1
BX1 X3
VFY6 RJ EXR PROCESS EXCESS RECORDS OR FILES
* CHECK FOR EOI.
VFY7 SA1 F1-RST CHECK FILE STATUS
SA2 F2-RST
SX1 X1+B1
SX2 X2+B1
BX3 X1*X2
BX4 X1+X2
NG X3,VFY11 IF EOI ENCOUNTERED ON BOTH FILES
PL X4,VFY9 IF EOF ENCOUNTERED ON BOTH FILES
SA3 EOIF
NZ X3,VFY9 IF EOI PREVIOUSLY ENCOUNTERED
SX6 F1 SET EOI ENCOUNTERED FLAG
NG X1,VFY8 IF EOI ON FILE 1
SX6 F2
VFY8 SA6 A3
SA1 EXRG BUILD EXCESS FILE LINE
SA2 A1+B1
BX6 X1
SA6 EXRD
LX7 X2
SA7 A6+B1
SA3 =1H CLEAR FILE NUMBER FROM TITLE LINE
BX7 X7-X7 CLEAR SUBTITLE LINE
LX6 X3
SA7 SBTL
SX7 99999 FORCE PAGE EJECT
SA7 LC
* CHECK FOR VERIFY COMPLETE.
VFY9 RJ EOF PROCESS END OF FILE
SA1 FC
ZR X1,VFY10 IF EMPTY FILE REQUEST
SX2 B1 DECREMENT FILE COUNT
IX6 X1-X2
SA6 A1+
ZR X6,VFY11 IF FILE COUNT EXHAUSTED
EQ VFY1 CONTINUE VERIFY
VFY10 SA1 F1-EFF CHECK FOR EMPTY FILE
SA2 F2-EFF
BX1 X1*X2
NZ X1,VFY1 IF NO EMPTY FILE ENCOUNTERED
* PROCESS REWIND REQUEST, ISSUE COMPLETION MESSAGE,
* AND END OR ABORT.
VFY11 SA1 RW
ZR X1,VFY12 IF NO REWIND
REWIND F1
REWIND F2
VFY12 SA1 EC
NZ X1,VFY14 IF ERRORS DETECTED
MESSAGE (=C* VERIFY GOOD.*)
VFY13 ENDRUN
VFY14 WRITER O FLUSH OUTPUT BUFFER
MESSAGE (=C* VERIFY ERRORS.*)
SA1 AB
ZR X1,VFY13 IF ABORT NOT REQUESTED
ABORT
TITLE SUBROUTINES.
CPR SPACE 4,10
** CPR - COMPARE RECORDS.
*
* ENTRY (F1-RST) = FILE 1 READ STATUS.
* (F2-RST) = FILE 2 READ STATUS.
* (F1-LWD) = LWA+1 DATA IN WORKING BUFFER FOR FILE 1.
* (F2-LWD) = LWA+1 DATA IN WORKING BUFFER FOR FILE 2.
*
* USES A - ALL.
* X - ALL.
*
* CALLS CDD, COD, LEW, WOF.
*
* MACROS READW.
CPR SUBR ENTRY/EXIT
CPR1 SA4 F1-LWD GET LWA+1 DATA FOR FILE 1
SA5 F2-LWD GET LWA+1 DATA FOR FILE 2
SX4 X4-SBF1 SET WORD COUNT FOR FILE 1
SX5 X5-SBF2 SET WORD COUNT FOR FILE 2
IX6 X4-X5
PL X6,CPR2 IF FILE 2 WORD COUNT .LE. FILE 1
SX5 X4 SET NUMBER OF WORDS TO COMPARE
CPR2 SA6 CPRA SAVE WORD COUNT DIFFERENCE
ZR X5,CPR6 IF NO DATA TO COMPARE
SA0 B0+ INITIALIZE WORD INDEX
* COMPARE DATA WORDS.
CPR3 SA1 SBF1+A0 COMPARE FILE 1 AND FILE 2 DATA WORDS
SA2 SBF2+A0
BX6 X1-X2
NZ X6,CPR4 IF NO MATCH
PL X6,CPR5 IF MATCH
CPR4 SA6 ER+3 STORE DIFFERENCE
BX7 X2 STORE WORD 2
LX6 X1 STORE WORD 1
SA7 A6-B1
SA6 A7-B1
RJ LEW LIST ERROR WORDS
CPR5 SA1 ER ADVANCE WORD NUMBER
SX2 B1
IX7 X1+X2
SA0 A0+B1 ADVANCE WORD INDEX
IX5 X5-X2 DECREMENT WORD COUNT
SA7 A1
NZ X5,CPR3 IF MORE WORDS TO COMPARE
CPR6 SA5 CPRA GET WORD COUNT DIFFERENCE
NZ X5,CPR7 IF EXCESS WORDS
SA1 F1-RST GET FILE 1 READ STATUS
NZ X1,CPR11 IF EOR/EOF/EOI ENCOUNTERED ON BOTH FILES
READW F1,SBF1,BUFL
READW F2,SBF2,BUFL
EQ CPR1 CONTINUE PROCESSING DATA IN RECORD
* PROCESS EXCESS WORDS.
CPR7 SX2 F1
SX0 B0+
PL X5,CPR8 IF FILE 1 RECORD LONGER
SX2 F2
BX5 -X5
CPR8 SA1 X2-RST CHECK FILE LAST READ STATUS
NZ X1,CPR10 IF EOR/EOF/EOI ENCOUNTERED
CPR9 IX5 X5+X0 COUNT EXCESS WORDS
READW X2,SBF1,BUFL
SX0 BUFL
ZR X1,CPR9 IF NOT EOR
SX0 B6-SBF1
IX5 X5+X0
CPR10 SA1 X2 SPACE FILL NAME
MX0 42
BX6 X0*X1
SX1 X5 CONVERT WORD COUNT
SA6 CPRE
RJ COD
SA6 CPRD+1
SA1 RN CONVERT RECORD NUMBER
RJ CDD
LX6 30
SA1 EC ADVANCE ERROR COUNT
SA6 CPRD
SX7 X1+B1
SA7 A1
SX2 CPRL
SX1 A6 LIST ERROR LINE
RJ WOF
* CHECK FOR NONSTANDARD RECORD COMPARED WITH STANDARD RECORD.
CPR11 SA2 F1-RST CHECK FILE 1 LAST READ STATUS
SA3 F2-RST CHECK FILE 2 LAST READ STATUS
MX0 42
BX3 X2-X3
PL X3,CPRX IF MATCHING RECORD STRUCTURE
SA1 F1
SA3 EC
NG X2,CPR12 IF NONSTANDARD RECORD ON FILE 1
SA1 F2
CPR12 BX6 X0*X1 SET FILE NAME IN MESSAGE
SX7 X3+B1 ADVANCE ERROR COUNT
SA6 CPRC
SA7 A3
SA1 RN CONVERT RECORD NUMBER
RJ CDD
LX6 30
SA6 CPRB
SX1 CPRB LIST ERROR LINE
SX2 CPRL
RJ WOF
EQ CPRX RETURN
CPRA CON 0 WORD COUNT DIFFERENCE
CPRB DATA 1H
DATA 1H
DATA 20H EOR MISSING ON
CPRC DATA 1H
CPRD DATA 1H
DATA 1H
DATA 20H EXCESS WORD(S) ON
CPRE DATA 1H
CPRL EQU *-CPRD
EOF SPACE 4,10
** EOF - PROCESS END OF FILE.
*
* USES A - 1, 6, 7.
* X - 1, 6, 7.
*
* CALLS CDD.
EOF SUBR ENTRY/EXIT
SA1 FN ADVANCE FILE NUMBER
SX6 X1+B1
SA6 A1
SX1 X6 CONVERT NUMBER
RJ CDD
SA1 =10HVERIFYING
LX6 5*6
BX7 X1
SA7 SRMA
SB2 B2-B1 CLEAR BLANK FILL FROM FILE NUMBER
MX7 1
AX7 B2
BX7 X7*X4
SA1 EOIF
SA7 DFN SAVE DISPLAY FILE NUMBER
NZ X1,EOFX IF EOI ENCOUNTERED
SX7 99999 FORCE PAGE EJECT
SA7 LC
EQ EOFX RETURN
EXR SPACE 4,15
** EXR - PROCESS EXCESS RECORDS.
*
* ENTRY (A0) = FET ADDRESS.
* (X2) = BUFFER ADDRESS.
* (X1) = FILE READ STATUS.
*
* USES A - 1, 2, 3, 4, 6, 7.
* B - 2, 5.
* X - ALL.
*
* CALLS CDD, CIO=, RDA, SFN, SNM, SRT, SYS=, WOF.
*
* MACROS MESSAGE, READ, READW.
EXR5 SA1 RN
ZR X5,EXR6 IF NO DATA TRANSFERRED
SX1 X1+B1 INCREMENT RECORD COUNT
EXR6 RJ CDD CONVERT RECORD COUNT TO DISPLAY
SA6 EXRC
SA1 A0+ ADD FILE NAME
MX2 42
SX3 1R
BX6 X2*X1
SA4 EOIF
BX6 X6+X3
LX6 -6
SA6 EXRE
ZR X4,EXR7 IF EOI NOT ENCOUNTERED ON EITHER FILE
SA1 EXRH
SA6 EXRF
SA2 A1+B1
BX6 X1
SA6 EXRE
LX7 X2
SA7 A6+B1
SA1 DFN GET DISPLAY CODE FILE NUMBER
SB2 1RZ
SB5 EXRB
RJ SNM ENTER FILE NUMBER INTO MESSAGE
EXR7 SX1 EXRB
SA3 PW
NZ X3,EXR8 IF NOT SHORT FORMAT
SA4 EXRB
MX3 6
BX6 -X3*X4
SA3 =1L
BX6 X3+X6
SA6 A4
EXR8 RJ WOF WRITE EXCESS RECORDS/FILE LINE
EXR SUBR ENTRY/EXIT
SA3 EC ADVANCE ERROR COUNT
BX7 X7-X7 CLEAR EXCESS RECORD COUNT
SX6 X3+B1
SA7 RN
SA6 A3
BX5 X5-X5 CLEAR DATA TRANSFERRED FLAG
SX0 B1 SET PREVIOUS EOR FLAG
EQ EXR3 DISPLAY RECORD NAME
EXR1 SA4 RN INCREMENT RECORD COUNT
BX5 X5-X5 CLEAR DATA TRANSFERRED FLAG
SX6 X4+B1
SA3 A0-CWF
SA6 A4+
NZ X3,EXR2 IF CONTROL WORDS ENABLED
READ A0
EXR2 READW A0,SBF1,BUFL
SX2 SBF1
EXR3 NG X1,EXR5 IF EOF OR EOI ENCOUNTERED
SB5 X1 SAVE CURRENT READ STATUS
SX5 B1 INDICATE DATA TRANSFERRED
ZR X0,EXR4 IF PREVIOUS READ NOT EOR
SA1 A0-LWD LWA+1 OF DATA READ
RJ SRT SET RECORD TYPE
SA7 EXRA+1
MESSAGE A7-B1,B1 DISPLAY RECORD NAME
EXR4 SX0 B5
ZR X0,EXR2 IF NOT EOR
EQ EXR1 INCREMENT RECORD COUNT
EXRA DATA 10H READING
CON 0
EXRB DATA 10H0 *****
EXRC CON 0
EXRD DATA 20H EXCESS RECORD(S) ON
EXRE CON 0,0
EXRF CON 0
EXRG DATA 20H RECORD(S) IN EXCESS
EXRH DATA 20H FILE ZZZZZZZZZZZ ON
IRF SPACE 4,15
** IRF - INITIATE READ FUNCTION.
*
* IF EOI STATUS IS DETECTED ON THIS FILE, NO FURTHER READ
* FUNCTION IS INITIATED. IF CONTROL WORDS ARE ALLOWED OR IF
* EOF STATUS IS DETECTED, NO FURTHER READ IS INITIATED UNLESS
* AN INITIAL READ IS REQUESTED (INDICATES PREVIOUS EOF HAS
* BEEN PROCESSED).
*
* ENTRY (X2) = FWA FET.
* (X0) = 0, IF INITIAL READ.
*
* USES A - 1, 3, 6.
* X - 1, 3, 6.
*
* CALLS CIO=.
IRF1 PL X3,IRF2 IF NOT EOF
NZ X0,IRFX IF NOT INITIAL READ
IRF2 READ X2
IRF SUBR ENTRY/EXIT
SA3 X2
SA1 X2-CWF CONTROL WORD FLAG
LX3 59-9 CHECK FOR EOI
MX6 1
NG X3,IRFX IF EOI ENCOUNTERED
LX3 59-3-59+9 CHECK FOR EOF
ZR X1,IRF1 IF CONTROL WORDS DISABLED
NZ X0,IRFX IF NOT INITIAL READ
SA6 X2-WRB SET FIRST READ FLAG
READCW X2,17B
EQ IRFX RETURN
LEW SPACE 4,15
** LEW - LIST ERROR WORDS.
*
* ENTRY (RN) = RECORD NUMBER.
* (ER) = WORD NUMBER.
* (ER+1) = WORD FROM FILE 1.
* (ER+2) = WORD FROM FILE 2.
* (ER+3) = LOGICAL DIFFERENCE.
*
* USES A - 1, 2, 3, 6, 7.
* B - 7.
* X - 1, 2, 3, 4, 6, 7.
*
* CALLS CDD, COD, UPN, UPW, WOF.
*
* MACROS MOVE.
LEW SUBR ENTRY/EXIT
SA2 EL
SA3 EC
ZR X2,LEW4 IF ERROR LIMIT ZERO
IX6 X3-X2
PL X6,LEWX IF ERROR LIMIT EXCEEDED
SA1 RN CHECK RECORD CHANGE
SA2 LEWA
BX6 X1-X2
ZR X6,LEW3 IF NO CHANGE
BX6 X1
SA6 A2 SET NEW RECORD
SA3 LC CHECK LINE COUNT
SX7 X3+5
SA1 A3+B1 GET LINE LIMIT
IX7 X7-X1
NG X7,LEW1 IF NOT BOTTOM OF PAGE
SX7 99999 FORCE EJECT
SA7 A3
EQ LEW2
LEW1 SX1 =C* *
RJ WOF
SX1 =C* *
RJ WOF
LEW2 SA1 SRMB PRINT RECORD NAME
SA2 A1+B1
SA3 =3R
MX4 -18
LX1 18
LX2 18
BX6 X4*X1
IX6 X6+X3
BX7 X4*X2
IX7 X7+X3
SA6 LEWB+3
SA7 LEWB+6
BX6 -X4*X1
BX7 -X4*X2
SA1 TY PRINT TYPE
SA2 A1+B1
SA1 X1+LEWC
SA2 X2+LEWC
IX6 X6+X1
IX7 X7+X2
SA6 A6-B1
SA7 A7-B1
SX1 LEWB
RJ WOF
SX1 =C* *
RJ WOF
LEW3 SA1 RN CONVERT RECORD NUMBER
RJ CDD
SB7 CHAR
RJ UPN
SA1 ER CONVERT WORD NUMBER
RJ COD
SX7 1R
SA7 B7
SA7 A7+B1
SA7 A7+B1
SB7 A7+B1
RJ UPN
SA1 ER+1 UNPACK WORD FROM FILE 1
SA2 TY
RJ UPW
SA1 ER+2 UNPACK WORD FROM FILE 2
SA2 TY+1
SB7 B7-B1
RJ UPW
SX6 B7+
SA6 LEWL SAVE LENGTH OF SHORT LINE
SA1 ER+3 UNPACK LOGICAL DIFFERENCE
SA2 TY+1
RJ UPW
SA1 PW
ZR X1,LEW3.1 IF SHORT LINE
SX6 B7+ RESET LINE LENGTH
SA6 LEWL
LEW3.1 SX1 4
SX2 CHAR+6
SX3 CHAR+11D
MOVE X1,X2,X3 PACK RECORD NUMBER INTO WORD COUNT WORD
SX6 1RB INSERT OCTAL CHARACTER
SX3 CHAR+10D RESET FWA OF LINE
SA6 CHAR+23D
BX1 -X3 LIST LINE
SA2 LEWL
IX2 X2-X3
RJ WOF
LEW4 SA1 EC ADVANCE ERROR COUNT
SA2 EL
SX6 X1+B1
SA6 A1
ZR X2,LEWX IF ZERO ERROR LIMIT
IX7 X6-X2
NG X7,LEWX IF LIMIT NOT REACHED
SX1 =C+ ** ERROR LIMIT EXCEEDED **+
RJ WOF
SX1 =C* *
RJ WOF
EQ LEWX RETURN
LEWA DATA 0 RECORD NUMBER
LEWB DATA 10H
DATA 10H
DATA 0,0 RECORD NAME 1
DATA 20H
DATA 0,0 RECORD NAME 2
LEWC BSS 0
.E ECHO ,RT=("RTMIC")
.A IFC NE,/RT//
VFD 36/0A_RT,24/1L/
.A ELSE
VFD 36/3A ,24/1L/
.A ENDIF
.E ENDD
LEWL CON 0
RDA SPACE 4,20
** RDA - READ DATA.
* PROCESSES CALLS TO READ WORDS (RDW=).
* DEBLOCKS DATA IF CONTROL WORD READS.
*
* ENTRY (X2) = FWA FET.
* (B6) = FWA WORKING BUFFER.
* (B7) = NUMBER OF WORDS TO TRANSFER.
*
* EXIT (X1) = 0, IF TRANSFER COMPLETE.
* (X1) = -1, IF EOF DETECTED ON FILE.
* (X1) = -2, IF EOI DETECTED ON FILE.
* (X1) = (B6), IF EOR DETECTED BEFORE TRANSFER COMPLETE.
* (B6) = LWA+1 DATA TRANSFERRED TO WORKING BUFFER.
* ((X2)-RST) = (X1).
* ((X2)-LWD) = (B6).
*
* USES A - 1, 3, 4, 6, 7.
* B - 3, 4, 5, 6, 7.
* X - 1, 3, 4, 6, 7.
*
* CALLS RDW=.
RDA7 SX6 B5-B7 UPDATE WORDS REMAINING
SA6 A1
RDA8 RJ RDW= READ WORDS
SA3 X2-WRB
NZ X3,RDA10 IF MORE WORDS IN BLOCK
RDA9 SA4 X2-UBC
ZR X4,RDA10 IF NO UNUSED BIT COUNT
SB3 X4 CLEAR EXTRANEOUS DATA IN LAST WORD
MX6 1
SB4 B3-B1
AX6 B4
SA3 B6-B1 LAST WORD TRANSFERRED
LX6 B3
BX6 -X6*X3
SA6 A3
RDA10 BX6 X1 SAVE FILE READ STATUS
SX7 B6 SAVE LWA+1 DATA IN WORKING BUFFER
SA6 X2-RST
SA7 X2-LWD
RDA SUBR ENTRY/EXIT
SA1 X2-CWF
ZR X1,RDA8 IF CONTROL WORD READ DISABLED
RDA1 SA1 X2-WRB NUMBER OF WORDS BEFORE CONTROL WORD
SB5 X1+
PL X1,RDA2 IF NOT FIRST READ
SX7 B7+ SET WORDS NEEDED
SA7 RDAA
JP RDA4
RDA2 GE B5,B7,RDA7 IF ENOUGH DATA TO FILL BUFFER
SA3 X2-ERF CHECK EOR FLAG
PL X3,RDA3 IF NOT EOR ON FILE
MX6 1 SET NEW READ FLAG
SB7 B5+B1 SET WORDS TO READ
SA6 A3
SA6 A1
RJ RDW= READ WORDS
SA1 B6-B1 CHECK CONTROL WORD
AX1 48
SX6 X1-17B
MX1 -1
SB6 B6-B1 BACK UP LAST WORD ADDRESS
ZR X6,RDA10 IF *EOF* CONTROL WORD
SX1 B6 SET *EOR* INDICATION
EQ RDA9 CLEAR EXTRANEOUS DATA IN LAST DATA WORD
RDA3 SX6 B7-B5 SAVE ADDITIONAL WORDS NEEDED
SA6 RDAA
SB7 B5+B1 SET WORDS TO TRANSFER
RJ RDW= READ WORDS
SB6 B6-1 BACK UP OVER LAST CONTROL WORD
RDA4 SB7 B1 READ CONTROL WORD
RJ RDW=
NG X1,RDA10 IF EOF/EOI ENCOUNTERED
SB6 B6-B1 BACK UP WORKING BUFFER
SA1 B6 CONTROL WORD
* FOR MASS STORAGE AND WORD BOUNDARY FORMAT TAPES (ALL EXCEPT
* S, L, AND F FORMATS), UNUSED BIT COUNT IN CONTROL WORD HEADER
* IS ASSUMED ZERO AND BYTE COUNT SHOULD BE A MULTIPLE OF 5.
MX3 -24
BX7 -X3*X1 BYTE COUNT
SX3 4
LX4 X7
IX7 X7+X3 ROUND UP BYTE COUNT
SX3 X3+B1
IX7 X7/X3 WORD COUNT
MX3 -6
SA7 X2-WRB
LX1 -24
BX6 -X3*X1 UNUSED BIT COUNT (BASED ON BYTE)
SX3 5
IX3 X7*X3
IX4 X3-X4 UNUSED BYTES
ZR X4,RDA5 IF NO EXTRANEOUS DATA BYTES
SX3 12
IX3 X4*X3
IX6 X3+X6
RDA5 SA6 X2-UBC STORE UNUSED BIT COUNT
LX4 X6
SX6 -B1 INDICATE EOR
NZ X4,RDA6 IF EXTRANEOUS DATA IN LAST WORD
SA3 X2-SLF
LX1 -12
NZ X3,RDA6 IF S, L, OR F TAPE
SX1 X1 PRU SIZE
IX6 X7-X1 NO EOR IF FULL BLOCK
RDA6 SA6 X2-ERF SAVE EOR FLAG
SA1 RDAA RESET WORDS NEEDED
SB7 X1
EQ RDA1 LOOP
RDAA CON 0
SRM SPACE 4,10
** SRM - SEND RECORD MESSAGE.
*
* ENTRY (F1-LWD) = LWA+1 OF DATA IN FILE 1 BUFFER.
* (F2-LWD) = LWA+1 OF DATA IN FILE 2 BUFFER.
*
* USES A - 1, 6.
* X - 1, 2, 6.
*
* CALLS SFN, SRT, SYS=.
SRM SUBR ENTRY/EXIT
SA1 F1-LWD LWA+1 OF DATA IN FILE 1
SX2 SBF1
RJ SRT SET RECORD TYPE
SA6 TY
BX1 X7
RJ SFN SPACE FILL NAME
SA6 SRMB
SA1 F2-LWD LWA+1 OF DATA IN FILE 2
SX2 SBF2
RJ SRT SET RECORD TYPE
SA6 TY+1
BX1 X7
RJ SFN SPACE FILL NAME
SA6 SRMB+1
SA1 EC
ZR X1,SRM1 IF NO ERRORS
SA1 =0LERRORS.
BX6 X1
SA6 SRMC
SRM1 MESSAGE SRMA,1
EQ SRMX RETURN
SRMA DATA 10HVERIFYING
SRMB DATA 0,0
SRMC DATA 0
UPN SPACE 4,10
** UPN - UNPACK NAME.
*
* ENTRY (X6) = NAME LEFT JUSTIFIED.
* (B7) = CHARACTER ADDRESS.
*
* EXIT (B7) ADVANCED.
*
* USES A - 7.
* B - 2, 7.
* X - 1, 6, 7.
UPN SUBR ENTRY/EXIT
MX1 60-6
SB2 B7+10
LX6 6
UPN1 BX7 -X1*X6
ZR B7,UPNX IF END OF NAME
SA7 B7
SB7 B7+B1
LX6 6
NE B7,B2,UPN1 LOOP FOR 10 CHARACTERS
EQ UPNX RETURN
UPW SPACE 4,15
** UPW - UNPACK WORD.
*
* ENTRY (X1) = WORD.
* (B7) = CHARACTER ADDRESS.
* (X2) = RECORD TYPE.
*
* EXIT (B7) ADVANCED.
*
* USES A - 7.
* B - 2, 4, 5, 7.
* X - 0, 1, 2, 7.
UPW SUBR ENTRY/EXIT
SB2 X2
SX2 UPWA
LX2 48
LX2 X2,B2
SB5 4
SB4 5
PL X2,UPW1 IF TEXT TYPE
SB5 B4
SB4 B4-B1
UPW1 SX7 1R
SX7 1R
MX0 60-3
SA7 B7
SA7 A7+B1
SA7 A7+B1
SA7 A7+B1
SA7 A7+B1
UPW2 SB2 B5
UPW3 LX1 3
SB2 B2-B1
BX2 -X0*X1 CONVERT DIGIT
SX7 X2+1R0
SA7 A7+B1 STORE CHARACTER
NZ B2,UPW3 IF MORE DIGITS
SX7 1R
SB4 B4-B1
SA7 A7+B1 SPACE
NZ B4,UPW2 IF MORE BYTES
SB2 B5-4
ZR B2,UPW4 IF 5 GROUPS OF 4
SA7 A7+B1 SPACE
UPW4 SB7 A7+B1 ADVANCE CHARACTER ADDRESS
EQ UPWX RETURN
UPWA EQURT (RLRT,OVRT,ABRT),12
WOF SPACE 4,15
** WOF - WRITE LINE TO OUTPUT.
*
* ENTRY (X1) = FWA LINE.
* IF (X1) < 0, LINE IS *S* FORMAT.
* OTHERWISE LINE IS *C* FORMAT.
* (X2) = WORD COUNT.
*
* USES A - 1, 2, 3, 4, 6, 7.
* X - 1, 2, 3, 4, 6, 7.
* B - 7.
*
* CALLS CDD.
*
* MACROS WRITEC, WRITES, WRITEW.
WOF4 BX1 -X1
WRITES O,X1,X2
WOF SUBR ENTRY/EXIT
SA4 EL
ZR X4,WOFX IF ERROR LIMIT
SA3 LC ADVANCE LINE COUNT
SX6 X3+B1
SA6 A3
SA4 A3+B1 GET PAGE LENGTH
IX7 X6-X4
NG X7,WOF3 IF BOTTOM OF PAGE NOT REACHED
BX6 X1 SAVE REQUEST
LX7 X2
SA6 WOFA
SA7 A6+B1
SA1 PN ADVANCE PAGE NUMBER
SX7 X1+B1
SX6 3
SA6 A3
SA7 A1
RJ CDD CONVERT PAGE NUMBER
MX1 48
LX6 18 STORE PAGE NUMBER
BX6 X1*X6
SA6 PAGE
SA3 PW
ZR X3,WOF1 IF SHORT PAGE FORMAT
WRITEW O,(=1H1),1
WRITEC X2,TITL WRITE TITLE LINE
WRITEC X2,SBTL WRITE SUBTITLE LINE
WRITEW X2,(=1L ),1 WRITE BLANK LINE
EQ WOF2 RESTORE REQUEST
WOF1 SA3 PN
SB7 X3-2
NZ B7,WOF2 IF TITLE NOT ISSUED
WRITEW O,(=1L ),1 WRITE BLANK LINE
WRITEW X2,TITL,TITSL WRITE SHORT TITLE
WRITEC X2,(=C* *)
WRITEW X2,SBTL,SBTSL WRITE SHORT SUBTITLE
WRITEC X2,(=C* *)
WOF2 SA1 WOFA RESTORE REQUEST
SA2 A1+B1
WOF3 NG X1,WOF4 IF *S* FORMAT
WRITEC O,X1,X2
EQ WOFX RETURN
WOFA DATA 0,0
SPACE 4,10
** COMMON DECKS.
*CALL COMCCDD
*CALL COMCCIO
*CALL COMCCOD
*CALL COMCMVE
*CALL COMCRDW
*CALL COMCSFN
*CALL COMCSNM
*CALL COMCSRT
*CALL COMCSYS
*CALL COMCWTC
*CALL COMCWTS
*CALL COMCWTW
SPACE 4,10
** BUFFERS.
USE //
SEG
OBUF BSS 0 OUTPUT FILE CIO BUFFER
CHAR EQU OBUF+OBUFL CHARACTER STRING BUFFER
SBF1 EQU CHAR+136 FILE 1 WORKING BUFFER
SBF2 EQU SBF1+BUFL+1 FILE 2 WORKING BUFFER
BUF1 EQU SBF2+BUFL FILE 1 CIO BUFFER
BUF2 EQU BUF1+FBUFL FILE 2 CIO BUFFER
RFL= EQU BUF2+FBUFL+4 FIELD LENGTH
TITLE PRESET.
PRS SPACE 4,10
** PRS - PROCESS ARGUMENTS.
*
* ENTRY NONE
*
* EXIT (PW) .EQ. ZERO IF SMALL PAGE WIDTH
* .NE. ZERO IF STANDARD PAGE WIDTH.
*
* USES A - ALL.
* B - 4, 5, 7.
* X - ALL.
*
* CALLS ARG, CBS, CDT, DXB, PCM, RLF, SFN, STF.
*
* MACROS CLOCK, DATE, GETPP, MEMORY, MESSAGE, REWIND.
PRS SUBR ENTRY/EXIT
DATE DATE
CLOCK TIME
MEMORY ,,,RFL= SET FIELD LENGTH
SA1 ACTR CHECK ARGUMENT COUNT
SB4 X1
MX0 42
ZR B4,PRS3 IF NO ARGUMENTS
SA4 ARGR
BX7 X0*X4
SB4 B4-B1
SX2 3
ZR X7,PRS1 IF FIRST ARGUMENT NULL
IX7 X7+X2
SA7 F1
PRS1 ZR B4,PRS3 IF END OF ARGUMENTS
SA4 A4+B1
BX7 X0*X4
ZR X7,PRS2 IF SECOND ARGUMENT NULL
IX7 X7+X2
SA7 F2
PRS2 SB4 B4-B1
ZR B4,PRS3 IF END OF ARGUMENTS
SA4 A4+B1 CONVERT SPECIAL ARGUMENTS
SB5 PRSA
RJ ARG
NZ X1,PER2 IF ARGUMENT ERROR
PRS3 SA5 FC CHECK FILE COUNT
SB7 B1+ DECIMAL CONVERSION
RJ DXB
SA6 FC STORE VALUE
NZ X4,PER2 IF ASSEMBLY ERROR
SA1 O
SX6 B1
SX2 A1
ZR X1,PRS4 IF NO FILE NAME IN FET
RJ STF SET TERMINAL FILE
PRS4 SA6 PW SET PAGE WIDTH
GETPP *,LL,PD GET PAGE SIZE PARAMETERS
SA5 EL CONVERT ERROR LIMIT
RJ DXB
SA6 EL STORE VALUE
NZ X4,PER2 IF ASSEMBLY ERROR
RJ PCM PROCESS CODED MODE PARAMETER
SA1 F1 COMPARE FILE NAMES
SA2 F2
MX0 42
BX1 X0*X1
SA3 O
BX2 X0*X2
IX6 X1-X2
SX5 PERB * VERIFY FILE NAME CONFLICT - LFN.*
ZR X6,PER3 IF FILE 1 = FILE 2
BX3 X0*X3
IX4 X3-X1
BX7 X3-X2
ZR X4,PER3 IF O = FILE 1
BX0 X1
LX1 X2
ZR X7,PER3 IF O = FILE 2
RJ SFN SPACE FILL FILE NAMES
SA6 F2NM
BX1 X0
RJ SFN
SA1 PRSG SET POINTER TO OUTPUT FET
SA6 F1NM
BX7 X1
MX6 0
SA7 B1+B1
SA6 A7+B1
SA0 F1
RJ CDT CHECK IF CONTROL WORDS ALLOWED ON FILE 1
SA0 F2
RJ CDT CHECK IF CONTROL WORDS ALLOWED ON FILE 2
RJ CBS CHECK BLOCK SIZE
RJ RLF RFL UP FOR LARGE L AND F TAPES
SA1 RW
ZR X1,PRS5 IF REWIND NOT REQUESTED
REWIND F1
REWIND F2
PRS5 SA1 F1-SLF
SA2 F2-SLF
BX3 X1+X2
ZR X3,PRSX IF NO S, L, OR F TAPES
BX3 X1-X2
ZR X3,PRSX IF FILES HAVE SAME FORMAT
MESSAGE PRSH,3 ISSUE VERIFY NOT GUARANTEED WARNING
EQ PRSX RETURN
PRSA BSS 0 CONTROL CARD ARGUMENT EQUIVALENCE TABLE
L ARG O,O ERROR LIMIT FILE
N ARG PRSD,FC FILE COUNT
E ARG PRSE,EL ERROR LIMIT
R ARG -PRSF,RW REWIND
A ARG -PRSF,AB ABORT ON ERROR
C ARG -PRSB,CM CODED MODE ON BOTH FILES
C1 ARG -PRSF,CM CODED MODE ON FIRST FILE ONLY
C2 ARG -PRSC,CM CODED MODE ON SECOND FILE ONLY
BS ARG PRSE,BS BLOCK SIZE
ARG
PRSB CON -1
PRSC CON 2
PRSD CON 0L999999
PRSE CON 0L0
PRSF CON 1
PRSG CON 0LOUTPUT+O
PRSH DATA C* FILE STRUCTURES NOT COMPATIBLE.*
CBL SPACE 4,10
** CBL - CALCULATE BUFFER LENGTH.
*
* ENTRY (A0) = FWA FET.
* ((A0)+6) = PRU SIZE, IF S OR L FORMAT TAPE.
* ((A0)+8) = PRU SIZE, IF F FORMAT TAPE.
*
* EXIT (X6) = DESIRED BUFFER LENGTH.
* (B3) .LT. 0, IF BUFFER LENGTH CHANGE REQUIRED.
*
* USES A - 1.
* B - 2, 3.
* X - 1, 2, 3, 6.
CBL SUBR ENTRY/EXIT
SA1 A0-SLF S, L, OR F TAPE INDICATOR
SX6 FBUFL DEFAULT BUFFER LENGTH
SB2 X1
SB3 B1
SX3 3
SA1 A0+6 GET S/L TAPE MAXIMUM BLOCK SIZE
GT B2,B1,CBL1 IF L TAPE
PL B2,CBLX IF NOT F TAPE
SA1 A0+8 GET F TAPE PRU SIZE
CBL1 IX2 X1+X3 ALLOW FOR CONTROL WORDS
LX2 1 PRU SIZE * 2
IX3 X6-X2
PL X3,CBLX IF CALCULATED BUFFER LENGTH .LE. DEFAULT
BX6 X2
SB3 -B1
EQ CBLX RETURN
CBS SPACE 4,15
** CBS - CHECK BLOCK SIZE.
*
* EXIT BS PARAMETER VERIFIED, PRU SIZE SET IN MLRS FIELD OF
* S AND L TAPE FET(S).
* TO PER2, IF ERROR ENCOUNTERED.
*
* USES A - 0, 1, 2, 5, 6.
* B - 2, 7.
* X - 1, 2, 5, 6.
*
* CALLS DXB, SPS.
CBS SUBR ENTRY/EXIT
SA5 BS CONVERT BLOCK SIZE
SX1 X5
SB7 B1
NZ X1,CBS2 IF BS NOT SPECIFIED
RJ DXB
SA6 BS
NZ X4,PER2 IF ASSEMBLY ERROR
ZR X6,PER2 IF BS=0 SPECIFIED
SA1 F1-SLF
SA2 F2-SLF
SB3 X1
SB4 X2
GT B3,CBS1 IF S OR L TAPE
LE B4,PER2 IF BS PARAMETER NOT ALLOWED
CBS1 SX2 X6-MSPS-1
NG X2,CBS2 IF BS .LE. MAXIMUM S TAPE PRU SIZE
GT B3,B1,CBS2 IF FILE 1 IS L TAPE
LE B4,B1,PER2 IF FILE 2 IS NOT L TAPE
CBS2 SA0 F1
RJ SPS SET FILE 1 PRU SIZE IF S OR L TAPE
SA0 F2
RJ SPS SET FILE 2 PRU SIZE IF S OR L TAPE
EQ CBSX RETURN
CDT SPACE 4,15
** CDT - CHECK DEVICE TYPE.
*
* ENTRY (A0) = FWA FET.
*
* EXIT CONTROL WORD FLAG AND S, L, OR F TAPE INDICATOR
* SET APPROPRIATELY FOR THIS FILE.
* OPTICAL DISK FET EXTENSION INITIALIZED, IF APPLICABLE.
* WARNING MESSAGE ISSUED IF FILE NOT FOUND.
* ((A0)+8) = PRU SIZE, IF F FORMAT TAPE.
*
* USES A - 1, 2, 3, 6, 7.
* B - 2, 3, 5.
* X - 0, 1, 2, 3, 6, 7.
*
* CALLS SNM.
*
* MACROS FILINFO, MESSAGE, OPEN.
CDT4 OPEN A0,READNR,R CHECK FOR TERMINAL FILE
SA3 A0+B1 GET DEVICE TYPE
MX2 -11
LX3 12
BX3 -X2*X3
SX7 X3-2RTT
ZR X7,CDTX IF TERMINAL FILE
SA1 A0 GET FILE NAME
SB5 -CDTA * FILE NOT FOUND - LFN.*
BX1 X0*X1
SB3 CDTB MESSAGE ASSEMBLY AREA
SB2 1RX SET REPLACEMENT CHARACTER
RJ SNM SET NAME IN MESSAGE
MESSAGE CDTB,3 ISSUE WARNING MESSAGE
CDT5 SX7 B1+ ENABLE CONTROL WORDS
SA7 A0-CWF
CDT SUBR ENTRY/EXIT
SA1 A0 SET FILE NAME IN PARAMETER BLOCK
MX0 42
SA2 CDTC
BX1 X0*X1
SX2 X2
BX6 X1+X2
SA6 A2
FILINFO CDTC GET FILE INFORMATION
SA1 CDTC+1 GET DEVICE TYPE AND STATUS
ZR X1,CDT4 IF FILE NOT FOUND
BX3 X1
AX3 48
SX2 X3-2ROD OPTICAL DISK DEVICE TYPE
NZ X2,CDT1 IF NOT OD DEVICE
SX7 FETODL OD FET EXTENSION LENGTH
SX2 A0+12B BUILD POINTER TO FET EXTENSION
LX7 18
BX7 X2+X7
SA7 A0+11B STORE POINTER AND LENGTH
OPEN A0,READNR,R
EQ CDT5 ENABLE CONTROL WORDS
CDT1 LX1 59-15
NG X1,CDT5 IF FILE ON MASS STORAGE
LX1 59-24-59+15
PL X1,CDTX IF FILE NOT ON TAPE
CDT2 SA1 CDTC+FIPBL GET TAPE FORMAT
MX0 -6
LX1 -6
SX7 B1
BX1 -X0*X1
SX2 X1-/MTX/TFS
ZR X2,CDT3 IF S TAPE
SX2 X1-/MTX/TFL
SX7 B1+B1
ZR X2,CDT3 IF L TAPE
SX7 -B1
SX2 X1-/MTX/TFF
NZ X2,CDT5 IF NOT F TAPE
SA3 A1+B1 GET BLOCK SIZE
LX3 -24
SX6 X3+
SA6 A0+8
CDT3 SA7 A0-SLF SET S/L/F TAPE INDICATOR
EQ CDT5 SET CONTROL WORD FLAG
CDTA DATA C* FILE NOT FOUND - XXXXXXX.*
CDTAL EQU *-CDTA
CDTB BSS CDTAL MESSAGE BUFFER
CDTC VFD 42/0,6/CDTCL,12/1 *FILINFO* PARAMETER BLOCK
BSS FIPBL-1
CON FMTK TAPE FORMAT KEYWORD
CON BSZK TAPE BLOCK SIZE KEYWORD
CDTCL EQU *-CDTC
PCM SPACE 4,10
** PCM - PROCESS CODED MODE PARAMETER.
*
* EXIT CODED MODE SET ON FIRST, SECOND, OR BOTH FILES,
* IF REQUESTED.
*
* USES A - 1, 2, 6.
* B - 2.
* X - 1, 2, 6.
PCM SUBR ENTRY/EXIT
SA2 CM
ZR X2,PCMX IF CODED MODE NOT REQUESTED
SB2 X2
SX2 B1+B1
GT B2,B1,PCM1 IF SECOND FILE ONLY
SA1 F1 SET CODED MODE ON FIRST FILE
BX6 -X2*X1
SA6 A1
PCM1 EQ B2,B1,PCMX IF FIRST FILE ONLY
SA1 F2 SET CODED MODE ON SECOND FILE
BX6 -X2*X1
SA6 A1
EQ PCMX RETURN
PER SPACE 4,10
** PER - PRESET ERROR PROCESSOR.
*
* ENTRY (X5) = FWA MESSAGE, IF ENTRY AT PER1 OR PER3.
* (X1) = FILE NAME, IF ENTRY AT PER3.
PER3 SB5 X5 SET NAME IN MESSAGE
SB2 1RX
RJ SNM
EQ PER1 ISSUE ERROR MESSAGE
PER2 SX5 PERA * VERIFY ARGUMENT ERROR.*
PER1 MESSAGE X5,,R
PER ABORT
PERA DATA C* VERIFY ARGUMENT ERROR.*
PERB DATA C* VERIFY FILE NAME CONFLICT - XXXXXXX.*
PERC DATA C* VERIFY FL ABOVE USER LIMIT.*
RLF SPACE 4,25
** RLF - RFL UP FOR LARGE L AND F TAPES.
*
* IF L OR F TAPE(S) TO BE VERIFIED, CALCULATE REQUIRED FL,
* RFL UP, AND RESET CIO BUFFER POINTERS IN FETS.
* 1. FOR L TAPE FILES, USE MLRS VALUE AS MAXIMUM BLOCK SIZE.
* FOR F TAPE FILES, USE BLOCK SIZE SAVED IN FET+8.
* 2. GET CURRENT MAXIMUM FL (MAXFL) VIA MEMORY MACRO.
* 3. FOR EACH L OR F TAPE, BUFFER LENGTH = MAXIMUM(FBUFL,
* 2*BLOCK SIZE).
* 4. IF FL REQUIREMENTS EXCEED MINIMUM(MAXFL,MFLF), SET EACH
* L OR F TAPE BUFFER LENGTH = BLOCK SIZE.
* 5. IF FL REQUIREMENTS EXCEED MAXFL, ABORT WITH * VERIFY
* FL ABOVE USER LIMIT.*.
*
* EXIT FIELD LENGTH INCREASED AS NECESSARY FOR L AND F TAPES.
* TO PER1, IF FIELD LENGTH ERROR.
*
* USES A - 0, 1, 2, 5, 6, 7.
* B - 3, 4.
* X - ALL.
*
* CALLS CBL, SYS=.
RLF SUBR ENTRY/EXIT
SA0 F1
RJ CBL CALCULATE FILE 1 BUFFER LENGTH
SA6 RLFA
SA0 F2
SB4 B3 SAVE BUFFER LENGTH CHANGE INDICATOR
RJ CBL CALCULATE FILE 2 BUFFER LENGTH
SA6 RLFB
SX0 MFLF MAXIMUM FIELD LENGTH FACTOR
NG B4,RLF1 IF FILE 1 BUFFER LENGTH CHANGE REQUIRED
PL B3,RLFX IF NO BUFFER LENGTH CHANGE ON FILE 2
RLF1 MEMORY CM,STAT,R GET CURRENT MAXIMUM FL
SA5 STAT
AX5 30 CURRENT MAXIMUM FL (MAXFL)
IX1 X5-X0
PL X1,RLF2 IF MAXFL .GE. MFLF
BX0 X5
RLF2 SA1 RLFA CALCULATE REQUIRED FL
SX4 X1+BUF1
SA2 RLFB
IX4 X4+X2
IX3 X0-X4
PL X3,RLF4 IF REQUIRED FL .LE. MINIMUM(MAXFL,MFLF)
PL B4,RLF3 IF NO BUFFER LENGTH CHANGE ON FILE 1
AX6 X1,B1 SET BUFFER LENGTH = BLOCK SIZE
SA6 A1
RLF3 PL B3,RLF4 IF NO BUFFER LENGTH CHANGE ON FILE 2
AX6 X2,B1
SA6 A2
RLF4 SA1 RLFA CALCULATE REQUIRED FL
SX3 X1+BUF1
SA2 A1+B1
IX4 X3+X2
SX6 X4+2
IX2 X5-X6
LX6 30
SX5 PERC *VERIFY FL ABOVE USER LIMIT.*
SA6 STAT
NG X2,PER1 IF REQUIRED FL .GT. MAXFL
* INCREASE FIELD LENGTH AS NECESSARY FOR L AND F TAPES AND
* RESET CIO BUFFER POINTERS IN FETS.
MEMORY CM,STAT,R
SA1 F1+4 RESET CIO BUFFER POINTERS
MX0 42
BX6 X0*X1
SA2 F2+1
BX6 X6+X3
SA6 A1 FILE 1 LIMIT
BX7 X0*X2
LX6 X3
BX7 X7+X3
SA6 A2+B1 FILE 2 IN
SA7 A2 FILE 2 FIRST
SA6 A6+B1 FILE 2 OUT
SA1 A6+B1
BX7 X0*X1
BX7 X7+X4
SA7 A1 FILE 2 LIMIT
EQ RLFX RETURN
RLFA CON 0 FILE 1 BUFFER LENGTH
RLFB CON 0 FILE 2 BUFFER LENGTH
SPS SPACE 4,10
** SPS - SET PRU SIZE.
*
* ENTRY (A0) = FWA FET.
*
* EXIT PRU SIZE SET IN MLRS FIELD OF FET IF S OR L TAPE.
* TO PER2, IF ERROR ENCOUNTERED.
*
* USES A - 1, 2, 6.
* B - 2.
* X - 1, 2, 3, 6.
SPS SUBR ENTRY/EXIT
SA1 A0-SLF S, L, OR F TAPE INDICATOR
SA2 BS BLOCK SIZE PARAMETER VALUE
SX3 MSPS MAXIMUM S TAPE PRU SIZE
SB2 X1
IX3 X3-X2
LE B2,SPSX IF NOT S OR L TAPE
SX6 DLPS DEFAULT L TAPE PRU SIZE
GT B2,B1,SPS1 IF L TAPE
SX6 DSPS DEFAULT S TAPE PRU SIZE
NG X2,SPS2 IF BS PARAMETER NOT SPECIFIED
NG X3,SPS2 IF BLOCK SIZE EXCEEDS MAXIMUM S PRU SIZE
SPS1 NG X2,SPS2 IF BS PARAMETER NOT SPECIFIED
BX6 X2
SPS2 SA6 A0+6 SET MLRS FIELD OF FET
EQ SPSX RETURN
SPACE 4,10
** PRESET DATA STORAGE.
BS CON -1 MAXIMUM BLOCK SIZE
CM CON 0 CODED MODE
STAT VFD 30/-1,30/0 FIELD LENGTH STATUS WORD
SPACE 4,10
** COMMON DECKS.
*CALL COMCARG
*CALL COMCCPM
*CALL COMCDXB
*CALL COMCLFM
*CALL COMCSTF
SPACE 4
END