.NLIST
;	.LIST	TTM	; LIST IN TELETYPE (80-COLUMN) MODE
;	.NLIST		; DON'T LIST ANYTHING
;	.NLIST	SYM	; DON'T LIST SYMBOL TABLE
;	.NLIST	COM	; DON'T LIST COMMENTS
;	.NLIST	SEQ	; DON'T LIST LINE NUMBERS
;	.NLIST	LOC	; DON'T LIST PC LOCATIONS
;	.NLIST	BIN	; DON'T LIST BINARY CODE
	.NLIST	CND	; DON'T LIST UNSATISIFED CONDITIONAL CODING
;	.LIST	MEB	; LIST MACRO EXPANSIONS
	.NLIST	BEX	; LIST ONLY 1ST LINE OF BINARY EXPANSIONS
	.ENABL	AMA	; LIST ABSOLUTE ADDRESSES
	.LIST
;
;************************************
	.TITLE	DSKCPY
;************************************
;
;
	.IDENT	/PMC004/
;
;
;	THIS TASK COPIES ANY TYPE OF DISK PACK TO ITS BACK-UP
;  PACK ON ANOTHER DRIVE.  IT MAY BE RUN "ON-LINE", SINCE THE
;  STATUS OF FILES (OPEN OR CLOSED) AND FILE PRIVILEGES HAVE
;  NO EFFECT ON ITS OPERATION.
;
;	THERE ARE TWO RESTRICTIONS --
;	1) DISK PACKS MUST BE MOUNTED [FOR] OR [DCF]
;	2) THE COPY (OBJECT) PACK MUST HAVE NO BAD BLOCKS.
;
;	<CTRL Z> IN RESPONSE TO ANY REQUEST FOR INFORMATION WILL
;	CAUSE THE TASK TO EXIT.
;
;	IN ANY "ONE-FOR-ONE" COPY PROGRAM, THE AIM IS TO HAVE
;  AN EXACT DUPLICATE OF THE SOURCE PACK, WITH THE EXCEPTION THAT
;  THE COPY PACK SHOULD HAVE ITS OWN IDENTIFICATION, AND DATE AND
;  TIME OF CREATION.  (LOCATED IN THE HOME BLOCK).
;
;	"BAD BLOCKS" ARE THE ONLY PROBLEM STANDING IN THE WAY OF
;  SUCH A REPRODUCTION.  THERE IS NO PARTICULAR PROBLEM IF THERE
; ARE NO BAD BLOCKS ON THE SOURCE PACK, OR IF THERE ARE BAD BLOCKS
; WHICH ARE SO MARKED IN THE "BAD" FILE.  
;
;	HOWEVER, IF THERE ARE UNREADABLE BLOCKS THAT ARE NOT MARKED
; AS BAD, THESE SHOULD BE MADE KNOWN, SINCE THEY ARE A SOURCE OF
; FUTURE PROBLEMS.  SUCH BLOCKS WILL NOT STOP THE COPY PROGRAM, SINCE
; THE LOGIC IS THAT THEY CANNOT BE READ UNDER ANY CIRCUMSTANCES, AND
; THAT A COPY SHOULD BE MADE BEFORE THE SOURCE PACK DETERIORATES ANY
; FURTHER.
;
;	AS INDICATED ABOVE, THE COPY PACK CANNOT HAVE ANY BAD BLOCKS
; ON IT.  IF IT DOES, THE COPY TASK WILL STOP WHEN IT FINDS THE FIRST
; ONE.  HOWEVER, IF THE SOURCE PACK HAS BAD BLOCKS MARKED IN THE "BAD"
; FILE, THESE SAME BLOCKS WILL BE MARKED AS BAD ON THE COPY PACK, EVEN
; THOUGH THEY ARE ACTUALLY GOOD BLOCKS.  THIS IS A NECESSARY REQUIRE-
; MENT.  THE ONLY WAY THESE BAD BLOCKS CAN EVER BE ELIMINATED IS
; BY COMPRESSING THE SOURCE PACK ONTO THE OBJECT PACK, USING TASK
; "DSC" OR "DDSC".
;
;	THE COMPLETE SEQUENCE OF ERROR HANDLING IS AS FOLLOWS:
;
;	1) IF A READ ERROR ON THE MULTI-BLOCK READ OCCURS, THE TASK
; 	MAKES 10 TRIES TO GET AN ERROR-FREE READ.
;
;	2) IF THE READ ERROR PERSISTS, THE TASK REVERTS TO THE
;	FIRST BLOCK OF THE GROUP AND BEGINS TO READ ONE BLOCK AT
;	A TIME.  
;
;	3) WHEN AN UNREADABLE BLOCK IS FOUND, A CHECK IS PERFORMED
;	TO SEE IF THE BLOCK IS MARKED AS "BAD" ON THE SOURCE PACK.
;	IF SO, THE TASK CONTINUES WITH NO MESSAGE.  GARBAGE IS
;	WRITTEN INTO THE CORRESPONDING BLOCK OF THE OBJECT PACK,
;	BUT THE BLOCK IS ALSO MARKED AS BAD, SO THERE IS NO PROBLEM.
;
;	4) IF THE BLOCK IS NOT MARKED AS BAD ON THE SOURCE PACK, AN
;	ERROR MESSAGE IS OUTPUT, TELLING THE BAD BLOCK NUMBER.  THE
;	BLOCK IS WRITTEN TO THE OBJECT PACK, BUT THE DATA MAY RANGE
;	FROM ONLY ONE BAD WORD (IN THE CASE OF A PARITY ERROR), TO
;	A FULL BLOCK OF GARBAGE DATA IF THE BLOCK IS NOT READ AT ALL.  THE
;	TASK CONTINUES.  THE SYSTEM MANAGER SHOULD TAKE SOME ACTION
;	ON THESE BLOCKS -- PROBABLY BY FIRST FINDING OUT WHAT FILE
;	THE BAD BLOCK IS IN AND RECONSTRUCTING THAT FILE -- AND THEN
;	COMPRESSING THE SOURCE PACK TO CREATE A NEW, ERROR FREE PACK.
;
;	5) IF A WRITE ERROR OCCURS ON THE MULTI-BLOCK WRITE, THE
;	TASK MAKES ONLY THREE EFFORTS TO WRITE, BEFORE REVERTING
;	TO A SINGLE BLOCK OPERATION.
;
;	6) IF THE SINGLE-BLOCK WRITE FAILS, THE TASK STOPS, UNDER
;	THE ASSUMPTION THAT THE COPY PACK IS NOT IN ACCEPTABLE
;	CONDITION.  *
;
;	* THERE MAY BE CERTAIN UNUSUAL CONDITIONS WHERE THE OPERATOR
;	WANTS THE COPYING TO CONTINUE, EVEN THOUGH THERE WILL BE
;	ERRORS ON THE PACK -- AS FOR EXAMPLE, IF AN ORIGINAL PACK
;	CONTAINING BAD BLOCKS IS BEING RE-BUILT FROM ITS BACK-UP
;	PACK, WHEN NO ERROR-FREE PACK IS AVAILABLE.  THE PROGRAM
;	PROVIDES THE OPTION OF CONTINUING AFTER A WRITE-ERROR, EVEN
;	THOUGH IT IS STRONGLY DISCOURAGED EXCEPT IN AN EMERGENCY
;	SITUATION.
;
;	THE TASK IS BUILT FOR THE MAXIMUM BUFFER SIZE.  THIS
;	  MAY BE REDUCED BY REDUCING THE VALUE OF EXTTSK IN THE
;	  TASK-BUILDER COMMAND FILE.  THE TASK WILL BE SMALLER,
;	  BUT WILL RUN SLOWER.
;
;	THE TASK STARTS AT LABEL "START".  ALL DATA AND INSTRUC-
;	TIONS FROM LABEL "DEVTBL" TO THE END OF THE TASK ARE
;	OVERLAID BY THE MAIN I/O BUFFER.
;
;	ADDITIONAL DISK DEVICES MAY BE DEFINED BY ADDING THEM
;	INTO THE TABLE LOCATED AT LABEL "DEVTBL".  ANY DEVICE IN
;	THE PUD TABLE MAY BE ENTERED, INCLUDING PSEUDO DEVICES,
;	PROVIDING THE PSEUDO DEVICE HAS BEEN REDIRECTED TO AN
;	ACTUAL DEVICE.
;
;	LUN 1 IS THE TT.
;	LUN 2 IS THE OUTPUT PACK.
;	LUN 3 IS THE INPUT PACK
;
;
	.SBTTL	MACROS
	.PAGE
	.MCALL	QIOW$S, ALUN$S, EXIT$S, HMBOF$, DEF$L
	.MCALL	FHDOF$, GLUN$S, GTSK$S
