.TITLE	CPY -- WRITE LARGE BLOCKED FILES
	.IDENT	-000000-
;+
; ABSTRACT:	CPY
;	THIS PROGRAM WILL WRITE A FILE FROM ONE DISK TO ANOTHER
;	OR TO THE SAME ONE USING MULTI-BLOCK READS AND WRITES.
;
; OPERATING PROCEDURES:
;	MCR>RUN CPY$
;	CPY>DEV:OUTFILE=DEV:INFILE
;	CPY>^Z
;	MCR>
;
;	SWITCHES:
;
;		/CO	FILE IS TO BE CONTIGUOUS
;		/CP	FILE IS TO BE "AS CONTIGUOUS AS POSSIBLE"
;			WITHOUT NECESSARILY BEING CONTIGUOUS.
;
; FILES:
; OUTFILE	THE OUTPUT FILENAME (DEFAULTS TO SY0:.LST)
; INFILE	THE INPUT FILENAME (DEFAULTS TO SY0:.LST)
;
; ERRORS:
;	COMMAND STRING ERRORS ARE SELF-EXPLANATORY. IF AN ERROR
;	OCCURRS ON THE FILES PROCESSED, THE ERROR CODE WILL BE
;	PRINTED. ALL ERRORS ARE REPORTED TO TI: ONLY.
;
; LIMITATIONS:
;	AS NOTED IN THE NOTE ABOVE UNDER "OPERATING PROCEDURES"
;
;	ALSO, NOTE THAT A BLOCKING FACTOR OF 64. BLOCKS IS NOT
;	POSSIBLE, REGARDLESS OF WHAT THE I/O OPERATIONS
;	REFERENCE MANUAL SAYS. IF YOU TRY TO SPECIFY A LENGTH
;	OF 32767. ON THE READ$/WRITE$ OPERATION, NO I/O WILL
;	ACTUALLY TAKE PLACE, AND IF YOU SPECIFY A LENGTH OF
;	32768., YOU WILL GET AN FCS ERROR OF "INVALID OPERATION
;	ON FDB".
;
; WRITTEN:
;	BRUCE C. WRIGHT
;	CLINICAL EPIDEMIOLOGY LABORATORY
;	DUKE UNIVERSITY MEDICAL CENTER
;	DURHAM, N. C. 27710
;	01-OCT-78
;-

	.SBTTL	MACRO CALLS
 
	.MCALL	EXIT$S,QIOW$
	.MCALL	OPNS$R,OPEN$W,CLOSE$,FINIT$,DELET$
	.MCALL	READ$,WRITE$,WAIT$
	.MCALL	GCMLB$,GCML$,CSI$,CSI$1,CSI$2,CSI$SW,CSI$ND
	.MCALL	FDAT$R,FDRC$R,FDOP$R,FDBF$R,FDBK$R
	.MCALL	FSRSZ$,FDBDF$,NMBLK$,BDOFF$
 
	.MACRO	ERROR	STRING,LEN,SEV
	MOV	STRING,R0
	MOV	LEN,R1
	.IF IDN	<SEV>,<CONT>
	CLR	R2
	.ENDC
	.IF NDF	CMDQIO
	BR	CMDQIO
	.IFF
	.IF GT	.-CMDQIO
	JMP	CMDQIO
	.IFF
	BR	CMDQIO
	.ENDC
	.ENDC
	.ENDM
 
	.SBTTL	PARAMETER SYMBOL DEFINITIONS
 
NOBLKS	=	63.	;NUMBER OF BUFFERS.
 
EX.ENA	=	200
EX.ADF	=	010
EX.FCO	=	004
EX.AC2	=	002
EX.AC1	=	001
 
	BDOFF$	DEF$L
 
	.SBTTL	READ A COMMAND LINE
 
	.PSECT	CODE,RO,I
START:	FINIT$
	MOV	SP,SPSAVE
