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 BX7 X4 'X(N+1)'7 SA7 A2 'V[J'7]'7 _ 'X(N+1)'7 BX6 X2 X6 = 'Y'7 AX2 X4,B3 J _ 'X(N+1)'7 DIV (2**42) BX7 X3 'X(N+1) SA2 S1TAB+X2 'Y _ 'V[J] SA7 A2 'V[J] _ 'X(N+1) 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