;
	HMBOF$	; DEFINE HOME BLOCK SYMBOLS LOCALLY
	FHDOF$	; DEFINE FILE HEADER SYMBOLS LOCALLY
	DEF$L
;
; MACRO FOR OUTPUTTING MESSAGES TO THE CONSOLE
	.MACRO MSG A
	MOV	#'A',R4
	MOV	#'A'L,R5
	CALL	TYPE
	.ENDM
;
;  MACRO FOR READING IN DATA WITH A PROMPT MESSAGE
;  A IS THE ADR OF THE PROMPT MESSAGE, B IS THE LENGTH OF THE
;  INPUT ARRAY, AND C IS THE ADR OF THE INPUT ARRAY.
	.MACRO	GETANS	A,B,C
	.IF NB C
	.IFT
	MOV	#C,R2
	.IFF
	MOV	#DATA,R2
	.ENDC
	.IF NB B
	.IFT
	MOV	#B,R3
	.IFF
	MOV	#1,R3
	.ENDC
	MOV	#'A',R4
	MOV	#'A'L,R5
	CALL	INPUT
	.ENDM
	.SBTTL	ACTUAL COPY SECTION OF TASK
	.PAGE
CR=15
LF=12
;
BAD:	.BLKW	256.	; BUFFER FOR BAD-BLOCK FILE HEADER
BADSW:	.WORD	0	; VALIDITY SWITCH FOR BAD BLOCK FILE
BLOCKS:	.BLKW	1	; SIZE OF I/O BUFFER IN BLOCKS
BYTES:	.BLKW	1	; BYTES READ OR WRITTEN ON EACH I/O
IOST:	.BLKW	2	; I/O STATUS BLOCK
NAME:	.BLKB	12.	; LABEL TO BE USED ON COPY PACK
BLKCT:	.BLKW	2	; COUNT OF BLOCKS TO BE COPIED
DATA:	.BLKW	16.	; BUFFER FOR KEYBOARD INPUT
M10:	.ASCII	<CR><LF><LF>\  DSKCPY COMPLETE\
M10L=.-M10
M11:	.ASCII	<CR><LF>\  DISK READ ERROR \
M11A:	.BLKB	3
	.ASCII	\ IN BLOCK \