BEGIN:	MOV	SPSAVE,SP
	GCML$	#CMLBLK		;GET COMMAND LINE
	BCC	GETOK		;SKIP IF GOTTEN OK.
	MOV	#1,R2		;ASSUME WE WILL LEAVE.
	CMPB	CMLBLK+G.ERR,#GE.IOR
	BEQ	CMDERR		;I/O ERROR
	CMPB	CMLBLK+G.ERR,#GE.OPR
	BEQ	CMDOPE		;OPEN ERROR
	CMPB	CMLBLK+G.ERR,#GE.BIF
	BEQ	CMDSYN		;SYNTAX ERROR
	CMPB	CMLBLK+G.ERR,#GE.MDE
	BEQ	CMDMAX		;MAX @ FILE DEPTH
	CMPB	CMLBLK+G.ERR,#GE.EOF
	BNE	CMDUNK		;EOF ON COMMAND FILE
	EXIT$S
CMDERR:	ERROR	#M.ERR,#L.ERR,FATAL
CMDOPE:	ERROR	#M.OPE,#L.OPE,CONT
CMDSYN:	ERROR	#M.SYN,#L.SYN,CONT
CMDMAX:	ERROR	#M.MAX,#L.MAX,CONT
CMDPS1:	ERROR	#M.PS1,#L.PS1,CONT
CMDPS2:	ERROR	#M.PS2,#L.PS2,CONT
CMDUNK:	ERROR	#M.UNK,#L.UNK,FATAL
CMDQIO:	MOV	R0,$QIOW+Q.IOPL+0
	MOV	R1,$QIOW+Q.IOPL+2
	MOV	#$QIOW,-(SP)
	CALL	.DIRDL
	CLOSE$	#FDBIN
	CLOSE$	#FDBOUT
	TST	R2		;LEAVE YET?
	BEQ	BEGIN		;NO
	EXIT$S

	.SBTTL	PARSE THE COMMAND LINE
 
GETOK:	TST	CMLBLK+G.CMLD
	BEQ	BEGIN		;LOOP IF NULL INPUT LINE.
	MOV	#FDBIN,R0	;POINT TO THE FDB'S
	MOV	#FDBOUT,R1	;
	MOV	#S.FDB/2,R2	;GET FDB SIZE.
10$:	CLR	(R0)+		;CLEAR OUT FDB'S
	CLR	(R1)+		;
	SOB	R2,10$		;AND LOOP.
	CSI$1	#CSIBLK,CMLBLK+G.CMLD+2,CMLBLK+G.CMLD
	BCS	CMDPS1		;PRINT ERROR MESSAGE IF SYNTAX ERROR
	CSI$2	#CSIBLK,INPUT,#CSITAB
	BCS	15$		;PRINT ERROR MESSAGE IF TOO MANY SWITCHES
	FDRC$R	#FDBIN,#FD.RWM	;R/W MODE
	FDBK$R	R0,#BUFFER,#<1000*NOBLKS>,,#2
	FDOP$R	R0,#2,,#INDFN
	OPNS$R	#FDBIN,,#CSIBLK+C.DSDS,,,,CMDOPN
	CSI$2	#CSIBLK,OUTPUT
	BCC	20$
15$:	JMP	CMDPS2
20$:	MOV	FDBIN+F.RSIZ,R1	;GET THE RECORD SIZE.
	BNE	25$		;SKIP IF INITIALISED.
	MOV	#1000,R1	;OTHERWISE INITIALISE TO 512..
25$:	MOVB	FDBIN+F.RATT,R2	;GET RECORD ATTRIBUTES.
	MOV	FDBIN+F.ALOC,R4	;DEFAULT EXPANSOPN.
	BITB	#FD.SQD!FD.REC,FDBIN+F.RCTL ;SEQUENTIAL?
	BEQ	30$		;NO
	ERROR	#M.SEQ,#L.SEQ,CONT
30$:	FDAT$R	#FDBOUT,FDBIN+F.RTYP,R2,R1,,R4
	FDRC$R	R0,#FD.RWM	;YES
	FDBK$R	R0,#BUFFER,#<NOBLKS*1000>,,#3
	FDOP$R	R0,#3,,#OUTDFN
	OPEN$W	#FDBOUT,,#CSIBLK+C.DSDS,,,,CMDOPN
	BITB	#FD.SQD!FD.REC,FDBOUT+F.RCTL ;SEQUENTIAL DEVICE?
	BEQ	60$		;NO
	ERROR	#M.SEQ,#L.SEQ,CONT
