CIPHER
* /--- FILE TYPE = E
* /--- BLOCK ENTRY 00 000 85/08/08 17.36
IDENT CIPHER,FETS
TITLE CIPHER - ENCRYPT/DECRYPT A FILE.
ABS
ENTRY CIPHER
ENTRY SSM=
ENTRY SDM=
ENTRY RFL=
SYSCOM B1 DEFINE (B1) = 1
** CIPHER - ENCRYPT/DECRYPT A FILE.
*
* THIS PROGRAM ENCRYPTS/DECRYPTS A FILE ACCORDING
* TO A LINEAR CONGRUENTIAL CIPHER (PSEUDO-RANDOM
* SEQUENCE).
*
* THIS PROGRAM IS ESSENTIALY THE SAME AS =COPYBR=
* FROM THE NOS DECK =COPYB=. SEE THAT DECK FOR
* MUCH MORE DOCUMENTATION.
*
* THIS PROGRAM MUST HAVE FOUR CALLING PARAMETERS,
* INPUT FILE NAME, OUTPUT FILE NAME, ENCRYPT/DECRYPT
* FLAG AND CIPHERING KEY. NONE OF THE OTHER =COPYB=
* PARAMETERS ARE RECOGNIZED.
*
* THE ENCRYPT/DECRYPT PARAMETER IS EITHER THE STRING
* *ENCRYPT* OR *DECRYPT* (OTHER VALUES ARE REJECTED)
* EITHER CAN BE USED TO ENCRYPT THE FILE, BUT THE
* OTHER MUST BE USED TO DECRYPT IT.
*
* /--- BLOCK CONSTANTS 00 000 85/07/29 12.36
TITLE ASSEMBLY CONSTANTS.
**** ASSEMBLY CONSTANTS.
DPRS EQU 1003B DEFAULT PRU SIZE WITH CONTROL WORDS
BUFL EQU DPRS DEFAULT WORKING STORAGE BUFFER LENGTH
FBUFL EQU DPRS*4 DEFAULT CIO BUFFER LENGTH
LBUFL EQU 102B ALTERNATE OUTPUT CIO BUFFER LENGTH
RBFL EQU 100B RECORD COPY WORKING BUFFER LENGTH
SBUFL EQU DPRS*8 SINGLE BUFFER COPY DEFAULT BUFFER LENGTH
FETL EQU 9 FET LENGTH
DSPS EQU 1000B DEFAULT S TAPE PRU SIZE FOR *COPY*
DLPS EQU 2000B DEFAULT L TAPE PRU SIZE FOR *COPY*
MCBS EQU 5120 MAXIMUM BLOCK SIZE (IN CHARACTERS)
MFLF EQU 45000B-2 MAXIMUM FIELD LENGTH FACTOR
LOFL EQU 20000B-2 LOWER OPTIMUM FL FOR L AND F TAPE COPIES
****
SPACE 4,10
* SPECIAL ENTRY POINTS.
SSM= EQU 0 SUPPRESS DUMPS OF FIELD LENGTH
SDM= EQU 0 SUPPRESS INITIAL DAYFILE MSG
* /--- BLOCK COMMONS 00 000 83/04/18 15.17
SPACE 4,10
*CALL COMCMAC
*CALL COMSLFM
QUAL MTX
*CALL COMSMTX
QUAL *
* /--- BLOCK FETS 00 000 83/03/30 19.11
TITLE FETS.
ORG 120B
FETS BSS 0
I BSS 0 INPUT FILE
INPUT FILEB IBUF,FBUFL,FET=FETL
CWF EQU *-I CONTROL WORD FLAG
CON 0 NONZERO IF CONTROL WORDS ENABLED ON INPUT
SLF EQU *-I FORMAT FLAG
CON 0 1= S TAPE, 2= L TAPE, -1= F TAPE, 0= OTHER
TCF EQU *-I TCOPY CONVERSION FORMAT
CON 0 -2=SI, -1=X, 1=E, 2=B, 0=NO CONVERSION
PRU EQU *-I PRU SIZE (IN CM WORDS)
CON -1
NSZ EQU *-I NOISE SIZE (24/BITS, 18/UBC, 18/LENGTH)
CON 0
TRK EQU *-I TAPE TRACK AND LABEL TYPE
CON 0 1/9-TRACK, 1/7-TRACK, 52/0, 6/LABEL TYPE
O BSS 0 OUTPUT FILE
OUTPUT FILEB OBUF,FBUFL,FET=FETL
CON 0 NONZERO IF CONTROL WORDS ENABLED ON OUTPUT
CON 0 1= S TAPE, 2= L TAPE, -1= F TAPE, 0= OTHER
CON 0 1=E, 2=B, 0=NO CONVERSION
CON -1 PRU SIZE (IN CM WORDS)
CON 0 NOISE SIZE (24/BITS, 18/UBC, 18/LENGTH)
CON 0 TAPE TRACK AND LABEL TYPE
L FILEB LBUF,LBUFL ALTERNATE OUTPUT FILE
ORG L
VFD 42/0LOUTPUT,17/1,1/1
ORG L+FETL
* /--- BLOCK STORAGE 00 000 83/03/30 19.10
TITLE DATA STORAGE.
** DATA STORAGE.
BTSK CON 0 BLOCK TERMINATOR/SKIP WORD INDICATOR
CRI CON -2 CALLING ROUTINE INDICATOR
CT CON 1 COPY COUNT
EL CON 0 ERROR LIMIT
EORF CON 1 CURRENT BLOCK EOR FLAG
ERRF CON 0 CURRENT BLOCK ERROR FLAG
FUBC CON 0 FULL BLOCK UNUSED BIT COUNT (S, L TAPES)
FWWB CON BUF1+1 FWA WORKING BUFFER
LVL CON 0 EOR LEVEL NUMBER
LWDB CON 0 LWA+1 DATA TRANSFERRED TO WORKING BUFFER
RWCB VFD 1/1,59/0 REMAINING WORDS IN CURRENT BLOCK
RWTT CON 0 REMAINING WORDS TO TRANSFER
SBT CON -1 SINGLE BUFFER READ/WRITE THRESHOLD
SK CON 0 SKIP FLAG
TC CON 1 TERMINATION CONDITION (-1=EOI,0=EOD,1=EOF)
UBC CON 0 UNUSED BIT COUNT FOR CURRENT WRITE
UBCB CON 0 UNUSED BIT COUNT FOR CURRENT BLOCK
VF CON 0 VERIFY FLAG
BC CON -1 BLOCK COUNT
RC CON 0 RECORD COUNT
ESPI CON 0 ERROR BLOCKS SKIPPED/PROCESSED INDICATOR
NPDI CON 0 NOISE BLOCKS PADDED/DELETED INDICATOR
RSAI CON 0 RECORD SPLIT ALLOWED INDICATOR
SEWI CON 0 SKIP EOF WRITE INDICATOR
TLLI CON 0 TRUNCATE LONG LINES INDICATOR
BFCT CON 0 BAD FORMAT BLOCK COUNT
NZCT CON 0 NOISE BLOCK COUNT
PBCT CON 0 PARITY/BLOCK TOO LARGE ERROR COUNT
RSCT CON 0 RECORD SPLIT COUNT
* /--- BLOCK TECA 00 000 83/03/30 19.11
SPACE 4,10
** TECA - TABLE OF ERROR COUNT ADDRESSES.
*
*T 6/ EF, 18/ DMSA, 18/ OMSA, 18/ ERCA
*
* EF ERROR FLAG VALUE.
* DMSA DAYFILE ERROR SUMMARY MESSAGE ADDRESS.
* OMSA ALTERNATE OUTPUT FILE ERROR MESSAGE ADDRESS.
* ERCA ERROR COUNT ADDRESS.
TECA BSS 0
VFD 6/-1,18/IESA,18/PDED,18/PBCT PARITY/BLOCK TOO LARGE
VFD 6/1,18/IESC,18/PDEF,18/BFCT BAD FORMAT BLOCK ERROR
TECAL1 EQU *-TECA
VFD 6/0,18/IESD,18/0,18/NZCT NOISE BLOCKS PROCESSED
VFD 6/0,18/IESE,18/0,18/RSCT RECORD SPLITS PROCESSED
TECAL2 EQU *-TECA
* /--- BLOCK ABT 00 000 83/04/18 15.21
ABT SPACE 4,15
** ABT - ABORT ROUTINE.
*
* FLUSHES OUTPUT FILE BUFFER. FLUSHES ALTERNATE OUTPUT FILE
* BUFFER, IF NECESSARY. ISSUES DAYFILE MESSAGES.
*
* ENTRY (B5) = FWA MESSAGE, IF ENTRY AT *ABT4*.
*
* USES A - 1, 2, 6.
* B - 2.
* X - 1, 2, 6.
*
* CALLS CIO=, IES, MSG=, SNM, SYS=.
ABT4 SX6 B5+ SAVE ABORT MESSAGE ADDRESS
SA1 I SET NAME IN MESSAGE
MX2 42
SA6 ABTA
BX1 X2*X1
SB2 1RX
RJ SNM
* EQ ABT
ABT SA1 SK
NZ X1,ABT2 IF SKIP SET
SA1 O+CWF
ZR X1,ABT1 IF CONTROL WORDS DISABLED ON OUTPUT
WRITECW O FLUSH OUTPUT BUFFER
EQ ABT2 ABORT
ABT1 WRITER O FLUSH OUTPUT BUFFER
ABT2 SA1 EL
ZR X1,ABT3 IF EXTENDED ERROR PROCESSING NOT IN EFFECT
WRITER L FLUSH ALTERNATE OUTPUT FILE BUFFER
ABT3 RECALL I FORCE 1MT ERROR MESSAGES TO DAYFILE FIRST
RJ IES ISSUE ERROR SUMMARY MESSAGES
SA2 ABTA ISSUE ABORT MESSAGE
MESSAGE X2,0
ABORT
ABTA CON ABTB ABORT MESSAGE ADDRESS
ABTB DATA C* ERROR LIMIT EXCEEDED.*
ABTC DATA C* RECORD TOO LARGE ON XXXXXXX.*
ABTD DATA C* UNRECOVERABLE ERROR ON XXXXXXX.*
* /--- BLOCK DRN 00 000 83/03/30 20.17
DRN SPACE 4,15
** DRN - DISPLAY RECORD NAME.
*
* ENTRY (X2) = FWA RECORD. IF (X2) .LT. 0, IT IS THE
* COMPLEMENT OF FWA RECORD IN INPUT CIO BUFFER.
* (X1) = FWA RECORD, IF ZERO LENGTH RECORD.
*
* EXIT (RC) = UPDATED RECORD COUNT.
*
* USES A - 1, 2, 3, 6, 7.
* X - 1, 2, 3, 6, 7.
*
* CALLS MSG=.
DRN SUBR ENTRY/EXIT
SA3 RC INCREMENT RECORD COUNT
SX7 B1
IX6 X3+X7
PL X2,DRN1 IF NOT DISPLAY FROM CIO BUFFER
IX7 X2-X7
BX2 -X2
DRN1 IX1 X1-X2
SA6 A3
ZR X1,DRN2 IF ZERO LENGTH RECORD
SA1 X2 GET RECORD NAME
MX6 12
BX6 X6*X1
LX6 12
SX6 X6-7700B
NZ X6,DRN2 IF NOT 77 TABLE
SA3 I+4
SA1 A1+B1
SX3 X3
PL X7,DRN2 IF NOT DISPLAY FROM CIO BUFFER
SA2 I+1
IX6 X3+X7 CHECK FOR WRAP AROUND
NZ X6,DRN2 IF NO WRAP AROUND
SA1 X2
DRN2 MX7 42
BX7 X7*X1
SA7 DRNA+1 ENTER NAME IN MESSAGE
MESSAGE A7-B1,1 DISPLAY RECORD NAME
EQ DRNX RETURN
DRNA DATA 10H COPYING
CON 0,0
* /--- BLOCK END 00 000 85/07/25 15.39
END SPACE 4,15
** END - END ROUTINE.
*
* FLUSHES OUTPUT BUFFER, IF NECESSARY. FLUSHES ALTERNATE
* OUTPUT FILE BUFFER, IF NECESSARY. ISSUES DAYFILE MESSAGES.
*
* ENTRY AT *END5*, IF EOI ENCOUNTERED BEFORE COPY COMPLETE.
*
* EXIT TO *VFY*, IF VERIFY REQUESTED.
*
* USES A - 1, 2, 6.
* X - 1, 2, 6.
*
* CALLS CIO=, IES, MSG=, SYS=.
END5 SX6 ENDC *EOI ENCOUNTERED* OR *FILE NOT FOUND*
SA6 ENDA
* EQ END
END SA1 SK
NZ X1,END2 IF SKIP SET
RECALL O
SA1 O+2 CHECK *IN* = *OUT*
SA2 A1+B1
IX1 X1-X2
ZR X1,END2 IF OUTPUT BUFFER EMPTY
SA2 O+CWF
ZR X2,END1 IF CONTROL WORD WRITE DISABLED
WRITECW O FLUSH OUTPUT BUFFER
EQ END2 ISSUE COMPLETION MESSAGE
END1 WRITE O FLUSH OUTPUT BUFFER
END2 SA1 EL
ZR X1,END3 IF EXTENDED ERROR PROCESSING NOT IN EFFECT
WRITER L FLUSH ALTERNATE OUTPUT FILE BUFFER
END3 RECALL I FORCE 1MT ERROR MESSAGES TO DAYFILE FIRST
RECALL O
RECALL L
RJ IES ISSUE ERROR SUMMARY MESSAGES
SA2 ENDA ISSUE ENDING MESSAGE
MESSAGE X2,0
* SA1 VF
* NZ X1,VFY IF VERIFY REQUESTED
ZR X0,END4 IF NO WARNING MESSAGES ISSUED
MESSAGE ENDE,3 * CHECK DAYFILE FOR ERRORS.*
END4 ENDRUN
ENDA CON ENDB ENDING MESSAGE ADDRESS
ENDB DATA C* COPY COMPLETE.*
ENDC DATA C* EOI ENCOUNTERED.*
* DATA C* FILE NOT FOUND - LFN.*
BSS 1 ALLOW ROOM FOR *FILE NOT FOUND* MESSAGE
ENDD DATA C* EOF ENCOUNTERED.*
ENDE DATA C* CHECK DAYFILE FOR ERRORS.*
* /--- BLOCK IES 00 000 83/03/30 20.18
IES SPACE 4,10
** IES - ISSUE ERROR SUMMARY MESSAGES.
*
* EXIT (X0) = NUMBER OF ERROR SUMMARY MESSAGES ISSUED.
*
* USES A - 1, 2, 6.
* B - 5, 6, 7.
* X - 0, 1, 2, 6.
*
* CALLS INM, MSG=.
IES SUBR ENTRY/EXIT
SB6 B0
BX0 X0-X0
SB7 TECAL2
IES1 GE B6,B7,IESX IF END OF ERROR COUNTS
SA2 TECA+B6
SB6 B6+B1
SA1 X2
ZR X1,IES1 IF NO ERRORS OF THIS TYPE OCCURRED
AX2 36
SX0 X0+B1
SB5 X2+
RJ INM INSERT NUMBER IN MESSAGE
MESSAGE B5,3 ISSUE MESSAGE TO USERS DAYFILE
EQ IES1 CONTINUE ERROR SUMMARY PROCESSING
IESA DATA C* XXXXXXXXXX PARITY/BLOCK TOO LARGE ERRORS.*
IESC DATA C* XXXXXXXXXX BAD FORMAT BLOCKS.*
IESD DATA C* XXXXXXXXXXXXXXX NOISE BLOCKS PADDED.*
IESE DATA C* XXXXXXXXXX RECORD SPLITS OCCURRED.*
* /--- BLOCK INM 00 000 83/03/30 20.19
INM SPACE 4,15
** INM - INSERT NUMBER IN MESSAGE.
*
* ENTRY (B5) = FWA MESSAGE TO BE ISSUED.
* (X1) = NUMBER TO BE CONVERTED FOR MESSAGE.
*
* EXIT NUMBER CONVERTED TO DECIMAL DISPLAY AND ENTERED INTO
* MESSAGE.
*
* USES B - 2.
* X - 1.
*
* CALLS CDD, SNM.
INM SUBR ENTRY/EXIT
RJ CDD CONVERT NUMBER TO DECIMAL DISPLAY
SB2 B2-B1 CLEAR BLANK FILL
MX1 1
AX1 B2
BX1 X1*X4
SB2 1RX
RJ SNM ENTER NUMBER IN MESSAGE
EQ INMX RETURN
* /--- BLOCK PDE 00 000 83/03/30 20.19
PDE SPACE 4,15
** PDE - PROCESS DATA BLOCK ERROR.
*
* ENTRY (B3) = 0, IF PARITY OR BLOCK TOO LARGE ERROR.
* = 1, IF DATA ERROR.
*
* EXIT IF BLOCK ERROR FLAG NOT ALREADY SET, PARITY/BLOCK
* TOO LARGE, OR DATA ERROR COUNT INCREMENTED, AND
* IF ERROR LIMIT NONZERO, ERROR MESSAGE ISSUED TO
* ALTERNATE OUTPUT FILE.
* TO *ABT*, IF ERROR LIMIT EXCEEDED.
*
* USES A - 1, 2, 3, 4, 6, 7.
* B - 2, 3, 5, 7.
* X - 1, 2, 3, 4, 6, 7.
*
* CALLS INM, SNM, SYS=, WTC=, WTW=.
PDE SUBR ENTRY/EXIT
SA1 ERRF
SA2 TECA+B3
NZ X1,PDEX IF BLOCK ERROR FLAG ALREADY SET
SA3 X2 INCREMENT CORRESPONDING ERROR COUNT
SX6 B1
IX7 X3+X6
SA4 EL
AX2 18
SA7 A3
ZR X4,ABT IF ZERO ERROR LIMIT
SX7 X2 SAVE ERROR MESSAGE ADDRESS
AX2 36
SA7 PDEA
BX6 X2
SA6 A1 SET BLOCK ERROR FLAG
SB2 TECAL1-1
SX6 -B1
* /--- BLOCK PDE 00 000 83/03/30 20.19
PDE1 SA1 TECA+B2 CALCULATE TOTAL ERROR COUNT
SA2 X1
SB2 B2-B1
IX6 X6+X2
GE B2,PDE1 IF MORE ERROR COUNTS
BX7 X4
NG X4,PDE2 IF UNLIMITED ERROR PROCESSING
IX7 X6-X4
PDE2 SA7 A7+B1 SAVE ABORT INDICATOR
NZ X6,PDE3 IF NOT FIRST ERROR
WRITE L,* PRESET STANDARD WRITE
WRITEW L,PDEC,B1+B1 WRITE HEADER LINE
WRITEW X2,CCDR,8
DATE PDEC
CLOCK PDEC+1
WRITEW X2,PDEC,5
PDE3 SA2 PDEA GET ERROR MESSAGE ADDRESS
SB3 B0
SB2 X2
SB7 PDECL
SB5 PDEC
PDE4 SA2 B2+B3 MOVE MESSAGE TO BUFFER
BX6 X2
SA6 B5+B3
SB3 B3+B1
LT B3,B7,PDE4 IF MORE WORDS IN MESSAGE
SA1 BC BLOCK COUNT
RJ INM INSERT NUMBER IN MESSAGE
WRITEC L,B5
SA1 PDEB GET ABORT INDICATOR
NG X1,PDEX IF ERROR LIMIT NOT REACHED
EQ ABT ABORT
PDEA CON 0 ERROR MESSAGE ADDRESS
PDEB CON 0 ABORT INDICATOR
PDECL EQU 6
PDEC BSS 0 HEADER LINE AND MESSAGE BUFFER
CON 10H1- ERROR S
CON 10HUMMARY -
BSSZ PDECL-2
PDED DATA C* PARITY/BLOCK TOO LARGE ERROR IN BLOCK XXXXXXXXXX.*
PDEF DATA C* ILLEGAL FORMAT IN BLOCK XXXXXXXXXX.*
* /--- BLOCK PEF 00 000 83/03/30 20.19
PEF SPACE 4,20
** PEF - PROCESS END OF FILE.
*
* GENERATES AN EOF ON OUTPUT WITH OR WITHOUT CONTROL WORDS
* UNLESS ONE OF THE FOLLOWING CONDITIONS EXIST -
* 1. SKIP FLAG IS SET.
* 2. PO=M OPTION (SKIP EOF WRITE) IS SELECTED.
* 3. LAST DOUBLE EOF (FOR TC=EOD COPY) IS ENCOUNTERED.
* 4. FOR A COPY WITH A FILE COUNT SPECIFIED (COPYBF
* OR COPY/TCOPY WITH TC=EOF PARAMETER), WHEN EOI
* IS ENCOUNTERED ON INPUT AND NO DATA TRANSFER HAS
* OCCURRED SINCE PREVIOUS EOF.
* THE COPY COUNT IS DECREMENTED WHEN APPLICABLE.
*
* ENTRY (X0) .LT. 0, IF EOI ENCOUNTERED.
* (X5) = 0, IF EMPTY FILE ENCOUNTERED.
*
* EXIT (X0) .LT. 0, IF EOI ENCOUNTERED.
* (CT) = 0, IF COPY COMPLETE.
*
* USES A - 1, 2, 3, 4, 6.
* B - 2.
* X - 0, 1, 2, 3, 4, 6.
*
* CALLS CIO=, MSG=, WTW=.
PEF3 WRITEF O GENERATE EOF AND FLUSH BUFFER
PEF4 SA1 TC GET TERMINATION CONDITION
NG X0,PEFX IF EOI ENCOUNTERED
* /--- BLOCK PEF 00 000 83/03/30 20.19
NG X1,PEFX IF COPY TO EOI
SB2 X0+
NZ X1,PEF5 IF COPY TO FILE COUNT
EQ B2,B1,PEFX IF EMPTY FILE NOT ENCOUNTERED
PEF5 SX1 B1 DECREMENT COPY COUNT
SA2 CT
IX6 X2-X1
SA6 A2+
PEF SUBR ENTRY/EXIT
SA2 TC
SA4 SK
SA1 BC INCREMENT BLOCK COUNT
SA3 CT
SB2 X2
NG X0,PEF2 IF EOI ENCOUNTERED
SX0 B1
IX6 X1+X0
SA6 A1
NZ X5,PEF1 IF DATA TRANSFERRED
NZ B2,PEF1 IF NOT COPY TO DOUBLE EOF
SA2 RC
IX1 X3-X0
ZR X2,PEF1 IF NO RECORDS COPIED
SX0 B1+B1
NZ X1,PEF1 IF NOT LAST DOUBLE EOF
SA1 =10H SKIPPING SKIP LAST EOF
BX0 X0-X0
LX6 X1
SA6 PEFB
PEF1 SA1 RC ADVANCE RECORD COUNT
SX6 B1
IX6 X1+X6
SA6 A1+
MESSAGE PEFB,1 DISPLAY EOF MESSAGE
ZR X0,PEF5 IF LAST DOUBLE EOF ENCOUNTERED
SA3 SEWI SKIP EOF WRITE INDICATOR
NZ X3,PEF4 IF PO=M OPTION SELECTED
SA2 O+CWF
NZ X4,PEF4 IF SKIP SET
ZR X2,PEF3 IF CONTROL WORD WRITE DISABLED
WRITEW O,PEFA,B1+B1 WRITE CONTROL WORD EOF
EQ PEF4 DECREMENT COPY COUNT
PEF2 NZ X4,PEFX IF SKIP SET
LE B2,PEFX IF NOT COPY TO FILE COUNT
ZR X5,PEFX IF NO DATA TRANSFERRED
EQ PEF1 WRITE EOF
PEFA VFD 60/0 CONTROL WORD EOF
VFD 12/17B,48/0
PEFB DATA C* COPYING EOF.*
* /--- BLOCK COMMONS 00 000 83/04/20 09.43
SPACE 4,10
** COMMON DECKS.
*CALL COMCCDD
WRIF$ EQU 1 SELECT *RE-ISSUE CURRENT WRITE*
*CALL COMCCIO
*CALL COMCRDW
*CALL COMCSFN
*CALL COMCSNM
*CALL COMCSYS
*CALL COMCWTC
*CALL COMCWTW
* /--- BLOCK BUFFERS 00 000 83/04/20 11.38
SPACE 4,10
** COPY/COPYBF/COPYEI BUFFERS.
USE BUFFERS
LBUF BSS 0 ALTERNATE OUTPUT FILE CIO BUFFER
* SINGLE BUFFER COPY ALLOCATIONS.
SBUF EQU LBUF+LBUFL SINGLE CIO BUFFER
SRFL EQU SBUF+SBUFL FL FOR SINGLE BUFFER COPY
* DOUBLE BUFFER COPY ALLOCATIONS.
BUF1 EQU LBUF+LBUFL WORKING STORAGE BUFFER
IBUF1 EQU BUF1+BUFL INPUT FILE CIO BUFFER
OBUF1 EQU IBUF1+FBUFL OUTPUT FILE CIO BUFFER
RFL1 EQU OBUF1+FBUFL FL FOR DOUBLE BUFFER COPY
* ERRNG TCOPY-BUF1 IF LBUF OVERFLOWS INTO TCOPY
* /--- BLOCK CIPHER 00 000 85/07/30 16.41
TITLE CIPHER - MAIN LOOP.
CIPHER SPACE 4,15
** CIPHER - MAIN LOOP - COPY ALL RECORDS FROM ONE
* FILE TO ANOTHER AND ENCRYPT/DECRYPT.
*
* EXIT TO *END*, IF COPY COMPLETE.
* TO *END5*, IF EOI ENCOUNTERED.
CIPHER BSS 0
RJ PRS PRESET PROGRAM
CBR1 BSS 0
* INITIALIZE LINEAR CONGRUENTIAL CIPHER (PSEUDO-
* RANDOM SEQUENCE) FOR EACH RECORD, SO THEY CAN BE
* READ IN ANY ORDER. ALSO, ADVANCE ONE OF THE
* SEEDS TO PREVENT THEM FROM MOVING IN LOCKSTEP.
SA1 KEY
SX2 65539
BX6 X1
DX7 X1*X2
SA6 S1TAB
SA7 S2TAB
SA2 =31167285
SX3 69069
SB6 STABLTH
CBR2 BSS 0
DX6 X6*X2
SA6 A6+B1
DX7 X7*X3
SA7 A7+B1
SB6 B6-B1
GT B6,B0,CBR2
READ I BEGIN READ
RECALL O
WRITE O,* PRESET WRITE FUNCTION
READW I,BUF,RBFL
RJ CPR COPY RECORD
NG X0,END5 IF EOI ENCOUNTERED
EQ CBR1 -- KEEP COPYING UNTIL EOI
* /--- BLOCK CPR 00 000 85/07/29 13.07
TITLE RECORD COPY ROUTINES.
CPR SPACE 4,15
** CPR - COPY RECORD.
*
* ENTRY (X1) = FIRST BLOCK READ STATUS.
* (B6) = LWA+1 DATA TRANSFERRED TO WORKING BUFFER.
*
* EXIT (X0) .LT. 0, IF EOI.
* (X0) = 0, IF EOR.
* (X0) .GT. 0, IF EOF.
*
* USES A - 1, 2.
* X - 0, 1, 2, 5.
*
* CALLS CIO=, DRN, MSG=, RDW=, WTW=.
CPR4 MESSAGE PEFB,1 DISPLAY EOF MESSAGE
SA1 RC ADVANCE RECORD COUNT
SX0 B1+ SET EOF STATUS
SA2 SK
IX6 X1+X0
SA6 A1
NZ X2,CPRX IF SKIP SET
WRITEF O GENERATE EOF
CPR SUBR ENTRY/EXIT
SX0 X1+B1
BX5 X1
NG X0,CPRX IF EOI ENCOUNTERED
ZR X0,CPR4 IF EOF ENCOUNTERED
SX2 BUF
RJ DRN DISPLAY RECORD NAME
CPR1 SA2 SK
NZ X2,CPR2 IF SKIP SET
SB7 BUF
RJ CRYPT *** ENCRYPT/DECRYPT BUFFER ***
SB7 B6-BUF
WRITEW O,BUF,B7
CPR2 SX0 B0+ SET EOR STATUS
NZ X5,CPR3 IF EOR
READW I,BUF,RBFL READ NEXT CHUNK OF INPUT
BX5 X1
PL X1,CPR1 IF NOT EOF OR EOI
SX0 X1+B1 CHECK FOR EOI
PL X0,CPR4 IF EOF
CPR3 SA2 SK
NZ X2,CPRX IF SKIP SET
WRITER O END RECORD
EQ CPRX RETURN WITH EOR OR EOI STATUS
* /--- BLOCK CRYPT 00 000 85/08/30 15.25
CRYPT TITLE CRYPT - ENCRYPT/DECRYPT A BUFFER.
** CRYPT - ENCRYPT/DECRYPT A BUFFER.
*
* USES A LINEAR CONGRUENTIAL CIPHER (PSEUDO-RANDOM
* SEQUENCE) WHERE THE KEY IS THE INITIAL SEED VALUE.
* THE RESULT IS 'X'O'RED INTO THE PLAINTEXT. SINCE
* THE RESULT OF THE DOUBLE-PRECISION MULTIPLY IS
* ONLY 48 BITS, TWO SUCH OPERATIONS ARE DONE IN
* PARALLEL TO COVER THE ENTIRE 60 BIT WORD.
*
* BACKGROUND'; 'KNUTH, 'VOL. 2, PP 1-33. THIS IS
* ALGORITHM 'M BY 'MAC'LAREN AND 'MARSAGLIA ['J'A'C'M 12
* (1965), 83-89; 'C'A'C'M 11 (1968), 759]. 'I CHOSE IT
* OVER ALGORITHM 'B BY 'BAYS AND 'DURHAM BECAUSE 'I
* HAVE TO PRODUCE TWO 48-BIT QUANTITIES TO COVER THE
* THE ENTIRE WORD AND 'I FELT THAT USING ONE AS THE
* INDEX INTO THE SHUFFLE TABLE OF THE OTHER PREVENTS
* THE TOP BITS OF THE WORD FROM BEING RELATED TO THE
* SLOT INDEX.
*
* THE TWO MULTIPLIERS'; ONE WAS THE ONE SUGGESTED
* IN 'KNUTH AS IDEAL FOR 48-BITS OF PRECISION, THE
* OTHER WAS THE ',BEST OF ALL POSSIBLE MULTIPLIERS.',
* THE TWO MULTIPLIERS ARE RELATIVELY PRIME';
* 69069 = 3*7*11*13*23
* 31167285 = 3*3*3*5*19*29*419
*
* A PSEUDO-RANDOM SEQUENCE ALONE IS VULNERABLE TO
* ATTACK BY KNOWN/CHOSEN PLAINTEXT, SO 'I HAVE ALSO
* MODIFIED THIS ALGORITHM TO RUN AS A STREAM CIPHER
* BY 'X'O'RING SOME OF THE DATA INTO THE NEXT SEED.
*
* ENTRY (B6) = LWA+1 OF THE DATA TO BE CIPHERED.
* (B7) = FWA OF DATA TO BE CIPHERED.
*
* USES A - 2, 3, 4, 6, 7.
* X - 0, 2, 3, 4, 6, 7.
* B - 2, 3, 7.
*
* /--- BLOCK CRYPT 00 000 85/08/13 11.05
CRYPT PS
LE B6,B7,CRYPT -- NOTHING WAS READ IN
SB3 42D
SA3 SEED1 X3 = 'X(N)
SA4 SEED2 X4 = 'X(N)'7
SA2 =31167285
BX0 X2 X0 = A
CRYPT1 BSS 0
DX3 X3*X0 'X(N+1) _ ('X(N) * A) MOD 2**48
SX6 69069 X6 = A'7
DX4 X4*X6 'X(N+1)'7 _('X(N)'7 * A'7) MOD 2**48
AX2 X3,B3 J'7 _ 'X(N+1) DIV (2**42)
SA2 S2TAB+X2 'Y'7 _ 'V[J'7]'7 <READ MEMORY>
BX7 X4 'X(N+1)'7 <TO STORAGE REGISTER>
SA7 A2 'V[J'7]'7 _ 'X(N+1)'7 <STORE IN MEM>
BX6 X2 X6 = 'Y'7 <FOR USE LATER>
AX2 X4,B3 J _ 'X(N+1)'7 DIV (2**42)
BX7 X3 'X(N+1) <TO STORAGE REGISTER>
SA2 S1TAB+X2 'Y _ 'V[J] <READ MEMORY>
SA7 A2 'V[J] _ 'X(N+1) <STORE IN MEM>
BX7 X4 X7 _ COPY OF 'X(N+1)'7
AX7 44D X7 _ 'X(N+1)'7 DIV (2**44)
SB2 X7+19 B2 NOW PSEUDO-RANDOM (19..34)
LX2 B2 LEFT SHIFT (END-AROUND) 'Y BY B2
BX6 X2-X6 X6 = 'Y XOR 'Y'7
SA2 B7 READ NEXT WORD FROM BUFFER
BX7 X2-X6 X7 = WORD XOR ('Y XOR 'Y'7)
SB7 B7+B1 INCREMENT BUFFER ADDRESS
SA7 A2 STORE ENCRYPTED WORD IN BUFFER
* CODE FOR STREAM CIPHER
CRYPTA EQU *O ADDRESS OF MXI JK INSTRUCTION
CRYPTAS EQU *P-15D SHIFT FOR JK PORTION OF INSTR
MX6 52B MASK FOR LOW-ORDER BITS
CRYPTB EQU *O ADDRESS CONTAINING AND INSTR
CRYPTBS EQU *P-12D SHIFT TO 'XJ IN BXI -XK*XJ
BX6 -X6*X0 X2 OR X7 REPLACES X0 IN *PRS*
BX3 X3-X6 DEFLECT A FEW BITS IN 'X(N+1)
BX4 X4-X6 DEFLECT A FEW BITS IN 'X(N+1)'7
*
LT B7,B6,CRYPT1 -- IF NOT END OF BUFFER, LOOP
BX6 X3
SA6 A3 STORE CURRENT 'X(N) IN MEMORY
BX6 X4
SA6 A4 STORE CURRENT 'X(N)'7 IN MEMORY
EQ CRYPT
KEY EQU ARGR+3 PLAY IT WHERE IT LIES
STABLTH EQU 100B K
S1TAB BSS STABLTH 'V[0..K-1]
SEED1 DATA 0 'X (INITIALLY SET TO 'V[K])
S2TAB BSS STABLTH 'V'7[0..K-1]
SEED2 DATA 0 'X'7 (INITIALLY SET TO 'V[K]'7)
* /--- BLOCK BUFFERS 00 000 83/03/30 19.21
** COMMON DECKS.
*CALL COMCSRT
SPACE 4,10
** COPYBR/COPYX BUFFERS.
BUF BSS 0 WORKING STORAGE BUFFER
IBUF EQU BUF+RBFL INPUT FILE CIO BUFFER
OBUF EQU IBUF+FBUFL OUTPUT FILE CIO BUFFER
RFL= EQU OBUF+FBUFL FIELD LENGTH FOR COPYBR AND COPYX
* /--- BLOCK NEW PRS 00 000 85/08/13 10.49
TITLE PRESET.
** PRS - PRESET FOR EXECUTION.
*
PRS SUBR ENTRY/EXIT
SB1 1 (B1) = 1, THROUGHOUT PROGRAM
MX0 42D MASK FOR FILE NAMES
SA1 ACTR ARGUMENT COUNT
SB7 X1
ZR B7,PRS9 -- NO ARGUMENTS
* PROCESS INPUT FILE NAME.
R= A5,ARGR FIRST PARAM = INPUT FILE NAME
SA2 I
BX7 X0*X5
SX3 X2
ZR X7,PRS1 -- NO INPUT FILE
BX7 X7+X3
SA7 A2 STORE NEW INPUT FILE NAME
* PROCESS OUTPUT FILE NAME.
PRS1 BSS 0
SB7 B7-B1 DECR ARG CNT
ZR B7,PRS9 -- NO ARGS REMAINING, NO KEY
SA5 A5+B1 NEXT ARG = OUTPUT FILE NAME
SA2 O
BX7 X0*X5
SX3 X2
ZR X7,PRS2 -- NO OUTPUT FILE
BX7 X7+X3
SA7 A2 STORE NEW OUTPUT FILE NAME
* PROCESS ENCRYPT/DECRYPT FLAG
PRS2 BSS 0
SB7 B7-B1 DECR ARG CNT
ZR B7,PRS9 -- NO ARGS LEFT, NO KEY
SA5 A5+B1 NEXT ARG = ENCRYPT/DECRYPT
BX5 X0*X5 HOLD IT TO 7 CHARS
SA2 =7LENCRYPT
SA3 =7LDECRYPT
BX2 X2-X5
BX3 X3-X5
SX6 7 'XJ = 7 IF ENCRYPTING
ZR X2,PRS2.1 -- IF ARG WAS *ENCRYPT*
SX6 2 'XJ = 2 IF DECRYPTING
NZ X3,PRS9.1 -- IF ARG WAS NOT *DECRYPT*
PRS2.1 BSS 0
LX6 CRYPTBS SHIFT TO 'XJ IN BXI -XK*XJ
SA2 CRYPTB READ WORD TO BE PLANTED
BX6 X2+X6 UNION
SA6 A2 STORE MODIFIED INSTRUCTION WD
* /--- BLOCK NEW PRS 00 000 85/08/13 11.02
* PROCESS CIPHERING KEY.
SB7 B7-B1 DECR ARG CNT
ZR B7,PRS9 -- NO MORE ARGS, NO KEY
SA5 A5+B1 NEXT ARG = CIPHERING KEY
MX3 48 MASK FOR 8 CHARS
BX1 X5*X3
ZR X7,PRS9 -- THE KEY IS ZERO
MX0 6 MASK FOR CHARACTER
PRS3 BX6 X1 X6 = LAST GOOD VALUE
LX1 54D SHIFT NEXT CHAR
BX2 X0*X1 MASK OFF TOP CHAR
ZR X2,PRS3 -- KEEP LOOPING IF NOT TOO FAR
CX7 X6 COUNT NUMBER OF BITS IN KEY
SX3 32771D INITIAL SCRAMBLE FOR LUCK
DX6 X6*X3
SA6 A5 SHOULD BE *KEY*
SB7 A5-KEY CHECK TO BE SURE A5=KEY
NZ B7,*+400000B
SA2 CRYPTA READ WORD TO BE PLANTED
MX6 -3B RANGE OF 0..7
BX7 -X6*X7
LX7 CRYPTAS SHIFT TO JK IN MXI JK
BX7 X7-X2 XOR TO FORM NEW MASK WIDTH
SA7 A2 STORE UPDATED WORD
SB7 4 NUMBER OF DELIMITERS BEFORE KEY
SA3 COMMAS
SA4 NINES
SA5 SPACES
MX0 6
SA1 CCDR
PRS4 LX0 54D
PL X0,PRS5
SA1 A1+B1
PRS5 LE B7,B0,PRS6 -- IF TERMINATING LINE
BX6 X0*X1 CURRENT CHAR
BX7 X0*X4 ',9',
ZR X6,PRS9 -- PREMATURE END-OF-LINE
IX7 X7-X6 ',9', - CURRENT CHAR
PL X7,PRS4 -- NOT A DELIMITER
BX7 X0*X5 SPACE
IX7 X7-X6 SPACE - CURRENT CHAR
ZR X7,PRS4 -- IGNORE SPACES
BX1 -X0*X1 CLEAR OUT CHAR
BX7 X0*X3 COMMA
BX1 X1+X7 REPLACE DELIMITER WITH COMMA
BX6 X1
SA6 A1
SB7 B7-B1 DECR DELIMITER COUNT
EQ PRS4 -- GET NEXT CHAR
PRS6 BSS 0
SA4 PERIODS
BX1 -X0*X1 CLEAR CURRENT CHAR
BX4 X0*X4 ',.',
BX6 X1+X4 CURRENT CHAR REPLACED W/.
PRS7 BSS 0
LX0 54D
NG X0,PRS8 -- LAST CHAR IN WORD
BX6 -X0*X6 CLEAR CHAR
EQ PRS7
PRS8 BSS 0
SA6 A1
MX6 0
SA6 A1+B1 CLEAR ENTIRE WORD
MESSAGE CCDR
* /--- BLOCK NEW PRS 00 000 85/08/08 09.47
SA0 I INPUT FILE
RJ CDT CHECK IF CONTROL WORDS ALLOWED
SA0 O OUTPUT FILE
RJ CDT CHECK IF CONTROL WORDS ALLOWED
RJ SFM SET FILE MODE
RJ CFN CHECK FILE NAMES
RJ CIC CHECK INDETERMINATE COPY
SX7 0
SA7 I+CWF DISABLE CONTROL WORD READ
SA7 O+CWF DISABLE CONTROL WORD WRITE
EQ PRSX -- EXIT
PRS9 BSS 0 NO KEY SPECIFIED
MESSAGE CCDR SEND UNALTERED CONTROL CARD
MESSAGE PRSA NO KEY SPECIFIED
ABORT
PRS9.1 BSS 0 ENCRYPT/DECRYPT NOT SPECIFIED
MESSAGE CCDR SEND UNALTERED CONTROL CARD
MESSAGE PRSB ENCRYPT/DECRYPT NOT SPECIFIED
ABORT
PRSA DIS ,* NO KEY SPECIFIED.*
PRSB DIS ,* ENCRYPT/DECRYPT NOT SPECIFIED.*
NINES DATA 0L9999999999
SPACES DATA 10H
COMMAS DATA 10L,,,,,,,,,,
PERIODS DATA 10L..........
* /--- BLOCK CDT 00 000 83/03/30 19.53
CDT SPACE 4,15
** CDT - CHECK DEVICE TYPE.
*
* ENTRY (A0) = FWA FET.
*
* EXIT ((A0)+CWF) .NE. 0, IF CONTROL WORDS ALLOWED.
* ((A0)+SLF) = -1, IF F FORMAT TAPE.
* = 1, IF S FORMAT TAPE.
* = 2, IF L FORMAT TAPE.
* ((A0)+NSZ) = NOISE SIZE IN FRAMES, IF TAPE FILE.
* ((A0)+TRK) = TRACK AND LABEL TYPE, IF TAPE FILE.
* ((A0)+PRU) = PRU SIZE, IF F FORMAT TAPE.
* WARNING MESSAGE ISSUED IF INPUT FILE NOT FOUND.
*
* USES A - 1, 2, 3, 6, 7.
* B - 2, 5.
* X - 0, 1, 2, 3, 6, 7.
*
* CALLS GPS, SNM.
*
* MACROS FILINFO, MESSAGE.
CDT4 RJ GPS CHECK FOR TERMINAL FILE
SA3 A0+B1 GET DEVICE TYPE
MX2 -11
LX3 12
BX3 -X2*X3
SX7 X3-2RTT
SX2 A0-I
ZR X7,CDTX IF TERMINAL FILE
NZ X2,CDT5 IF NOT INPUT FILE
SA1 A0 GET INPUT FILE NAME
SB5 -CDTA * FILE NOT FOUND - LFN.*
BX1 X0*X1
SB2 1RX
SB3 ENDC REPLACE * EOI ENCOUNTERED.* MESSAGE
RJ SNM SET NAME IN MESSAGE
CDT5 SX7 B1+ ENABLE CONTROL WORDS
SA7 A0+CWF
CDT SUBR ENTRY/EXIT
SA1 A0 SET FILE NAME IN PARAMETER BLOCK
MX0 42
* /--- BLOCK CDT 00 000 83/03/30 19.53
SA2 CDTB
BX1 X0*X1
SX2 X2
BX6 X1+X2
SA6 A2
FILINFO CDTB GET FILE INFORMATION
SA1 CDTB+1 GET DEVICE TYPE AND STATUS
BX3 X1
AX3 48
ZR X3,CDT4 IF FILE NOT FOUND
SX2 X3-2RNE
LX1 59-15
NG X1,CDT5 IF FILE ON MASS STORAGE
LX1 59-19-59+15
LX7 X1,B1
ZR X2,CDT5 IF NULL EQUIPMENT
NG X1,CDT2 IF 9-TRACK TAPE
PL X7,CDTX IF NOT 7-TRACK TAPE
CDT2 MX6 2
SA2 CDTB+FIPBL+1 GET LABEL TYPE
MX0 -6
LX2 -12
BX6 X6*X1 GET TRACK BITS
SA3 A2-B1 GET TAPE FORMAT
BX2 -X0*X2
SA1 A2+B1 GET BLOCK SIZE AND NOISE SIZE
LX3 -6
BX6 X6+X2
LX1 -6
SA6 A0+TRK SAVE TRACK BITS AND LABEL TYPE
BX3 -X0*X3
BX6 -X0*X1
SA6 A0+NSZ SAVE NOISE SIZE
SX2 X3-/MTX/TFS
SX7 B1
ZR X2,CDT3 IF S TAPE
SX7 B1+B1
SX2 X3-/MTX/TFL
ZR X2,CDT3 IF L TAPE
SX7 -1
SX2 X3-/MTX/TFF
NZ X2,CDT5 IF NOT F TAPE
LX1 -18
SX6 X1
SA6 A0+PRU SET F TAPE PRU SIZE
CDT3 SA7 A0+SLF SET S/L/F TAPE INDICATOR
EQ CDT5 SET CONTROL WORD FLAG
CDTA DATA C* FILE NOT FOUND - XXXXXXX.*
CDTB VFD 42/0,6/CDTBL,12/1 *FILINFO* PARAMETER BLOCK
BSS FIPBL-1
CON FMTK TAPE FORMAT KEYWORD
CON LTYK TAPE LABEL TYPE KEYWORD
CON BSZK TAPE BLOCK SIZE, NOISE SIZE KEYWORD
CDTBL EQU *-CDTB
* /--- BLOCK CFN 00 000 83/03/30 19.54
CFN SPACE 4,10
** CFN - CHECK FILE NAMES.
*
* EXIT SKIP FLAG SET IF INPUT FILE NAME SAME AS OUTPUT
* FILE NAME.
* TO *PER1*, IF ALTERNATE OUTPUT FILE NAME CONFLICT.
*
* USES A - 1, 2, 3, 4, 6, 7.
* B - 5.
* X - 0, 1, 2, 3, 4, 6, 7.
CFN SUBR ENTRY/EXIT
SA1 I COMPARE FILE NAMES
SA4 O
MX0 42
BX1 X0*X1
SA3 L
BX4 X0*X4
SA2 =10H SKIPPING SET SKIP FLAG AND MESSAGE
BX7 X1-X4
LX6 X2
NZ X7,CFN1 IF INPUT .NE. OUTPUT FILE NAME
SX7 B1
SA6 DRNA
SA7 SK
SA6 PEFB
CFN1 SA2 SEWI SKIP EOF WRITE INDICATOR
SB5 PERE * FILE NAME CONFLICT.*
ZR X2,CFN2 IF PO=M NOT SELECTED
SA6 PEFB
CFN2 SX6 A3 SET ALTERNATE OUTPUT FILE POINTER
BX3 X0*X3
SX7 A4 SET OUTPUT FILE POINTER
BX6 X6+X3
SA2 EL CHECK IF ALTERNATE OUTPUT FILE TO BE USED
BX7 X7+X4
R= A6,ARGR
BX1 X1-X3
SA7 A6+B1
ZR X2,CFNX IF ERROR LIMIT = 0
ZR X1,PER1 IF ALTERNATE OUTPUT = INPUT FILE NAME
BX7 X4-X3
ZR X7,PER1 IF ALTERNATE OUTPUT = OUTPUT FILE NAME
EQ CFNX RETURN
* /--- BLOCK CIC 00 000 83/03/30 19.54
CIC SPACE 4,15
** CIC - CHECK FOR INDETERMINATE COPY.
*
* EXIT WARNING MESSAGE ISSUED IF S, L, OR F TAPE COPY.
* L TAPE PRU SIZE LIMITED IF COPYBF OR COPYEI CALL.
* TO *PER*, IF F TAPE PRU SIZE .GT. WORKING BUFFER SIZE.
*
* USES A - 1, 2, 3, 6.
* B - 2, 3, 4.
* X - 0, 1, 2, 3, 6.
*
* CALLS SYS=.
CIC SUBR ENTRY/EXIT
SA1 I+SLF
SA2 O+SLF
NZ X1,CIC1 IF S, L, OR F TAPE INPUT
ZR X2,CICX IF OUTPUT NOT S, L, OR F TAPE
CIC1 SA3 CRI GET CALLING ROUTINE INDICATOR
SB4 X2
SB2 X3
SB3 X1+
LE B2,CIC5 IF COPYBR OR COPYX CALL
SX6 BUFL-3 LIMIT L TAPE PRU SIZE TO WORKING BUFFER
LE B3,B1,CIC2 IF INPUT NOT L TAPE
SA6 I+6 SET MLRS FIELD IN INPUT FET
CIC2 LE B4,B1,CIC3 IF OUTPUT NOT L TAPE
SA6 O+6 SET MLRS FIELD OF OUTPUT FET
CIC3 SB5 PERB * BLOCK SIZE TOO LARGE ON LFN.*
GE B3,CIC4 IF INPUT NOT F TAPE
SA2 I+PRU GET INPUT FILE PRU SIZE
IX2 X6-X2
SA1 I
NG X2,PER IF F TAPE PRU SIZE EXCEEDS WORKING BUFFER
CIC4 GE B4,CIC5 IF OUTPUT NOT F TAPE
SA3 O+PRU GET OUTPUT FILE PRU SIZE
SA1 O
IX3 X6-X3
NG X3,PER IF F TAPE PRU SIZE EXCEEDS WORKING BUFFER
CIC5 MESSAGE CICA,3 * COPY INDETERMINATE.*
EQ CICX RETURN
CICA DATA C* COPY INDETERMINATE.*
* /--- BLOCK GPS 00 000 83/03/30 19.56
GPS SPACE 4,10
** GPS - GET PRU SIZES.
*
* ENTRY (A0) = FWA FET.
*
* EXIT (A0+PRU) = PRU SIZE, IF NOT PREVIOUSLY SET.
*
* USES A - 1, 4, 6.
* X - 1, 4, 6.
*
* CALLS CIO=.
GPS SUBR ENTRY/EXIT
SA4 A0+PRU
PL X4,GPSX IF PRU SIZE ALREADY SET
OPEN A0,READNR,R
SA1 A0+4 GET PRU SIZE
LX1 -18
SX6 X1
SA6 A4
EQ GPSX RETURN
* /--- BLOCK PER 00 000 83/03/30 19.56
PER SPACE 4,10
** PER - PRESET ERROR PROCESSOR.
*
* ENTRY (B5) = FWA MESSAGE, IF ENTRY AT *PER* OR *PER1*.
* (X1) = FILE NAME, IF ENTRY AT *PER*.
*
* USES B - 2, 5.
* X - 1, 2.
*
* CALLS MSG=, SNM, SYS=.
PER2 SB5 PERA * ARGUMENT ERROR.*
EQ PER1 ISSUE ERROR MESSAGE
PER MX2 42 SET NAME IN MESSAGE
SB2 1RX
BX1 X2*X1
RJ SNM
PER1 MESSAGE B5,0
ABORT
PERA DATA C* ARGUMENT ERROR.*
PERB DATA C* BLOCK SIZE TOO LARGE ON XXXXXXX.*
PERC DATA C* BLOCK SIZE TOO SMALL ON XXXXXXX.*
PERD DATA C* COPY FL ABOVE USER LIMIT.*
PERE DATA C* FILE NAME CONFLICT.*
PERF DATA C* ILLEGAL COPY.*
PERG DATA C* INVALID NOISE SIZE ON XXXXXXX.*
PERH DATA C* UNLABELED TAPE REQUIRED - XXXXXXX.*
PERI DATA C* UNRECOGNIZED TERMINATION CONDITION.*
PERJ DATA C* UNRECOGNIZED BACKSPACE CODE.*
PERK DATA C* BLOCK SIZE NOT APPLICABLE.*
PERL DATA C* PROCESSING OPTION NOT APPLICABLE.*
* /--- BLOCK SFM 00 000 83/03/30 20.01
SFM SPACE 4,10
** SFM - SET FILE MODE.
*
* EXIT CODED MODE SET ON INPUT, OUTPUT, OR BOTH FILES,
* IF REQUESTED.
*
* USES A - 1, 2, 6.
* B - 2.
* X - 1, 2, 6.
SFM SUBR ENTRY/EXIT
SA2 CM GET MODE INDICATOR
ZR X2,SFMX IF CODED MODE NOT REQUESTED
SB2 X2
SX2 B1+B1
GT B2,B1,SFM1 IF SECOND FILE ONLY
SA1 I
BX6 -X2*X1
SA6 A1
SFM1 EQ B2,B1,SFMX IF FIRST FILE ONLY
SA1 O
BX6 -X2*X1
SA6 A1
EQ SFMX RETURN
* /--- BLOCK TABLES 00 000 83/04/27 12.42
SPACE 4,10
** PRESET DATA STORAGE.
BS CON 0 BLOCK SIZE
CC CON 0 CHARACTER COUNT
CF CON 0 CONVERSION FORMAT
CM CON 0 CODED MODE (-1=BOTH,0=NEITHER,1=1ST,2=2ND)
DCT CON 1L1 DISPLAY CODE COPY COUNT
MAXFL CON 0 CURRENT MAXIMUM FIELD LENGTH
MCC CON 0 MAXIMUM CHARACTER COUNT
PO CON 0 PROCESSING OPTIONS
STAT VFD 30/-1,30/0 FIELD LENGTH STATUS WORD
* THE ORDER OF THE FOLLOWING MUST BE PRESERVED.
WBL CON BUFL WORKING BUFFER LENGTH
IBL CON FBUFL INPUT BUFFER LENGTH
OBL CON FBUFL OUTPUT BUFFER LENGTH
* /--- BLOCK COMMONS 00 000 83/04/18 16.37
SPACE 4,10
** COMMON DECKS.
*CALL COMCARM
*CALL COMCCPA
*CALL COMCDXB
*CALL COMCLFM
*CALL COMCPOP
*CALL COMCUSB
SPACE 4,10
** PRESET BUFFERS.
PASB EQU * POSITIONAL ARGUMENT STRING BUFFER
ERRNG RFL=-PASB-200 CHECK FOR BUFFER OVERFLOW FL
* /--- BLOCK END 00 000 83/04/20 21.13
* TEMP BUFFER UNTIL PLACED ON DST
BSSZ RFL=-*
SPACE 4,10
END