M11B:	.BLKB	12.
M11L=.-M11
M12:	.ASCII	<CR><LF>\  DISK WRITE ERROR \
M12A:	.BLKB	3
	.ASCII	\ IN BLOCK \
M12B:	.BLKB	12.
	.ASCII	<CR><LF><LF>\  STRONGLY URGE COPYING BE HALTED.\
	.ASCII	<CR><LF>\  DO YOU WANT TO CONTINUE REGARDLESS? [Y/N]   \
M12L=.-M12
;
	.EVEN
;*******************************************
;	START OF COPY LOOP
;*******************************************
COPY:
40$:
	TST	BLKCT		; SEE IF ANY BLOCKS LEFT TO DO
	BNE	45$
	TST	BLKCT+2
	BEQ	85$		; ALL DONE IF BOTH WORDS 0
	CMP	BLOCKS,BLKCT+2
	BLOS	45$
	MOV	BLKCT+2,R3	; NEW BYTE SIZE AT VERY END
	ASH	#9.,R3
	CLR	BLKCT+2
	BR	47$
45$:
	SUB	BLOCKS,BLKCT+2
	SBC	BLKCT
	MOV	BYTES,R3	; BYTES TO BE READ
47$:
	MOV	#10.,R1
50$:
  QIOW$S  #IO.RLB,#3,#1,,#IOST,,<#BUF,R3,#0,R4,R5>
	TSTB	IOST
	BGT	60$
	SOB	R1,50$		; READ 10 TIMES BEFORE ERROR
	CALL	ONEBLK
	BR	40$