60$:	MOV	FDBIN+F.EFBK+2,R1 ;GET THE LOW ORDER EF BLOCK
	MOV	FDBIN+F.EFBK,R2	;AND HI ORDER EF BLOCK
	TST	FDBIN+F.FFBY	;IS THERE NOTHING USED LAST BLOCK?
	BNE	70$		;SOMETHING USED -- DON'T DELETE
	SUB	#1,R1		;LAST BLOCK;  OTHERWISE, DON'T
	SBC	R2		;ALLOCATE OR USE LAST BLOCK.
70$:	SWAB	R2		;GET THE BITS INTO THE HI ORDER.
	CLRB	R2		;CLEAR LOW ORDER R2 BYTE.
	BIS	#EX.ENA,R2	;SET OPTION BIT.
	BIT	#SW.CON,SWORD	;CONTIGUOUS OUTPUT?
	BNE	121$		;YES
	BIT	#SW.CP,SWORD	;"NEARLY" CONTIGUOUS OUTPUT?
	BEQ	123$		;NO
	BIS	#EX.AC2!EX.AC1,R2 ;SET OPTION BITS FOR "NEARLY CO"
	BR	123$		;AND CONTINUE.
121$:	BIS	#EX.AC1!EX.FCO,R2 ;SET OPTION BITS FOR "CO"
123$:	CALL	.EXTND		;EXTEND THE FILE AS DESIRED.
	BCC	200$		;SKIP ON OK.
	JMP	CMDOPN		;AND GO TO THE ERROR ROUTINE.
200$:

	.SBTTL	COPY THE FILE
 
	MOV	FDBIN+F.EFBK+2,R3 ;GET THE NUMBER OF BLOCKS TO MOVE.
	MOV	FDBIN+F.EFBK,R2	;AND HI ORDER.
	TST	FDBIN+F.FFBY	;CHECK FIRST FREE BYTE.
	BNE	LOOP		;SKIP IF BYTE OK.
	SUB	#1,R3		;IF NO BYTES USED LAST BLOCK, DEC
	SBC	R2		;THE BLOCK COUNT.
LOOP:	SUB	#NOBLKS,R3	;SUBTRACT OFF # BKOCKS
	SBC	R2		;AND FROM HI ORDER.
	BLT	ENDLP		;AND LEAVE IF DONE.
	READ$	#FDBIN		;READ FROM INPUT FDB.
	BCS	EOFMOD		;SKIP OUT ON ERROR.
	WAIT$	R0		;WAIT FOR IT.
	BCS	EOFMOD		;SKIP OUT ON ERROR.
	WRITE$	#FDBOUT		;WRITE OUTPUT FDB.
	BCS	EOFMOD		;ERROR?
	WAIT$	R0		;AND WAIT ON IT.
	BCS	EOFMOD		;ERROR?
	BR	LOOP		;LOOP UNTIL DONE.
ENDLP:	ADD	#NOBLKS,R3	;GET THE # TO BE TRANSFERRED.
	BEQ	CLOSIT		;CLOSE FILES IF DONE.
	ASH	#9.,R3		;CONVERT # BLOCKS TO BLOCK SIZE.
	READ$	#FDBIN,,R3	;READ A BLOCK
	BCS	EOFMOD
	WAIT$	R0		;WAIT ON IT
	BCS	EOFMOD
	WRITE$	#FDBOUT,,R3	;WRITE A BLOCK
	BCS	EOFMOD
	WAIT$	R0		;WAIT ON IT
	BCS	EOFMOD
;
; NORMAL EXIT ROUTINE. COPY THE END-OF-FILE INFO
; FROM THE INPUT FILE TO THE OUTPUT FILE (READ$/WRITE$
; CANNOT TELL WHERE VARYING LENGTH RECORDS ARE, FOR
; EXAMPLE, AND THUS CANNOT REALLY SET THESE FIELDS
; CORRECTLY ITSELF).
;
CLOSIT:	MOV	FDBIN+F.EFBK,FDBOUT+F.EFBK
	MOV	FDBIN+F.EFBK+2,FDBOUT+F.EFBK+2
	MOV	FDBIN+F.FFBY,FDBOUT+F.FFBY
	CLOSE$	#FDBIN		;CLOSE FDBIN
	BCS	EOFMOD
	CLOSE$	#FDBOUT		;AND FDBOUT
	BCS	EOFMOD
	JMP	BEGIN		;AND TRY AGAIN.

	.SBTTL	PRINT ERROR MESSAGES
 
