software: Added more and more

[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape5 / DTCOPY.PA

/DECTAPE COPY, V10

/
/
/
/
/
/
//
/
/
/
/
/COPYRIGHT (C) 1966, 1975
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
/SION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANT OTHER
/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
/AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/
/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMRNT COROPATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/
/
/
/
/
/
\f/DECTAPE COPY
/VERSION .B07
/
/
/COPYRIGHT 1968	DIGITAL EQUIPMENT CORPORATION
/	MAYNARD, MASS.	OCTOBER,1968

	
\f	
/ THIS PROGRAM COPIES A DECTAPE FROM ONE 
/ SPECIFIED UNIT TO ANOTHER. ALL DECTAPE
/ ROUTINES ARE INTERNALLY GENERATED SO THAT
/ IT MAY BE RUN WITHOUT THE MONITOR SYSTEM.
/
/ STARTING ADDRESS IS 200
/ 
	DTRA=6761
	DTCA=6762
	DTXA=6764
	DTSF=6771
	DTRB=6772
	DTLB=6774

	WC=7754
	CA=7755
/ THESE AREAS ARE USED BY DATA BREAK
BUFIOT=1547	/INPUT OUTPUT BUFFER
BUFCHK=4563	/RE-READ BUFFER
/ 
*20
/ PAGE ZERO WORKING STORAGE
BADTRY,	-3	/COUNT OF READ ERRORS
CURBLK,	0	/CURRENT BLOCK NUMBER
TRASH1,	0	/WORKING STORAGE
TRASH2,	0	/WORKING STORAGE
TRASH3,	0	/WORKING STORAGE
BLKCNT,	0	/NUMBEROF BLOCKS TO READ
		/OR MINUS THAT NUMBER
SORBLK,	0	/STORAGE FOR CURBLK
WORDS,	0	/NUMBER OF WORDS PER BLOCK
INUNIT,	0	/INPUT UNIT IN LH OCT CHAR
OUTUNI,	0	/OUTPUT UNIT IN LH OCT CHAR
RESTOR,	0	/NUMBER OF WORDS TO COPY 
RESAVE,	0	/NEGATIVE OF BLKCNT
SMICAR,	0	/CHARACTER STORAGE
SMISUM,	0	/RUNNING SUM
SPELIN,	0	/POINTER
SEAZIK,	0	/INPUT AREA
SEAZOK,	0	/TEMP STORAGE
DECTWC,	0	/FLAG TO DETERMINE IF VALIDATION WILL OCCUR
DECTCA,	0	/CURRENT ADDRESS STORE
FIRST,	0	/STARTING BLOCK NUMBER
LAST,	0	/LAST BLOCK NUMBER
LENGTH,	0	/NUMBER OF WORDS TO COPY
PARITY,	0		/PARITY ERROR FLAG (COUNT)
MSKIN,	0		/NEGATIVE OF INUNIT
PARDEL,	PSTACK		/POINTER TO PARITY TABLE
/
/ PAGE ZERO SUBROUTINES
DIREC,	0
	CLA
	DTRA		/FIND DIRECTION
	AND [400
	SZA CLA		/BRANCH BACK
	ISZ DIREC	/REVERSE DIRECTION EXIT
	JMP I DIREC	/FORWARD DIRECTION EXIT
/
/
BACKUP,	0		/SUBROUTINE REWINDS TAPE
	CLA
	DTRA
	AND (670	/CLEAR DIRECTION AND MOVEMENT
	DTXA
	TAD (600	/GO IN REVERSE
	DTXA
	DTSF
	JMP .-1		/WAIT UNTILL DONE
	JMS I [ERROR	/BUSYWORK FOR ERRORS
	JMP I BACKUP	/EXIT ON ENDZONE ERROR
	JMP BACKUP+1
\f	
*200
BEGIN,	CLA CLL	/INITIALIZE
	DTLB
	TLS	/TELETYPE OUTPUT
	JMS I [SPEAK
	MESS0
	JMS I [SPEAK
	MESS1	/INPUT UNIT NUMBER
	JMS GETNUM	/CHECK INPUT UNIT NUMBER
	DCA INUNIT
	TAD INUNIT
	CIA		/SET UP INPUT UNIT MASK
	DCA MSKIN
	JMS I [SPEAK
	MESS2	/OUTPUT UNIT NUMBER
	JMS GETNUM
	TAD MSKIN	/MAKE SURE UNITS ARE DIFFERENT
	SNA
	JMP BEGIN	/INPUT ERROR
	TAD INUNIT
	DCA OUTUNI
	JMS I [SPEAK	/GET FIRST BLOCK NUMBER
	MESSA
	JMS I [SMIGIT
	NOP	
	DCA CURBLK
	TAD CURBLK
	CIA	/STORE BEGINNING MARKER
	DCA FIRST
	JMS I [SPEAK	/GET LAST BLOCK NUMBER
	MESSB
	JMS I [SMIGIT
	CLA CMA	/KLUDGE IF NO INPUT
	DCA LAST
	TAD FIRST
	CLL
	SZA
	TAD LAST	/MAKE SURE VALID
	SZA SNL CLA
	JMP BEGIN
	DTLB
	TAD INUNIT		/INIT INPUT UNIT
	JMS I [FIXTAP
	DCA WORDS		/SET UP BLOCK LENGTH
	TAD OUTUNI		/INIT OUTPUT UNIT
	JMS I [FIXTAP
	CIA			/MAKE SURE BLOCK LENGTH
	TAD WORDS		/SAME ON INPUT AND OUTPUT
	SZA CLA
	JMP BADLEN		/BLOCK LENGTH ERROR
	JMS I [SPEAK		/TYPE OUT BLOCK LENGTH
	MESS3
	TAD WORDS
	JMS I [TYPNUM
	JMS I [SPEAK		/SEND <RETURN><LINE FEED>
	MESS0+11
	TAD WORDS
	CIA	/COMPUTE NUMBER OF BLOCKS
	DCA LENGTH	/TO READ AND WRITE
	DCA BLKCNT	/CLEAR BLOCK COUNTER
	TAD [3014	/LOAD BUFFER SIZE
	TAD LENGTH
	SPA
	JMP BADLEN	/TOO MANY WORDS PER BLOCK
	ISZ BLKCNT	/TALLY
	TAD LENGTH
	SMA
	JMP .-3 /CONTINUE COUNTING
	TAD WORDS	/GET NUMBER OF
	TAD [-3014	/WORDS TO READ
	CIA	/AND TO WRITE
	DCA RESTOR	/PRESERVE IN RESTOR
	TAD RESTOR
	DCA LENGTH
	TAD BLKCNT	/SAVE NEGATIVE OF BLKCNT
	CIA
	DCA RESAVE
	JMS I [SPEAK
	MESSC
	JMS I [SMIGIT
	NOP
	DCA DECTWC	/SET UP VERIFY FLAG
/
/ MAIN LOOP FOR COPY
LETS,	TAD CURBLK	/CHECK FOR PARTIAL BLOCK TO COPY
	TAD BLKCNT
	CLL CMA IAC
	TAD LAST
	SZL
	JMP LETT	/COPY FULL LENGTH
	DCA LENGTH	/ADJUST WORDS TO COPY
	TAD RESTOR
	CIA
	TAD WORDS
	ISZ LENGTH
	JMP .-2	/COMPUTE PROPER LENGTH
	CIA
	TAD WORDS
	DCA LENGTH
	TAD [REVERS	/KLUDGE COPY EXIT
	DCA I [COPY
	JMP I [COPY+1	/PERFORM THIS COPY
LETT,	JMS I [COPY	/COPY THIS BLOCKS
	TAD BLKCNT
	TAD BLKCNT	/ADVANCE CURRENT BLOCK
	TAD CURBLK
	DCA CURBLK
	JMS DIREC
	JMP LETU	/FORWARD EXCEEDED CHECK
LETR,	TAD CURBLK	/REVERSE CHECK
	TAD FIRST
	CMA
	SZA CLA		/CHECK FOR MINUS 1
	JMP LETT	/CONTINUE COPY
	JMP I [DONE	/FINISHED JOB
LETU,	TAD CURBLK
	CLL CMA IAC
	TAD LAST
	SZL CLA	/CHECK FOR END OF TAPE
	JMP LETS
	JMP I [REVERV




/ THIS SUBROUTINE GETS INPUT
/ AND OUTPUT UNIT NUMBERS FROM
/ THE TELETYPE AND VALIDATES THEM.
/
GETNUM, 0
	JMS I [SMIGIT
	NOP
	AND [7
	CLL RTR		/MOVE TO LH THREE BITS
	RTR
	JMP I GETNUM
/
/
	
BADLEN,	JMS I [SPEAK		/BLOCK LENGTH ERROR
	MESS3A
	JMP BEGIN
/
/
/
PAGE
\f	
/
/ THIS TURN AROUND IS ENTERRED 
/ WHEN THE LAST COPY MOVED INTO
/	THE FINAL DATA AREA
REVERV, TAD LAST
	DCA CURBLK	/START OF COPY BACK
	JMS REVALT	/CHANGE INUNIT AND OUTUNI
	TAD INUNIT
	DTCA DTXA
	JMS I [RESET	/REPOSITION TAPE
	TAD OUTUNI
	DTCA DTXA
	JMS I [RESET	/REPOSITION TAPE
REBACK, TAD CURBLK
	CMA	/COMPUTE NEW COPY LENGTH
	TAD SORBLK
	TAD BLKCNT
	SNA
	JMP REVERS	/KLUDGE IF NOTHING TO DO
	DCA SORBLK	/MINUS # OF BLOCKS
	TAD SORBLK
	DCA BLKCNT	/SAVE THIS NUMBER
	TAD WORDS
	ISZ SORBLK
	JMP .-2
	DCA LENGTH	/LENGTH FOR COPY
	JMS I [COPY	/PERFORM IT
	TAD CURBLK
	TAD BLKCNT
	TAD RESAVE	/ADVANCE CURBLK
	DCA CURBLK
	TAD RESAVE
	DCA BLKCNT
	TAD RESTOR
	DCA LENGTH
	JMP I [LETR	/CONTINUE COPY
/
/
/ THIS TURN AROUND IS ENTERRED
/ WHEN THE LAST SEARCH FOR
/ CURRENT BLOCK CAUSED AN END
/ OF TAPE ERROR
/
REVERT, JMS DIREC
	SKP
	JMP I [DONE	/FINISHED IF DIRECTION REVERSE
	TAD SORBLK
	DCA CURBLK	/RESTORE CURBLK
	TAD OUTUNI	/RESET LOCATION OF 
	DTCA DTXA	/OUTPUT DECTAPE AND
	JMS I [RESET	/FIND LAST BLOCK
	TAD [4000	/BY LOOKING FOR IMAGINARY
	JMS I [SEARCH	/BLOCK NUMBER (KLUDGING SEARCH)
	NOP
	JMP .-3	/TRY AGAIN ON ERRORS
	TAD SEAZIK	/MUST BE LAST BLOCK NUMBER
	DCA CURBLK
	JMS REVALT	/CHANGE INUNIT AND OUTUNI
	JMP REBACK
/
/
/ THIS TURN AROUND IS ENTERRED WHEN THE
/ END BLOCK FOR COPY WAS REACHED BY A
/ PARTIAL BUFFER COPY.
/
REVERS, CLA CMA	/ADJUST CURBLK POINTER
	TAD SORBLK
	DCA CURBLK
	TAD RESAVE
	DCA BLKCNT	/MAKE BLKCNT NEGATIVE
	TAD RESTOR
	DCA LENGTH	/RESTORE COPY LENGTH
	JMS REVALT	/CHANGE INUNIT AND OUTUNI
	JMP I [LETR
/
REVALT, 0
	TAD OUTUNI
	TAD [400
	DCA OUTUNI	/REVERSE DIRECTION
	TAD INUNIT
	TAD [400
	DCA INUNIT	/REVERSE DIRECTION
	JMP I REVALT
/
\f	
/THIS SUBROUTINE PERFORMS THE OPERATION
/OF COPYING N BLOCKS AND VALIDATING
/THE OUTPUT.
/WHEN END OF TAPE IS REACHED THE ROUTINE
/BRANCHES TO "REVERS", OR TO REVERT 
/AS APPROPRIATE.
/
COPY,	0
	KSF	/CHECK FOR <^C>
	JMP .+5
	KRB
	TAD [-203
	SNA
	JMP I [7600
	CLA
	TAD INUNIT	/LOAD STAT REG A
	DTCA DTXA
	TAD [-3
	DCA BADTRY	/RESTORE ERROR COUNTER
	JMS I [DECTAP
COPO,	BUFIOT	/INPUT AREA
	30	/READ CODE
	NOP	/NORMAL RETURN
	TAD PARITY		/CHECK PARITY FLAG
	SZA
	JMP I [ERRPAR		/FIX MESSAGE FOR PARITY ERRORS
COPZ,	TAD OUTUNI	/(IGNORE END ZONE)
	DTCA DTXA	/OUTPUT UNIT & DIRECTION
COPYB,	JMS I [DECTAP	/WRITE OUTPUT TAPE
	BUFIOT	/OUTPUT BUFFER
	50	/WRITE CODE
	JMP COPCPR	/NORMAL RETURN
	TAD [REVERS	/END ZONE RETURN
	DCA COPY	/FIX UP EXIT
COPCPR, TAD CURBLK
	DCA SORBLK	/STORE CURRENT BLOCK NUMBER
	TAD DECTWC
	SZA CLA
	JMP I COPY	/NO VERIFICATION
	JMS I [RESET	/RETURN TO FRONT END
	JMS I [DECTAP	/READ DATA
COPR,	BUFCHK	/INPUT AREA
	30	/READ CODE
	JMP .+2	/NORMAL RETURN BRANCH
	TAD I [WC	/END ZONE RETURN
	TAD LENGTH
	CIA
	DCA TRASH3	/COUNTER
	TAD COPO	
	DCA 17	/FORWARDS POINTER
	TAD COPR	/REREAD BUFFER
	DCA 16	/SET UP POINTER
COPCML, TAD I 16
	CIA
	TAD I 17
	SZA
	JMP COPERR	/MISMATCH ON READ
	ISZ TRASH3	/ANY MORE WORDS
	JMP COPCML	/LOOP
	JMP I COPY	/MADE IT! EXIT
COPERR, ISZ BADTRY	/HOW MANY ATTEMPTS
	JMP COPERS	/TRY AGAIN
	JMS I [SPEAK
	MESS5	/RE-READ ERRORS
	JMS I [TUNIT	/TYPE UNIT NUMBER AND WAIT
	TAD [-3
	DCA BADTRY	/RESTORE ERROR COUNTER
COPERS, CLA
	JMS I [RESET
	JMP COPYB	/WRITE OUT BLOCK AGAIN
/
PAGE
\f	
/ THIS SUBROUTINE MOVES THE DECTAPE
/ BACK IN PREPARATION FOR ANOTHER
/ READ OR WRITE.
/
RESET,	0
	CLA CLL	/CLEAR AC AND LINK
	TAD [400	/CHANGE DIRECTION
	DTXA
	JMS DIREC	/FIND DIRECTION
	TAD [6	/FORWARD MAKE +3
	TAD [-3	/REVERSE MAKE -3
	TAD CURBLK
	SPA	/MAKE SURE VALUE IS PLUS
	JMP RESEV
	JMS I [SEARCH	/FIND THIS BLOCK
	SKP CLA	/FOUND IT
	JMP RESET+4
REEXT,	DTRA
	AND [200	/CLEAR STOP-GO FLAG
	TAD [400	/AND REVERSE DIRECTION
	DTXA
	JMP I RESET
RESEV,	JMS BACKUP	/REWIND THIS TAPE
	JMP REEXT
/
/
/ THIS BRANCH IS TKEN WHEN
/ ALL COPYING IS COMPLETED
DONE,	JMS I [SPEAK
	MESS4
	JMS I [SMIGIT
	JMP I [BEGIN

	JMP I [BEGIN
\f	
/THIS SUBROUTINE READS NUMBERS,
/NOT EXCEEDING 4098, FROM A TELETYPE
/AND RETURNS THE OCTAL VALUE OF INPUT.
/THE FOLLOWING SPECIAL CHARACTERS
/ARE USD...<RETURN> MARKS END OF INPUT, CAUSES A <CR><LF>
/IF THE <RETURN> IS THE FIRST CHARACTER THEN
/DIRECT RETURN IS TAKEN, ELSE RETURN IS TO ENTRY+2
/	<^C> CAUSES A BRANCH TO 7600
/
SMIGIT, 0
	KCC		/INITIALIZE TTY INPUT
	DCA SMISUM		/CLEAR TEMP STORAGE
	JMS TTYIN		/GET CHAR
	AND	[177
	TAD	[200
	TAD [-215		/CHECK FOR <RETURN>
	SNA
	JMP SMIXIT		/EXIT ON FIRST <RETURN>
	ISZ SMIGIT		/ADVANCE EXIT POINTER
SMIGOP,	TAD [12			/CHECK FOR ^C
	SNA
	JMP I [7600		/BRANCH TO MONITOR
	TAD [-65		/CHECK FOR DIGITS
	CLL
	TAD [10
	SNL
	JMP SMILOP		/INVALID CHARACTER
	DCA SMICAR		/TEMP STOR
	TAD SMISUM		/GET CHARACTER STRING
	CLL RAL
	CLL RAL
	CLL RAL			/ROTATE TO LH POSITION
	TAD SMICAR		/APPEND CURRENT DIGIT
	DCA SMISUM
	TAD SMICAR
	TAD [260		/MAKE ASCII
	JMS TYPE	/ECHO CHARACTER
SMILOP,	JMS TTYIN		/GET NEXT CHARACTER
	TAD [-215		/CHECK FOR <RETURN>
	SZA
	JMP SMIGOP		/CONTINUE LOOP
SMIXIT,	JMS I [SPEAK		/SEND A <RETURN><LINE FEED>
	MESS0+11
	TAD SMISUM		/GET INPUT STRING
	JMP I SMIGIT		/EXIT


/THIS SUBROUTINE READS A CHARACTER FROM THE TTY
TTYIN,	0
	KSF			/WAIT UNTIL READY
	JMP .-1
	KRB			/READ TTY BUFFER
	JMP I TTYIN
\f
/THIS SUBROUTINE TYPES OUT A
/DIGIT STRING FROM THE AC
/AS FOUR OCTAL CHARACTERS
TYPNUM,	0
	DCA SMICAR		/PRESERVE STRING VALUE
	TAD [-4
	DCA SMISUM	/INITIALIZE COUNTER
TYPXL,	TAD SMICAR
	RTL
	RAL			/GET NEXT PRINT DIGIT
	DCA SMICAR		/RETURN TO STRING
	TAD [3
	AND SMICAR
	RAL			/ENTER CURRENT DIGIT
	TAD [260		/MAKE ASCII
	JMS TYPE		/TYPE DIGIT
	ISZ SMISUM		/COUNT DIGITS
	JMP TYPXL		/COUNTINUE LOOP
	JMP I TYPNUM		/EXIT

\f	
/THIS SUBROUTINE TYPES OUT A
/MESSAGE IN "TEXT" FORMAT TWO
/ASCII CHARACTERS PER WORD.
/SPECIAL CHARACTERS ARE NOT
/PERMITTED.	A CARRIGE RETURN
/AND LINE FEED PRECEED THE
/MESSAGE.
/	JMS I [SPEAK <BRANCH TO SUBROUTINE>
/	MESSAGE <POINTER TO MESSAGE BUFFER>
/A ZERO WORD MARKS THE
/END OF THE MESSAGE.
/
SPEAK,	0
	CLA CLL
	TAD [215
	JMS I [TYPE	/CARRIGE RETURN
	TAD I SPEAK	/GET ADDRESS OF OUTPUT
	DCA SPELIN
	ISZ SPEAK
	TAD [212	
	JMS I [TYPE	/LINE FEED
SPEELH, TAD I SPELIN	/GET NEXT WORD
	SNA	/CHECK FOR ZERO
	JMP I SPEAK	/EXIT IF ZERO
	AND [7700	/GET LH CHARACTER
	CLL RTR	/MOVE TO
	RTR	/RIGHT HAND
	RTR	/SIX BITS
	JMS SPEOUT	/TRANSLATE AND OUTPUT
	TAD I SPELIN
	ISZ SPELIN	/ADVANCE POINTER
	AND [77	/GET RH CHARACTER
	JMS SPEOUT	/TRANSLATE AND OUTPUT
	JMP SPEELH
SPEOUT, 0
	TAD [-40	/CHECK FORMAT
	SMA
	TAD [-100	/KLUDGE DIGITS FORMAT<200+XX>
	TAD [340	/ALPHA FORMAT <300+XX>
	JMS I [TYPE	/OUTPUT IT
	JMP I SPEOUT	/RETURN

/
/THIS SUBROUTINE TYPES OUT
/THE ASCII CHARACTER IN THE AC.
/
TYPE,	0
	TSF	/WAIT UNTIL READY
	JMP .-1
	TLS	/TYPE CHARACTER
	CLA
	JMP I TYPE
/
/THIS SUBROUTINE TYPES OUT THE 
/CURRENT UNIT NUMBER
TUNIT,	0
	CLA
	DTRA
	AND [7000	/GET CURRENT UNIT NUMBER
	CLL RTL		/MOVE OVER
	RTL
	TAD [260	/MAKE ASCII CODE
	JMS I [TYPE	/TYPE IT
	JMS I [SMIGIT	/WAIT
	JMP I TUNIT	/EXIT
	JMP I TUNIT
/
/
PAGE
\f	
/THIS SUBROUTINE SEARCHES DECTAPE
/IN A FORWARD OR REVERSE DIRECTION.
/STATUS REGISTER A SHOULD CONTAIN
/UNIT SELECT NUMBER (0-2), FORWARD
/OR REVERSE, AND A5=1.
/THE BLOCK NUMBER FOR WHICH THE PROGRAM IS
/SEARCHING MUST BE IN THE AC.
/ON ERROR RETURN THE COMAND
/FOLLOWING THE "JMS" IS SKIPPED,
/AN END OF TAPE ERROR WILL CAUSE
/THREE MOVES INTO ENDZONE AND TWO COMMANDS FOLLOWING
/THE "JMS" ARE SKIPPED
SEARCH, 0
	CIA	/FORM TWO'S COMPLEMENT
	DCA SEAZOK	/STORE - BLOCK NUMBER
	DCA SEAZIK	/CLEAR INPUT WORD
	DTRA
	AND [274
	DTXA	/CLEAR OUT A REGISTER
	TAD [210	/START DEVICE
	DTXA
	JMS DIREC	/DETERMINE DIRECTION
	TAD [NOP-CIA	/FORWARD...FIX TO "NOP"
	TAD [CIA	/REVERSE...FIX TO "CIA"
	DCA SEATIX	/FIX UP COMMAND
	TAD [SEAZIK	/BLOCK NUMBER INPUT
	DCA I [CA	/PUT IN CURRENT ADDRESS
	CLA CMA	/NUMBER OF BLOCKS=1
	JMS SEARUN	/FIND FIRST BLOCK MARK
	TAD [100		/SET CONTINUOUS MODE FLAG
	DTXA
	TAD SEAZIK	/BLOCK NUMBER HERE
	TAD SEAZOK	/MINUS BLOCK NUMBER THERE
SEATIX, NOP	/IFSEARCHING IN REVERSE DIRECTION
*.-1
	CIA	/IF SEARCHING IN FORWARD DIRECTION
	SPA	/SKIP IF DONE
	JMS SEARUN	/FIND "N" BLOCK MARKS
	DTRA
	AND [100		/CLEAR CONTINUOUS MODE FLAG
	DTXA
	JMP I SEARCH	/NORMAL EXIT
SEARUN, 0
	DCA I [WC	/NUMBER OF BLOCKS TO READ
	DTXA
	DTSF	/CHECK FOR DONE
	JMP .-1
	DTRB	/READ STATUS REGISTER B
	SMA CLA
	JMP I SEARUN	/DT FLAG...NORMAL EXIT
	JMS I [ERROR	/HANDLE ALL ERRORS
	ISZ SEARCH	/END OF TAPE ERROR
	ISZ SEARCH	/ALL OTHER ERRORS
	JMP SEARUN-4	/EXIT

\f	
/THIS SUBROUTINE READS OR WRITES
/<N> WORDS, IN CONTROL MODE, ON
/A BLOCK(S) ASSUMING THAT
/THE DECTAPE IS PROPERLY
/POSITIONED. IN LINE CODE:
/	JMS I [DECTAP
/	<BUFFER> ADDRESS TO READ INTO (OR WRITE FROM) -1
/	<3> IF READ, <5> IF WRITE
/<<NORMAL RETURN>>
/<<END OF TAPE ERROR>>
/AN END OF TAPE ERROR WHILE SEARCHING
/CAUSES A BRANCH TO "REVERT".
/STATUS REGISTER A SHOULD CONTAIN:
/AO-2 UNIT NUMBER
/A3 FORWARD=0, REVERSE=1
/A4 UNIMPORTANT, SHOULD BE ZERO
/A5	1
/A6-8,89 UNIMPORTANT
/BLOCK NUMBER IN PAGE ZERO "CURBLK"
/NUMBER OF WORDS TO READ OR
/WRITE IS IN PAGE ZERO "LENGTH"
/
DECTAP, 0
	TAD I DECTAP	/GET INPUT BUFFER
	DCA DECTCA	/STORE
	ISZ DECTAP
DECAGN, TAD CURBLK	/SEARCH FOR BLOCK
	JMS I [SEARCH
	JMP DECRUN	/FOUND IT
	JMP DECAGN
	JMP I [REVERT	/END ZONE ERROR
DECRUN, TAD SEAZIK
	TAD SEAZOK	/CHECK TO SEE IF FOUND BLOCK
	SZA
	JMP DECEXT-3
	TAD LENGTH	/SET UP WORD COUNT
	CIA
	DCA I [WC
	TAD DECTCA	/AND INPUT OUTPUT BUFFER
	DCA I [CA
	TAD I DECTAP	/GET READ OR WRITE
DECLOP, DTXA	/START GOING
	DTSF
	JMP .-1
	DTRB	/GET FLAGS
	SMA
	JMP DECEXI
	JMS I [ERROR
	JMP DECEXT-1	/ENDZONE ERROR
	JMS I [RESET	/RESTORE POINTERS
	JMP DECAGN
	ISZ DECTAP	/END OF TAPE EXIT
DECEXT, ISZ DECTAP
	CLA
	JMP I DECTAP	/FINISHED
DECEXI, CLA
	TAD I [WC	/HAVE WE FINISHED?
	SZA CLA
	JMP DECLOP	/NO-:CONTINUE READ-WRITE
	DTRA	/YES--CLEAR STATUS
	AND [274
	DTXA
	JMP DECEXT
\f	
/THIS SUBROUTINE CHECKS THE CONTENTS
/OF STATUS REGISTER B.
/	<BRANCH> JMS I [ERROR
/	<+1 END OF TAPE ERROR>
/	<+2 ALL OTHER ERRORS>
/IN ADDITION: 1--A SELECT ERROR WILL
/CAUSE A TYPEOUT AND HALT. 2--A PARITY
/ERROR ON OUTPUT TAPE CAUSES A
/BRANCH TO "COPERS"; ON INPUT TAPE
/"PARITY ERROR" IS TYPED OUT. 3--GO FLIP-FLOP
/AND STATUS REGISTER A6-8 WILL BE CLEARED.
/
ERROR,	0
	CLA CLL
	DTRB			/GET ERROR FLAGS
	AND [200		/PARITY ERROR FLAG
	SNA CLA
	JMP ERNOT		/HANDLE OTHER ERRORS
	DTXA			/CLEAR FLAGS, CONTINUE READ MODE
	DTRA			/GET UNIT NUMBER
	AND [7000
	TAD MSKIN		/CHECK FOR INPUT UNIT
	SZA
	JMP I [COPERR		/ERROR ON OUTPUT UNIT
	TAD I [WC		/PUT WORD COUNT IN PUSH
	CIA
	DCA I PARDEL		/DOWN STACK
	ISZ PARDEL		/ADVANCE POINTER
	ISZ PARITY		/SET FLAG
	JMP I [DECEXI		/RETURN TO READ
ERNOT,	DTRA	/GET STATUS REGISTER A
	AND [274
	TAD [2	/DO NOT DISTURB ERROR FLAGS
	DTXA	/CLEAR A4 AND A6-8
	DTRB	/GET ERROR FLAGS
	RTL
	SMA	/SKIP IF END OF TAPE ERROR
	JMP ERROTH
	CLA
	TAD [-3		/LOAD -3
	DCA ERRSOR	/STORE IN COUNT
	TAD [200	/GO FLIP-FLOP
	DTXA	/SET
	DTSF
	JMP .-1
	ISZ ERRSOR	/HAVE WE DONE THREE TIMES
	JMP .-5
	JMP I ERROR	/EXIT
ERRSOR, 0
ERROTH, ISZ ERROR	/CHANGE ERROR BRANCH
	SZL
	CLA CLL		/MARK TRACK ERROR
	RTL
	SNL CLA
	JMP I ERROR		/TIMING ERROR BRANCH
	JMS I [SPEAK	/SELECT ERROR MESSAGE
	ERRSEL
ERRUNT, JMS I [TUNIT
	JMP I ERROR
/
PAGE
\f	
/ VARIOUS MESSAGES
MESS0,	TEXT %DECTAPE COPY V10A %
MESSA,	TEXT %FIRST BLOCK TO COPY (OCTAL) %
MESSB,	TEXT %FINAL BLOCK TO COPY (OCTAL) %
ERRSEL, TEXT %SELECT ERROR ON UNIT #%
PMESS, TEXT %PARITY ERROR ON BLOCK %
MESSC,	TEXT %VERIFY OUTPUT? (0=YES, 1=NO): %
MESS1,	TEXT %FROM UNIT %
MESS2,	TEXT %TO UNIT %
MESS3,	TEXT %PDP-8 WORDS PER BLOCK %
MESS4,	TEXT %DONE%
MESS5,	TEXT %WRITE ERRORS ON UNIT #%
MESS3A,	TEXT %BLOCK LENGTH ERROR%
/
/
PAGE
/
/
\f
/THIS ROUTINE TYPES OUT PARITY ERROR MESSAGES
/AND RESTORES POINTERS TO THE PUSH DOWN STACK.
ERRPAR,	CIA
	DCA PARITY		/SET UP STACK COUNTER
	CLA CMA
	TAD PARDEL		/MOVE POINTER BACK
	DCA PARDEL
	JMS I [SPEAK		/TYPE OUT MESSAGE
	PMESS
	TAD CURBLK
EPLOOP,	DCA EPJK
	TAD I PARDEL		/CHECK FOR CORRECT BLOCK NUMBER
	TAD WORDS		/ADVANCE BLOCK WORDS COUNT
	DCA I PARDEL
	TAD I PARDEL
	CIA		/REACHED ORIGINAL VALUE?
	TAD LENGTH
	SNA CLA
	JMP EPTYP		/TYPE BLOCK AT ERROR
	JMS DIREC
	CLL CMA RAL		/ADD ONE IF FORWARD
	CMA			/SUBTRACT ONE IF NEGATIVE
	TAD EPJK		/NEXT BLOCK NUMBER
	JMP EPLOOP		/CONTINUE LOOP
EPTYP,	TAD EPJK
	JMS I [TYPNUM		/TYPE BLOCK NUMBER
	ISZ PARITY		/ADVANCE COUNTER
	JMP ERRPAR+2		/CONTINUE LOOP
	JMP I EPPEXT		/RETURN TO COPY
EPPEXT,	COPZ			/REENTRY TO COPY
EPJK,	0			/WORKING STORAGE
\f
/THIS SUBROUTINE READS A RANDOM
/BLOCK ON DECTAPE TO DETERMINE THE BLOCK LENGTH
FIXTAP,	0
	TAD [610		/FIX A REG. WORD
	DTCA DTXA		/LOAD A STAT. REG.
	CLA CMA
	DCA I [WC		/SEARCH FOR 1 BLOCK
	TAD [BUFIOT		/FIX CURRENT ADDRESS
	DCA I [CA		/TO READ INTO BUFFER
	DTSF			/WAIT AROUND
	JMP .-1
	DTRB
	SPA CLA
	JMP FIXERR		/HANDLE ERROR CONDITIONS
	TAD [30			/CHANGE TO READ MODE
	DTXA
	DTSF			/WAIT TILL READ DONE
	JMP .-1
	TAD [200		/STOP TAPE
	DTXA
	TAD I [WC		/GET BLOCK LENGTH
	JMP I FIXTAP		/EXIT
FIXERR,	JMS I [ERROR
	TAD [400		/END OF TAPE...REVERSE DIRECTION
	TAD [210		/START TAPE MOVING
	DTXA			/AND CLEAR FLAGS
	JMP FIXTAP+3		/TRY AGAIN
\f
/PARITY ERROR WORD COUNT STACK
PSTACK,	0


/

/END OF PROGRAM
$