;
; WRITE TO OUTPUT DEVICE ONLY THRICE BEFORE ERROR STOP
60$:
	MOV	#3,R1
70$:
  QIOW$S  #IO.WLB,#2,#1,,#IOST,,<#BUF,R3,#0,R4,R5>
	TSTB	IOST
	BGT	80$
	SOB	R1,70$
	CALL	ONEBLK
	BR	40$
;
; GO TO NEXT BLOCK GROUP
80$:
	ADD	BLOCKS,R5
	ADC	R4
	BR	40$
;
;********************************************
;	END OF COPY LOOP
;********************************************
;
; AFTER ALL BLOCKS HAVE BEEN COPIED,
; PREPARE TO STORE LABEL, DATE, AND TIME IN HOME BLOCK
;
; READ HOME BLOCK
85$:
	CALL	READHM
;
; STORE LABEL
	MOV	#12.,R0
	MOV	#BUF+H.VNAM,R1
	MOV	#NAME,R2
90$:
	MOVB	(R2)+,(R1)+
	SOB	R0,90$
;
; GET DATE 
	MOV	#BUF+H.VDAT,-(SP)
	MOV	#1,-(SP)
	MOV	SP,R5
	CALL	DATE
	ADD	#4,SP
;
; STORE DATE, ELIMINATING DASHES
	MOV	#BUF+H.VDAT+2,R0
	MOV	R0,R1
	INC	R1
	MOVB	(R1)+,(R0)+
	MOVB	(R1)+,(R0)+
	MOVB	(R1)+,(R0)+
	INC	R1
	MOVB	(R1)+,(R0)+
	MOVB	(R1),(R0)
;
; GET TIME
	MOV	#BUF+H.VDAT+7,-(SP)
	MOV	#1,-(SP)
	MOV	SP,R5
	CALL	TIME
	ADD	#4,SP
;
; STORE TIME, ELIMINATING COLONS
	MOV	#BUF+H.VDAT+9.,R0
	MOV	R0,R1
	INC	R1
	MOVB	(R1)+,(R0)+
	MOVB	(R1)+,(R0)+
	INC	R1
	MOVB	(R1)+,(R0)+
	MOVB	(R1),(R0)
;
; CALCULATE AND STORE CHECKSUMS
	MOV	#H.CHK1,R0
	ASR	R0
	MOV	#BUF,R2
	CLR	R1
100$:
	ADD	(R2)+,R1
	SOB	R0,100$
	MOV	R1,BUF+H.CHK1
	MOV	#255.,R0
	MOV	#BUF,R2
	CLR	R1
110$:
	ADD	(R2)+,R1
	SOB	R0,110$
	MOV	R1,BUF+H.CHK2
;
; WRITE BACK HOME BLOCK AND EXIT
	CLR	R4
	MOV	#1,R5
	QIOW$S	#IO.WLB,#2,#1,,#IOST,,<#BUF,#512.,#0,R4,R5>
	MSG	M10
	EXIT$S
	.SBTTL	SUBROUTINES USED BY BOTH SECTIONS OF TASK
	.PAGE
; SUBROUTINE TO TYPE MESSAGE ON CONSOLE
TYPE:
	QIOW$S	#IO.WAL,#1,#1,,#IOST,,<R4,R5>
	RETURN
;
; SUBROUTINE TO READ OBJECT PACK HOME BLOCK
READHM:
	CLC
	CLR	R4
	MOV	#1,R5
	QIOW$S	#IO.RLB,#2,#2,,#IOST,,<#BUF,#512.,#0,R4,R5>
	CLC
	TSTB	IOST
	BGT	10$
	SEC
10$:
	RETURN
;
; SUBROUTINE TO SOLICIT INPUT WITH PROMPT MESSAGE
INPUT:
	CLC
	QIOW$S  #IO.RPR,#1,#1,,#IOST,,<R2,R3,,R4,R5>
	CMP	IOST,#IE.EOF
	BEQ	10$
	CMP	#1,R3
	BNE	5$
	BICB	#40,DATA
	CMPB	#'Y,DATA
	BEQ	5$
	SEC