EOFMOD:
;
;	THE ERROR HANDLING ROUTINE.
;	IF AN END-OF-FILE IS DETECTED, THE PROGRAM JUST EXITS.
;
	CLR	R5		;SET DELETE FLAG TO 0.
	BR	CMD01		;
CMDOPN:	MOV	#1,R5		;SET DELETE FLAG TO 1.
CMD01:	MOV	#M.IOR,R1	;GET I/O ERROR MSG
	MOV	#L.IOR,R2	;AND LENGTH
	TST	@#$DSW		;DSW ERROR?
	BGT	10$		;NO
	MOV	@#$DSW,F.ERR(R0) ;MOVE IN ERROR CODE
10$:	CALL	.PRFCS		;
	CLOSE$	#FDBIN		;
	MOV	#FDBOUT,R0
	TST	R5		;DELETE?
	BEQ	20$		;NO
	DELET$	R0		;DELETE FILE NEVER USED.
	BR	30$
20$:	CALL	.TRNCL		;TRUNCATE.
30$:	JMP	BEGIN		;AND RESTART

	.SBTTL	ERROR MESSAGE STRINGS
 
	.PSECT	PDATA,RO,D
	.NLIST	BIN
M.ERR:	.ASCII	"CPY -- I/O ERROR ON @ FILE"
L.ERR	=	.-M.ERR
	.EVEN
M.OPE:	.ASCII	"CPY -- OPEN ERROR ON @ FILE"
L.OPE	=	.-M.OPE
	.EVEN
M.SYN:	.ASCII	"CPY -- SYNTAX ERROR FOR @ FILE"
L.SYN	=	.-M.SYN
	.EVEN
M.MAX:	.ASCII	"CPY -- MAX @ FILE DEPTH EXCEEDED"
L.MAX	=	.-M.MAX
	.EVEN
M.UNK:	.ASCII	"CPY -- UNKNOWN COMMAND ERROR"
L.UNK	=	.-M.UNK
	.EVEN
M.PS1:	.ASCII	"CPY -- SYNTAX ERROR"
L.PS1	=	.-M.PS1
	.EVEN
M.PS2:	.ASCII	"CPY -- ILLEGAL SWITCH"
L.PS2	=	.-M.PS2
	.EVEN
M.SEQ:	.ASCII	"CPY -- CANNOT COPY TO/FROM A SEQUENTIAL DEVICE"
L.SEQ	=	.-M.SEQ
	.EVEN
M.IOR:	.ASCII	/CPY/
L.IOR	=	.-M.IOR
	.EVEN

	.SBTTL	DATA AREA
 
	.PSECT	IDATA,RW,D
CSITAB:	CSI$SW	CO,SW.CON,SWORD,SET,NEG
	CSI$SW	CP,SW.CP,SWORD,SET,NEG
	CSI$ND
SWORD:	.WORD	0
SW.CON	=	000002		;CONTIGUOUS FILE
SW.CP	=	000004		;PARTIALLY CONTIGUOUS
CMLBLK:	GCMLB$	1,CPY,USRBUF,1
USRBUF:	.BLKB	82.
	.EVEN
	CSI$
	.EVEN
CSIBLK:	.BLKB	C.SIZE
	FSRSZ$	1
	.PSECT	IDATA,RW,D
FDBIN:	FDBDF$
INDFN:	NMBLK$	,LST,,SY,0
FDBOUT:	FDBDF$
OUTDFN:	NMBLK$	,LST,,SY,0
	.EVEN
SPSAVE:	.WORD	0
BUFFER:	.BLKB	<1000*NOBLKS>
	.EVEN
$QIOW:	QIOW$	IO.WVB,4,4,,,,<0,0,40>
	.END	START