5$:
	RETURN
10$:
	EXIT$S
;
; SUBROUTINE TO COPY ONE BLOCK AT A TIME
; IF THERE IS STILL AN I/O ERROR AFTER THE REQUIRED
; NUMBER OF TRIES, READ AND WRITE EACH OF THE (60) BLOCKS
; INDIVIDUALLY TO FIND THE BAD BLOCK.  THEN CONTINUE IF
; IT IS AN INPUT ERROR, BUT EXIT ON AN OUTPUT ERROR.
ONEBLK:
	MOV	BLOCKS,R2
20$:
	QIOW$S	#IO.RLB,#3,#1,,#IOST,,<#BUF,#512.,#0,R4,R5>
	TSTB	IOST
	BGT	30$
	CALL	INERR
30$:
	QIOW$S	#IO.WLB,#2,#1,,#IOST,,<#BUF,#512.,#0,R4,R5>
	TSTB	IOST
	BGT	31$
	CALL	OUTER
31$:
	ADD	#1,R5
	ADC	R4
	SOB	R2,20$
	RETURN
;
; SUBROUTINE ON AN INPUT ERROR
; IF THE BLOCK IS MARKED AS BEING BAD, CONTINUE WITH NO ERROR
; MESSAGE.  IF THE BLOCK IS NOT MARKED BAD, PRINT AN ERROR
; MESSAGE, BUT DO NOT EXIT FROM TASK.
INERR:
	MOV	R3,-(SP)	; SAVE R3 AND R2
	MOV	R2,-(SP)
	TST	BADSW	; SEE IF BAD BLOCK FILE IS PRESENT
	BEQ	8$	; IF NOT, READ-ERROR MSG
	MOVB	BAD+M.USE,R0	; WORDS OF RETRIEVAL POINTER IN USE
	BEQ	8$	; IF NONE, READ-ERROR MSG
	MOV	BAD+M.RTRV,R1	; START OF RETRIEVAL POINTERS
	ASR	R0	; NUMBER OF POINTERS IN USE
2$:
	MOVB	1(R1),R2	; # OF CONTIG BLKS - 1
	BIC	#177400,R2
	INC	R2
	MOV	2(R1),R3	; 1ST BLOCK IN GROUP
4$:
	CMP	R3,R5	; MATCH THE ERROR BLOCK?
	BNE	6$
	CMPB	1(R1),R4	; CHECK HIGH ORDER
	BEQ	10$		; NO ERROR MSG IF MATCH
6$:
	INC	R3	; NEXT BLOCK IN GROUP
	SOB	R2,4$
	ADD	#4,R1	; NEXT GROUP OF BAD BLOCKS
	SOB	R0,2$
;
; OUTPUT AN ERROR MESSAGE -- A BLOCK ON THE SOURCE PACK CANNOT BE
; READ, AND IT IS NOT MARKED AS A BAD BLOCK.
8$:
	MOV	#M11A,R0
	CALL	IOERR
	MOV	#M11B,R0
	CALL	CONVRT
	MSG	M11
10$:
	MOV	(SP)+,R2
	MOV	(SP)+,R3
	RETURN
;
; SUBROUTINE FOR A WRITE FAILURE ON THE OBJECT PACK.
; PRINT AN ERROR MESSAGE AND URGE TASK BE STOPPED, BUT OFFER
; OPTION TO CONTINUE.
OUTER:
	MOV	#M12A,R0
	CALL	IOERR
	MOV	#M12B,R0
	CALL	CONVRT
	GETANS	M12
	BCC	10$
	EXIT$S
10$:
	RETURN
;
; SUBROUTINE TO SET UP I/O ERROR NUMBER FOR PRINTING
IOERR:
	MOVB	IOST,R1
	MOV	#14112,R2
	CALL	$CBTA
	RETURN
;
; SUBROUTINE TO CONVERT BLOCK NUMBER TO ASCII FOR PRINTING
CONVRT:
	MOV	R4,R1
	CLR	R2
	CALL	$CBOMG
	MOVB	#' ,(R0)
	MOV	R5,R1
	MOV	#1,R2
	CALL	$CBOMG
	RETURN
;
BUF:		.BLKB	512.
;
	.SBTTL	SET-UP SECTION OF TASK.  OVERLAID BY DATA AFTER USE.
	.PAGE
;  ALL REMAINING DATA AND INSTRUCTIONS WILL BE OVERLAID ONCE
;  THE ACTUAL DISK READ-WRITE STARTS.
;
;
	.SBTTL	DEVICE TABLE
;********************************************************
; TABLE OF DISK BLOCKS FOR VARIOUS DEVICES
;   EACH ENTRY CONSISTS OF ONE WORD FOR THE DEVICE
;   MNEUMONIC IN ASCII, AND TWO WORDS FOR THE OCTAL
;   NUMBER OF DISK BLOCKS ON THE DEVICE.
;********************************************************
	.EVEN
DEVTBL:
DL:	.ASCII	\DL\
	.WORD	0
	.WORD	24000
DP:	.ASCII	\DP\
	.WORD	0
	.WORD	116100
DR:	.ASCII	\DR\
	.WORD	2
	.WORD	1140
;********************************************************
;
; COUNT OF ENTRIES IN TABLE
DEV=.-DEVTBL/6
;
CHECK:	.RAD50	\BAD\
M1:	.ASCII	<CR><LF><LF>\  THIS IS THE TASK TO COPY DISK PACKS.\
	.ASCII	<CR><LF>\  ARE YOU SURE YOU WANT TO RUN IT? [Y/N]   \
M1L=.-M1
M2:	.ASCII	<CR><LF>\  ENTER SOURCE DRIVE, E.G. "DP1:" <CR>   \
M2L=.-M2
M3:	.ASCII	<CR><LF>\  ENTER OBJECT DRIVE <CR>   \
M3L=.-M3
M4:	.ASCII	<CR><LF>\  YOU WILL COPY \
	.EVEN
SOURCE:	.BLKB	4
	.ASCII	\ ONTO \
OBJECT:	.BLKB	5
	.ASCII	\  CORRECT? [Y/N]   \
M4L=.-M4
M5:	.ASCII	<CR><LF><LF>\  DSKCPY STOPPED AT OPERATOR REQUEST\
M5L=.-M5
M6:	.ASCII	<CR><LF><LF>\  DSKCPY STOPPED.  LUN ASGMT FAILURE\
M6L=.-M6
M7:	.ASCII	<CR><LF><LF>\  DSKCPY STOPPED.  HOME BLOCK ON OBJECT \
	.ASCII	\DRIVE COULD NOT BE READ\
M7L=.-M7
M8:	.ASCII	<CR><LF>\  LABEL ON OBJECT PACK IS \
M8L=.-M8
M9:	.ASCII	<CR><LF>\  DO YOU WANT TO CHANGE IT? [Y/N]   \
M9L=.-M9
M13:	.ASCII	<CR><LF>\  (SOURCE DRIVE HAS BEEN REDIRECTED)\
M13L=.-M13
M14:	.ASCII	<CR><LF>\  (OBJECT DRIVE HAS BEEN REDIRECTED)\
M14L=.-M14
M15:	.ASCII	<CR><LF>\  ENTER LABEL (12 CHAR MAX)  <CR>   \
M15L=.-M15
M16:	.ASCII	<CR><LF>\  DSKCPY STOPPED.  DEVICE NOT FOUND IN\
	.ASCII	\ PROGRAM.\
M16L=.-M16
M17:	.ASCII	<CR><LF>\  (\
COUNT:	.BLKB	4
	.ASCII	\ BLOCKS AVAILABLE FOR BUFFERING)\
M17L=.-M17
;
;
;
	.EVEN
	.SBTTL	START OF TASK
START:
; MAKE SURE YOU REALLY WANT TO RUN THIS TASK
	GETANS	M1
	BCC	1$
	EXIT$S
;
; GET SIZE OF TASK AND NUMBER OF BLOCKS FOR BUFFERING
1$:
	MOV	PC,R0	; CURRENT PC
	SUB	#<.-BUF>,R0	; ADR WHERE BUFFER STARTS
	NEG	R0
	GTSK$S	#DATA	; GET TASK SIZE IN BYTES
	ADD	DATA+G.TSTS,R0	; BYTES AVAILABLE FOR BUFFER
	MOV	#512.,R1
	CALL	$DIV
	MOV	R0,BLOCKS	; BUFFER SIZE IN BLOCKS
	MOV	R0,R1
	ASH	#9.,R0
	MOV	R0,BYTES	; BUFFER SIZE IN BYTES
	MOV	#COUNT,R0	; PRINT BLOCK SIZE ON CONSOLE
	MOV	#14012,R2
	CALL	$CBTA
	MSG	M17
;
; REQUEST AND READ SOURCE DRIVE
	GETANS	M2,5,SOURCE
; REQUEST AND READ OBJECT DRIVE
	GETANS	M3,5,OBJECT
;
; ASSIGN LOGICAL UNITS
	MOV	OBJECT,R0
	MOVB	OBJECT+2,R1
	BIC	#177770,R1
	ALUN$S	#2,R0,R1
	BCS	5$
	MOV	SOURCE,R0
	MOVB	SOURCE+2,R1
	BIC	#177770,R1
	ALUN$S	#3,R0,R1
	BCC	7$
5$:
	MSG	M6
	EXIT$S
;
; CHECK SOURCE DRIVE ASSIGNMENT
7$:
	GLUN$S	#3,#DATA
	CLC
	CMP	DATA,SOURCE
	BEQ	8$
	SEC
	MOV	DATA,SOURCE
8$:
	BISB	#60,DATA+2
	CMPB	DATA+2,SOURCE+2
	BEQ	9$
	SEC
	MOVB	DATA+2,SOURCE+2
9$:
	BCC	10$
	MSG	M13
10$:
	GLUN$S	#2,#DATA
	CLC
	CMP	DATA,OBJECT
	BEQ	11$
	SEC
	MOV	DATA,OBJECT
11$:
	BISB	#60,DATA+2
	CMPB	DATA+2,OBJECT+2
	BEQ	12$
	SEC
	MOVB	DATA+2,OBJECT+2
12$:
	BCC	13$
	MSG	M14
; GET NUMBER OF BLOCKS TO COPY FOR THIS PARTICULAR DEVICE
13$:
	MOV	#DEV,R0
	MOV	#DEVTBL,R1
131$:
	MOV	2(R1),BLKCT
	MOV	4(R1),BLKCT+2
	CMP	(R1),DATA
	BEQ	14$
	ADD	#6,R1
	SOB	R0,131$
132$:
	MSG	M16
	EXIT$S
;
; CHECK THAT PROPER DRIVES HAVE BEEN ENTERED
14$:
	GETANS	M4
	BCC	16$
	MSG	M5
	EXIT$S
16$:
	CALL	READHM
	BCC	17$
	MSG	M7
	EXIT$S
;
; PRINT OBJECT PACK LABEL
17$:
	MSG	M8
	MOV	#<BUF+H.VNAM>,R4
	MOV	#12.,R5
	CALL	TYPE
;
; INQUIRE IF LABEL IS TO BE CHANGED
	GETANS	M9
	BCS	20$
;
; GET NEW LABEL
	GETANS	M15,12.,NAME
	BR	30$
;
; SAVE CURRENT LABEL
20$:
	MOV	#12.,R0
	MOV	#BUF+H.VNAM,R1
	MOV	#NAME,R2
25$:
	MOVB	(R1)+,(R2)+
	SOB	R0,25$
;
; READ AND CHECK BAD-BLOCK FILE
30$:
	MOV	BUF+H.IBLB,R4
	MOV	BUF+H.IBLB+2,R5
	ADD	BUF+H.IBSZ,R5
	ADC	R4
	ADD	#2,R5
	ADC	R4
	QIOW$S	#IO.RLB,#3,#3,,#IOST,,<#BAD,#512.,#0,R4,R5>
	CMP	CHECK,BAD+S.HDHD+I.FNAM
	BNE	40$
	INC	BADSW
;
; PREPARE TO COPY (60)-BLOCK CHUNKS
40$:
	CLR	R4
	CLR	R5
	JMP	COPY
	.END	START