.TITLE	FTCOPY MAIN PROGRAM FOR FOREIGN TAPE COPYING.
	.IDENT	/30-APR-1984 V01.D/
;	Foreign tape copy.
;
;	V01.D	TWD	30-APR-1984	Add copyright note and check buffer
;				length for output to TT: and LP: type devices.
;	V01.C	TWD	29-DEC-1983	Remove device restrictions to allow I/O
;				with NL: and TT: and others which can use RMS
;				for I/O handling.  Specific to this module,
;				change the call to FT_INI_FILE to allow us to
;				save the device class of both the input and
;				output devices.
;	V01.B	TWD	12-DEC-1983	Minor release to fix bugs in:
;				FTEXIT and FTTRANS
;	V1.a	T.W.D.	01-Mar-1982	Initail release.
;
	$SSDEF
	$NAMDEF		; NAM BLOCK DEFINITIONS.
	$RMSDEF		; RMS STATUS DEFINITIONS
	$DCDEF		; DEVICE CLASSES.
	$STSDEF		; EXIT STATUS DEFINITIONS.
;
	FTCBDEF			; FTCOPY CONTROL BLOCK DEFINITIONS
	FTIODEF			; FTCOPY IO BLOCK DEFINITIONS
;
;	FTCOPY input_file output_file
;		Information on the format of the command is in the module
;		FTCOMND - the command parsing subroutine.
;
;==========================================================================
;
;	Register usage -
;		Registers are used with the general condition of grouping
;	their use for status, move character instructions, general purpose,
;	and pointers to data areas.  Registers 12, 13, 14, 15 are only used
;	by the system for subroutine pointers.
;
;	Status registers are generally R0 and R1.
;	Move character registers are R0 - R5.  Their use is confined to the
;	FT_PCOPY and FT_TRANS subroutines and surrounding code in the main
;	program.
;	General purpose registers are R6 - R9.
;	Pointer registers are R10 and R11.
;
;	Usage specific to this routine -
;		R0 - Status from subroutine calls.
;		R1 - Temporary counter for the number of data blocks read.
;		R2 - not used.
;		R3 - Not used.
;		R4 - Not used.
;		R5 - Used as address pointer for translating "pad" characters.
;		R6 - Scratch register.
;		R7 - Scratch register.
;		R8 - Pointer to RAB's and temporary block counter.
;		R9 - Pointer to FAB's and temporary message pointer.
;		R10 - Pointer to the FTCB.
;		R11 - Pointer to the FT I/O block.
;
;	In the area where data is read from the input device and passed to the
;	copy routines, registers R0-R8 may be critical and not saved from 
;	routine to routine.  Care must be taken in this area to maintain the
;	integrity of all of the data pointers and counters.  The important
;	area is noted in the code.
;
;
	.PAGE
	.SUBTITLE DATA FOR FTCOPY MAIN PROGRAM.
;
DEV_NAME_DESC:	.BLKL	2		; STRING DESCRIPTOR FOR THE IN/OUT
					; PARSED FILE NAME.
;
;		EXPANDED FILE NAME AREAS FOR INPUT FILES AND OUTPUT FILES.
;
EX_IN_NAME::	.BLKB	NAM$C_MAXRSS	; INPUT EXPANDED STRING AREA.
EX_OUT_NAME::	.BLKB	NAM$C_MAXRSS	; OUTPUT EXPANDED STRING AREA.
EX_TMP_NAME::	.BLKB	NAM$C_MAXRSS	; TEMP. EXPANDED STRING AREA.
;
	.EVEN
CUR_REC:	.LONG	0	; CURRENT OUTPUT RECORD SIZE.
CUR_BLK:	.LONG	0	; CURRENT OUTPUT BLOCK SIZE.
IN_BYTE:	.LONG	0	; NUMBER OF BYTES READ FROM FOREIGN TAPE.
READ_BYTE:	.LONG	65535	; NUMBER OF BYTES TO READ FROM FOREIGN TAPE.
;
COUNT_FILE:	.LONG	0 	; COUNT OF FILES TO COPY.
;
	.PAGE
	.SUBTITLE ERROR MESSAGE STRINGS
;
;		CHARACTER STRINGS AND NUMBERS USED IN CONJUNCTION
;		WITH THE FTCOPY ERROR MESSAGES.
;
;
NUM_1::	.LONG	65535	; MAXIMUM SIZE OF FT BLOCK
NUM_2::	.LONG	9991	; MAXIMUM SIZE OF ANSI TAPE BLOCK
NUM_3::	.LONG	32767	; MAX SIZE OF RMS DISK RECORD.
;
;
	DESCRIPTOR	MSG_1,<input>
	DESCRIPTOR	MSG_2,<output>
	DESCRIPTOR	MSG_3,</FILES>
;
	DESCRIPTOR	MSG_4,</BLOCK_SIZE>
	DESCRIPTOR	MSG_5,</RECORD_SIZE>
	DESCRIPTOR	MSG_6,<small>
;
	DESCRIPTOR	MSG_7,<big>
	DESCRIPTOR	MSG_8,<read>
	DESCRIPTOR	MSG_9,<connect>
;
	DESCRIPTOR	MSG_10,<open>
	DESCRIPTOR	MSG_12,<close>
	DESCRIPTOR	MSG_13,<write>
;
	DESCRIPTOR	MSG_14,<setup>
	DESCRIPTOR	MSG_15,<end file>
	DESCRIPTOR	MSG_16,<records>
;
	DESCRIPTOR	MSG_17,<blocks>
	DESCRIPTOR	MSG_18,<parsing>
	DESCRIPTOR	MSG_19,</EVEN>
;
	DESCRIPTOR	MSG_20,</TRAIL-Record>
	DESCRIPTOR	MSG_21,</TRAIL-Block>
	DESCRIPTOR	MSG_22,</PAD-Record>
;
	DESCRIPTOR	MSG_23,</PAD-Block>
;
	.PAGE
	.SUBTITLE FOREIGN TAPE CONTROL BLOCK & I/O DATA BLOCKS
;		FOREIGN TAPE CONTROL BLOCK
;
	.SAVE
	.PSECT	FTCB_DATA,OVR,NOEXE,GBL,PIC,SHR,LONG
FTCB::	.BLKB	FTCB_K_LEN		; DEFINED BY LENGTH IN THE DEFINITIONS
;
;		FOREIGN TAPE I/O BLOCK
;
	.PSECT	FTIO_DATA,OVR,NOEXE,GBL,PIC,SHR,LONG
FTIO::	.BLKB	FTIO_K_LEN		; DEFINED BY LENGTH IN THE DEFINITIONS.
;
;		FOREIGN TAPE INPUT DATA BLOCK
;
	.PSECT	FT_IN_BUF,OVR,NOEXE,GBL,PIC,SHR,BYTE
FT_IN_DATA::	.BLKB	65535
;
;		FOREIGN TAPE OUTPUT DATA BLOCK
;
	.PSECT	FT_OUT_BUF,OVR,NOEXE,GBL,PIC,SHR,BYTE
FT_OUT_DATA::	.BLKB	65535
;
;		DATA TRANSLATION BUFFERS.
;
	.PSECT	FT_TRANSB,OVR,NOEXE,GBL,PIC,SHR,BYTE
FT_BLANK_DATA::	.BLKB	256
FT_TRANS_DATA::	.BLKB	256
	.RESTORE
;
	.PAGE
	.SUBTITLE FILE ACCESS AND NAME BLOCKS FOR FTCOPY
;
	.SAVE
	.PSECT	FTCOP_RMS,OVR,NOEXE,GBL,PIC,SHR,LONG
;		INPUT DATA FILE IF RMS.
;
IN_NAM::	$NAM	ESA=EX_IN_NAME,-	; INPUT NAME BLOCK WITH EXPANDED
			ESS=NAM$C_MAXRSS	; STRING ADDR. AND SIZE.
;
IN_XAB:	$XABFHC				; THE FILE HEADER - AVENUE TO LRL.
;
IN_FAB::	$FAB	FAC=<GET>,-		; GET AND FIND ACCESS.
			FOP=NAM,-		; SPECIFY NAME BLOCK PROCESSING.
			NAM=IN_NAM,-
			XAB=IN_XAB
				; NEED TO SPECIFY THE NAME ADDRESS AND
				; THE NAME SIZE AT RUN TIME.
IN_RAB::	$RAB	FAB=IN_FAB,-		; INPUT RECORD ACCESS BLOCK.
			RAC=SEQ,-			; SEQUENTIAL ACCESS.
			UBF=FT_IN_DATA,-	; INPUT BUFFER.
			USZ=65535		; INPUT BUFFER SIZE.
;
;		OUTPUT DATA FILE IF RMS USED.
;
OUT_NAM::	$NAM	ESA=EX_OUT_NAME,-	; OUTPUT NAME BLOCK WITH EXPND.
			ESS=NAM$C_MAXRSS	; STRING ADDR. AND SIZE.
;
OUT_FAB::	$FAB	FAC=<PUT,UPD,TRN>,-	; PUT, UPDATE AND TRUNCATE.
			FOP=<NAM,CBT,MXV>,-	; OPTIONS.
			ORG=SEQ,-		; SEQUENTIAL ORGANIZATION.
			RAT=CR,-		; IMPLIED <CR> AFTER EACH REC.
			RFM=VAR,-		; VARIABLE LENGTH RECORDS.
			NAM=OUT_NAM
;
OUT_RAB::	$RAB	FAB=OUT_FAB,-
			RAC=SEQ,-		; SEQUENTIAL ACCESS.
			RBF=FT_OUT_DATA		; OUTPUT BUFFER START.
;
;
;		TEMPORARY FAB - USED FOR BLANKEDIT, USER TRANSLATE, ....
;
TMP_NAM::	$NAM	ESA=EX_TMP_NAME,-	; TEMP EXPANDED STRING AREA.
			ESS=NAM$C_MAXRSS	; EXPANDED STRING SIZE.
;
TMP_FAB::	$FAB	FAC=<GET>,-	; GET AND FIND ACCESS.
			NAM=TMP_NAM
				; NEED TO SPECIFY THE NAME ADDRESS AND 
				; THE NAME SIZE AT RUN TIME.
;
TMP_RAB::	$RAB	FAB=TMP_FAB,-
			RAC=SEQ
;
	.RESTORE
;
	.PAGE
	.SUBTITLE START PROGRAM AND PARSE THE COMMAND.
;
FTCOPY::	.WORD	0
;
;		INITIAIZE THE CONTROL BLOCK AND I/O BLOCK.
;
	MOVAL	FTCB,R10		; LOAD ADDRESS OF THE CONTROL BLOCK
	MOVAL	FTIO,R11		; LOAD ADDRESS OF THE I/O BLOCK
;
	MOVAL	OUT_RAB,FTCB_L_OUT_RAB(R10)	; POINTER TO OUTPUT RAB.
	MOVAL	FTCB+FTCB_B_INSTR,FTCB_L_INSPTR(R10)	; POINT TO INPUT STR.
	MOVAL	FTIO+FTIO_B_INFIL,FTIO_L_INPTR(R11)	; POINT TO IN FILE
	MOVAL	FTIO+FTIO_B_OUTFIL,FTIO_L_OUTPTR(R11)	; POINT TO OUT FILE.
	MOVAL	FTIO+FTIO_B_BLAFIL,FTIO_L_BLAPTR(R11)	; POINT TO BLANK EDIT.
;
	MOVW	#^X0FFFF,FTCB_W_DEFS(R10)	; INITIALIZE THE DEFAULT 
						; SWITCHES FOR "ALL DEFAULTS."
	MOVW	#^X0007,FTCB_W_FLAG(R10)	; INITIALIZE THE FLAGS.
	MOVZWL	#40,FTCB_L_INLUN(R10)		; INITIALIZE THE INPUT LUN
	MOVZWL	#45,FTCB_L_OUTLUN(R10)		; INIT. THE OUTPUT LUN.
;
	MOVL	#SS$_NORMAL,FTCB_L_SEVERITY(R10) ; INIT. SEVERITY TO SUCCESS.
	MOVL	#1,FTCB_L_EXIT_FLG(R10)		; INIT. EXIT FLAG - REMOVE
				; WHEN CHECKING STARTS FOR COMPLETE COMMAND
				; SYNTAX BEFORE EXIT ON ERROR.
;
;		ISSUE COPYRIGHT NOTICE.
;
	CALL_MSG	PUT_SYS,#FTC_NOTICE,#0
;
;		CALL THE FTCOPY COMMAND PARSER AND FIND OUT WHAT TO DO.
;
5$:	CALLS	#0,G^FTCOMND
;
	BLBS	R0,IN_DVI
;
	$EXIT_S	R0		; IF THE PARSER QUITS - THEN PROG WILL QUIT.
;
	.PAGE
	.SUBTITLE GET INFORMATION ABOUT INPUT DEVICE AND OPEN FILE.
;
IN_DVI:	MOVAL	IN_FAB,R9		; POINTER TO THE INPUT FAB
	MOVAL	IN_NAM,R8		; POINTER TO THE INPUT NAM
;
	PUSHAL	FTCB+FTCB_W_IN_BUF	; LOCATION FOR THE DEVICE BUFFER SIZE.
	PUSHAL	FTCB+FTCB_B_IN_CLAS	; LOCATION TO SAVE THE IN DEVICE CLASS.
	PUSHL	#FLAG_V_FTIN		; PUSH THE FT IN FLAG NUMBER.
	PUSHAL	FTCB+FTCB_L_INLUN	; PUSH THE ADDR OF THE IN LUN NUMBER.
	PUSHAL	FTIO+FTIO_Q_INDESC	; PUSH THE ADDR OF THE IN FILE DESCRIP.
	CALLS	#5,G^FT_INI_FILE	; CALL INITIALIZE FT FILES SUBR.
;
;		THE FILE HAS BEEN CHECKED OUT AND OPENED, FIND OUT IF RMS
;		OR FOREIGN TAPE AND BRANCH TO THE CORRECT LOCATION TO CONTINUE
;		THE ANALYSIS AND OPENING.
;
	BBC	#FLAG_V_FTIN,FTCB_W_FLAG(R10),IN_RMS
	BRB	GET_OUT_INFO
;
;		RMS FILE --
;		OPENING AN RMS FILE 
;
IN_RMS:	CMPL	#1,FTCB_L_NFILES(R10)	; CHECK TO SEE IF AN RMS INPUT IS FOR
	BEQL	15$			; ONLY ONE FILE.  BRANCH IF TRUE.
;
	MOVL	#1,FTCB_L_NFILES(R10)	; FORCE NFILES = 1.
	CALL_MSG	PUT_SYS,#FTC_FILELIM,#0	; ISSUE A WARNING MESSAGE.
;
;		CONNECT TO THE FILE.
;
15$:	$CONNECT	RAB=IN_RAB	; SET DATA STREAM TO INPUT FILE.
	BLBC	R0,55$			; IF CLEAR - ERROR.
;
	BRB	GET_OUT_INFO		; GO CHECK OUT THE OUTPUT FILE.
;
55$:	MOVZBL	NAM$B_ESL(R8),R5	; GET THE STRING SIZE INTO LONG WORD.
	CALL_MSG	EXIT_SYS,#FTC_RMSERROR,#4,- ; EXIT - RMS ERROR MESSAGE.
		MSG_9,MSG_9+4,R5,NAM$L_ESA(R8),R0,IN_RAB+RAB$L_STV
;
	.PAGE
	.SUBTITLE GET INFORMATION ABOUT OUTPUT DEVICE AND OPEN FILE.
;
GET_OUT_INFO:
	MOVAL	OUT_FAB,R9		; GET OUTPUT FAB ADDR.
	MOVAL	OUT_NAM,R8		; GET OUTPUT NAM ADDR.
;
	PUSHAL	FTCB+FTCB_W_OUT_BUF	; LOCATION FOR OUTPUT BUFFER SIZE.
	PUSHAL	FTCB+FTCB_B_OUT_CLAS	; SAVE LOCATION FOR OUT DEVICE CLASS.
	PUSHL	#FLAG_V_FTOUT		; OUTPUT FOREIGN FLAG.
	PUSHAL	FTCB+FTCB_L_OUTLUN	; FOREIGN TAPE LUN.
	PUSHAL	FTIO+FTIO_Q_OUTDESC	; OUTPUT FILE DESCRIPTOR.
	CALLS	#5,G^FT_INI_FILE
;
;		CHECK THE OUTPUT FOREIGN FLAG AND BRANCH TO OPEN FOR RMS 
;		OR FOREIGN TAPE
;
20$:	BBC	#FLAG_V_FTOUT,FTCB_W_FLAG(R10),OUT_RMS
	BRB	GET_BLNK_INFO		; FOREIGN TAPE -- THERE ARE NO SPECIFIC
					; CHECKS FOR A FOREIGN TAPE.
;
;
;		RMS FILE  --
;		CHECK FOR A TT: OR LP: TYPE OF OUTPUT DEVICE AND, IF TRUE, SET
;		THE CHECK BUFFER SIZE FLAG.
;		
OUT_RMS:
	CMPB	#DC$_TERM,FTCB_B_OUT_CLAS(R10)	; CHECK FOR TERMINAL CLASS.
	BNEQ	10$
	BISW2	#FLAG_M_CKBUF,FTCB_W_FLAG(R10)	; SET FLAG SO BUFFER IS CHECKED
;
10$:	CMPB	#DC$_LP,FTCB_B_OUT_CLAS(R10)	; CHECK FOR LINE PRINTER CLASS.
	BNEQ	20$
	BISW2	#FLAG_M_CKBUF,FTCB_W_FLAG(R10)	; SET FLAG SO BUFFER IS CHECKED
;
;
;		PUT THE OUTPUT BLOCK SIZE INTO THE MAX. RECORD SIZE OF
;		THE FAB - THIS WILL ALLOW FTCOPY TO DEBLOCK OR BLOCK AN
;		RMS FILE WITHIN ITS RECORDS.
;
20$:	PUSHL	R9			; PUSH THE OUTPUT FAB ADDRESS.
	PUSHAL	OUT_RAB			; PUSH THE OUTPUT RAB ADDRESS.
	CALLS	#2,G^FT_CREATE		; CALL SUBR. TO CREATE AND CONNECT FILE
;
;
	.PAGE
	.SUBTITLE BLANK EDIT OF THE DATA - GET INFORMATION.
;
GET_BLNK_INFO:
	MOVAL	TMP_FAB,R9		; GET POINTER TO THE TEMP FAB.
	MOVAL	TMP_RAB,R8		; GET POINTER TO THE TEMP RAB INTO R8.
;
; 		IF BLANK EDIT CLEAR, BRANCH
	BBC	#FLAG_V_BLANK,FTCB_W_FLAG(R10),GET_TRANS_INFO
;
;		GO INITIALIZE THE BLANK EDIT MASK.
;
	CALLS	#0,G^BLNK_INIT
;
	.PAGE
	.SUBTITLE USER TRANSLATE TABLE - GET INFORMATION.
;
;		GET INFORMATION ABOUT THE USER TRANSLATE FILE.
;
GET_TRANS_INFO:
; 		BRANCH IF TRANSLATION BIT CLEAR.
	BBC	#FLAG_V_TRANS,FTCB_W_FLAG(R10),START_LOOP
;
;		CALL ROUTINE TO INITIALIZE THE TRANSLATION POINTERS,
;		GET USER TRANSLATION INFORMATION, AND TRANSLATE ANY
;		PAD BYTES.
;
	CALLS	#0,G^TRAN_INIT
;
	.PAGE
	.SUBTITLE LOOP TO GET RECORDS, DEBLOCK/BLOCK, AND PUT RECS.
;
;
;============================================================================
;
;	NOTE:
;	Care must be taken to maintain the integrity of R0-R8 in the following
;	sections of the program.  All of these registers may be passed in
;	and out of subroutines with out being saved.  The most critical are
;	R0-R5 as these are used as pointers and counters for the copy
;	operations.  Subroutines which may be called are documented as to
;	what registers they preserve and what registers are used and
;	how they used.  FTCOPY depends on the integrity of the registers for
;	completing the copies correctly.
;
;
;
START_LOOP:
	MOVL	FTCB_L_NFILES(R10),COUNT_FILE	; SET UP FILE COUNTER.
;
;		CHECK FOR FOREIGN OR RMS INPUT AND GET NEXT RECORD.
;
INPUT_REC:
	BBS	#FLAG_V_FTIN,FTCB_W_FLAG(R10),5$
	BRB	10$		; GO TO THE RMS INPUT.
;
5$:	BRW	INPUT_FT	; GO TO THE FOREIGN TAPE INPUT.
;
;
;		RMS INPUT - GET THE RECORD AND CHECK FOR END OF FILE.
;
10$:	MOVAL	IN_RAB,R6	; GET THE ADDR OF THE INPUT RAB.
	$GET	RAB=IN_RAB
	BLBS	R0,20$		; CHECK FOR SUCCESSFUL GET.
;
	CMPL	#RMS$_EOF,R0	; CHECK FOR END OF FILE.
	BEQL	15$		; IF NOT - BRANCH TO GIVE ERROR.
;
	MOVL	FAB$L_NAM(R6),R5	; GET NAME BLOCK ADDRESS.
	MOVZBL	NAM$B_ESL(R5),R4	; GET EXPANDED FILE NAME LENGTH.
	CALL_MSG	EXIT_SYS,#FTC_RMSERROR,#4,MSG_8,-	; FATAL - RMS.
		MSG_8+4,R4,NAM$L_ESA(R5),R0,IN_RAB+RAB$L_STV
;
15$:	BRW	CLOSE_FILE	; END OF FILE FOUND  --  CLOSE THE FILE.
;
;		INPUT OK - CHECK ON USING THE DEFAULT BLOCK SIZE OR
;		A USER SPECIFIED SIZE.
;
20$:	BBS	#DEFS_V_INBLK,FTCB_W_DEFS(R10),30$	; USE DEFAULT IF SET.
;
	ADDL3	#1,FTCB_L_BLK_READ(R10),R1	; TEMPORARY BLOCK COUNT.
;
	CMPW	RAB$W_RSZ(R6),FTCB_L_INBLK(R10)	; ARE IN BLK AND IN REC. SAME?
	BEQL	30$		; IF EQUAL, GO SET THE ACTUAL IN BLOCK SIZE.
	BLSS	25$		; IF IN LESS THAN SPECIFIED, USE IN WITH WARN.
;
;		INPUT BLOCK GREATER THAN SPECIFIED BLOCKSIZE - USE SPECIFIED.
	CALL_MSG	PUT_SYS,#FTC_INPGTRSPEC,#0,-
		#FTC_DATALOST,#0,#FTC_BLOCKNUM,#2,R1,FTCB_L_BLK_WRIT(R10)
;
	MOVL	FTCB_L_INBLK(R10),FTCB_L_ACT_INBLK(R10)	; USE THE SPECIFIED SIZE
	BRW	SET_RECORD
;
;		ISSUE MESSAGE SAYING THE SMALLER INPUT SIZE WILL BE USED AND
;		THEN GO TO SET INPUT BLOCK TO THE SMALLER SIZE.
25$:	CALL_MSG	PUT_SYS,#FTC_INPLTSPEC,#0,-
		#FTC_SMALLUSED,#0,#FTC_BLOCKNUM,#2,R1,FTCB_L_BLK_WRIT(R10)
;
30$:	MOVZWL	RAB$W_RSZ(R6),FTCB_L_ACT_INBLK(R10)	; SET INPUT BLOCK SIZE.
	BRW	SET_RECORD		; GO CHECK THE RECORD SIZE AND SET IT.
;
;
;		FOREIGN TAPE INPUT - READ TAPE AND CHECK THE INPUT BLOCK SIZE.
;
INPUT_FT:
	PUSHAL	FTCB+FTCB_Q_ISTAT	; ADDRESS OF I/O STATUS BLOCK
	PUSHAL	IN_BYTE			; ADDRESS OF # BYTES READ.
	PUSHAL	READ_BYTE		; ADDRESS OF BYTES TO READ.
	PUSHAL	FT_IN_DATA		; ADDRESS OF INPUT DATA AREA.
	PUSHAL	FTCB+FTCB_L_INLUN	; ADDRESS OF LUN FOR READ.
	CALLS	#5,G^RITAPE		; READ TAPE.
;
	ADDL3	#1,FTCB_L_BLK_READ(R10),R1	; TEMPORARY BLOCK COUNT.
	CASEL	FTCB_Q_ISTAT(R10),#1,#6		; CHECK FOR ERROR
;
1$:	.WORD	10$-1$		; NORMAL BRANCH
	.WORD	20$-1$		; EOF BRANCH
	.WORD	30$-1$		; EOT BRANCH.
	.WORD	40$-1$		; EOV BRANCH.
	.WORD	50$-1$		; DATACHECK BRANCH - NOT APPLICABLE.
	.WORD	60$-1$		; PARITY BRANCH.
	.WORD	70$-1$		; DATA OVERUN BRANCH.
;
;		ISTAT > 7 - FATAL SYSTEM ERROR.
;
	CALL_MSG	EXIT_SYS,#FTC_FTERROR,#2,-    ; FATAL TAPE READ ERROR.
		MSG_8,MSG_8+4,#FTC_ERRCODE,#1,FTCB_Q_ISTAT(R10),-
		FTCB_Q_ISTAT(R10)
;
10$:	CLRB	FTCB_B_EOV(R10)		; CLEAR THE COUNT OF EOF'S FOUND.
	BRW	INPUT_FT_1		; NORMAL END
;
20$:	INCB	FTCB_B_EOV(R10)		; INCREMENT THE COUNT OF EOF'S
	BRW	CLOSE_FILE		; END OF FILE FOUND.
;
30$:	CALL_MSG	EXIT_SYS,#FTC_FTEOT,#2,MSG_8,-	; END OF TAPE
		MSG_8+4,#FTC_OPERTERM
;
40$:	CALL_MSG	EXIT_SYS,#FTC_FTEOV,#0		; END OF VOLUME
;
50$:	CALL_MSG	EXIT_SYS,#FTC_FTERROR,#2,MSG_8,-	; DATA CHECK
		MSG_8+4,#SS$_DATACHECK
;
60$:	CALL_MSG	PUT_SYS,#FTC_FTERROR,#2,MSG_8,-	; PARITY
		MSG_8+4,#FTC_BLOCKNUM,#2,R1,FTCB_L_BLK_WRIT(R10),-
		#SS$_PARITY
	BRB	INPUT_FT_1		; HANDLE THE BLOCK ANYWAY.
;
70$:	CALL_MSG	EXIT_SYS,#FTC_FTERROR,#2,MSG_8,-	; DATA OVERUN
		MSG_8+4,#FTC_BLOCKNUM,#2,R1,FTCB_L_BLK_WRIT(R10),-
		#SS$_DATAOVERUN
;
;
;		CHECK ON USING THE DEFAULT INPUT BLOCK AND THEN 
;		SET THE ACTUAL BLOCK SIZE.
;
INPUT_FT_1:
	BBS	#DEFS_V_INBLK,FTCB_W_DEFS(R10),20$
;
	CMPL	IN_BYTE,FTCB_L_INBLK(R10)	; IN BLOCK = SPECIFIED BLOCK?
	BEQL	20$			; IF YES, CONTINUE.
	BLSS	15$		; INPUT SIZE LESS THAN SPECIFIED - WARN USER.
;
;		INPUT SIZE > SPECIFIED - WARN USER AND USE ANYWAY.
	CALL_MSG	PUT_SYS,#FTC_INPGTRSPEC,#0,-	; WARN 
		#FTC_DATALOST,#0,#FTC_BLOCKNUM,#2,R1,FTCB_L_BLK_WRIT(R10)
;
	MOVL	FTCB_L_INBLK(R10),FTCB_L_ACT_INBLK(R10)	; USE THE SPECIFIED SIZE
	BISW2	#FLAG_M_ODDSIZ,FTCB_W_FLAG(R10)		; SET THE ODDSIZE FLAG.
	BRB	SET_RECORD
;
;		INPUT SIZE LESS THAN SPEC. - USE THE SMALLER AND WARN USER.
15$:	CALL_MSG	PUT_SYS,#FTC_INPLTSPEC,#0,-	; WARN 
		#FTC_SMALLUSED,#0,#FTC_BLOCKNUM,#2,R1,FTCB_L_BLK_WRIT(R10)
;
20$:	MOVL	IN_BYTE,FTCB_L_ACT_INBLK(R10)	; ACTUAL BLOCK = BYTES READ.
;
	.PAGE
	.SUBTITLE CHECK INPUT AND OUTPUT RECORD SIZES.
;
;		CHECK ON USING THE DEFAULT INPUT RECORD SIZE OR
;		A SPECIFIED RECORD SIZE.
;
SET_RECORD:
	INCL	FTCB_L_BLK_READ(R10)	; INCREMENT COUNT OF BLOCKS READ.
	BBS	#DEFS_V_INREC,FTCB_W_DEFS(R10),30$	; BRANCH FOR DEFAULT.
;
;		SET FOR SPECIFIED RECORD SIZE.
;
	MOVL	FTCB_L_INREC(R10),FTCB_L_ACT_INREC(R10)
	BRB	40$
;
;		SET UP THE DEFAULT INPUT RECORD SIZE.
;
30$:	MOVL	FTCB_L_ACT_INBLK(R10),FTCB_L_ACT_INREC(R10)
;
;		CHECK THE INPUT RECORD SIZE TO BE SURE IT IS > 0 BEFORE
;		DOING THE DIVIDE BELOW - I.E. AVOID A DIVIDE BY ZERO FAULT.
;
40$:	TSTL	FTCB_L_ACT_INREC(R10)	; IS INPUT <= 0??
	BGTR	45$		; NOT <= 0, BRANCH TO DIVIDE.
;
	MOVL	#1,FTCB_L_INRECS(R10)	; SET NUMBER OF RECORDS = 1.
	CLRL	FTCB_L_INREM(R10)	; CLEAR REMAINDER OF BYTES
	BRB	48$			; SKIP THE DIVIDE.
;
;		EXTNDED DIVIDE THE ACTUAL INPUT RECORD INTO THE ACTUAL
;		INPUT BLOCK TO GET THE NUMBER OF RECORDS/BLOCK AND
;		THE NUMBER OF ANY REMAINING BYTES IN THE INPUT
;		BLOCK.
;
45$:	MOVL	FTCB_L_ACT_INBLK(R10),FTCB_Q_ISTAT(R10)	;SET UP QUAD
	CLRL	FTCB_Q_ISTAT+4(R10)	;WORD DIVIDEND
	EDIV	FTCB_L_ACT_INREC(R10),FTCB_Q_ISTAT(R10),-
		FTCB_L_INRECS(R10),FTCB_L_INREM(R10)
;
;
;		SET UP OUTPUT RECORD SIZE AND OUTPUT BLOCK SIZE.
;
48$:	BBS	#DEFS_V_OUTREC,FTCB_W_DEFS(R10),50$	; USE DEFAULT IF SET.
;
;		USE SPECIFIED RECORD SIZE.
	MOVL	FTCB_L_OUTREC(R10),FTCB_L_ACT_OUTREC(R10)
	BRB	60$
;
50$:	MOVL	FTCB_L_ACT_INREC(R10),FTCB_L_ACT_OUTREC(R10)	; USE DEFAULT.
;
60$:	BBS	#DEFS_V_OUTBLK,FTCB_W_DEFS(R10),70$	; USE DEFAULT IF SET.
;
;		USE SPECIFIED BLOCK SIZE.
	MOVL	FTCB_L_OUTBLK(R10),FTCB_L_ACT_OUTBLK(R10)
	BRB	80$
;
70$:	MOVL	FTCB_L_ACT_OUTREC(R10),FTCB_L_ACT_OUTBLK(R10)	; USE DEFAULT.
;
;		CHECK THE OUTPUT RECORD SIZE TO BE SURE IT IS > 0 BEFORE
;		DOING EXTENDED DIVIDE BELOW.
;
80$:	TSTL	FTCB_L_ACT_OUTREC(R10)	; IS RECORD <= 0??
	BNEQ	85$			; NOT <= 0, GO TO DIVIDE.
;
	MOVL	#1,FTCB_L_OUTRECS(R10)	; CLEAR # OUTPUT RECORDS.
	CLRL	FTCB_L_OUTREM(R10)	; CLEAR REMAINDER OF OUTPUT BYTES.
	BRB	CK_RECS			; SKIP THE DIVIDE.
;
;		EXTENDED DIVIDE THE ACTUAL OUTPUT RECORD SIZE INTO THE ACTUAL
;		OUTPUT BLOCK SIZE TO GET THE NUBMER OF RECORDS/BLOCK AND
;		THE NUMBER OF BYTES REMAINING TO BE PADDED IN THE OUTPUT
;		BLOCK.
;
85$:	MOVL	FTCB_L_ACT_OUTBLK(R10),FTCB_Q_ISTAT(R10)	; BUILD QUAD
	CLRL	FTCB_Q_ISTAT+4(R10)	; WORD DIVIDEND.
	EDIV	FTCB_L_ACT_OUTREC(R10),FTCB_Q_ISTAT(R10),-
		FTCB_L_OUTRECS(R10),FTCB_L_OUTREM(R10)
;
	.PAGE
	.SUBTITLE CHECK RECORD SIZES AND PADDING AND TRAILING.
;
CK_RECS:
;		CHECK TO SEE IF THE OUTPUT WAS JUST COMPLETED AND
;		IF NOT CHECK TO SEE IF THE CURRENT OUTREC SIZE = THE NEW
;		OUTREC SIZE FROM THE MOST RECENT READ.  ALSO, CHECK THE
;		OUTBLOCK SIZES.
;
15$:	BBS	#FLAG_V_INIT_COP,FTCB_W_FLAG(R10),35$	; INIT. COPY?
;
	BBS	#FLAG_V_OUT_COMP,FTCB_W_FLAG(R10),35$	; COPY COMPLETE?
;
	CMPL	CUR_REC,FTCB_L_ACT_OUTREC(R10)
	BEQL	30$		; BRANCH IF OK TO TEST BLOCKS.
;
; 		RECORD/BLOCK SIZES CHANGED.
20$:	CALL_MSG	EXIT_SYS,#FTC_SIZECHNG,#0,#FTC_BLOCKNUM,#2,-
		FTCB_L_BLK_READ(R10),FTCB_L_BLK_WRIT(R10),-
		#FTC_SIZECHNG1,#2,CUR_REC,FTCB_L_ACT_OUTREC(R10),-
		#FTC_SIZECHNG2,#2,CUR_BLK,FTCB_L_ACT_OUTBLK(R10)
;
30$:	CMPL	CUR_BLK,FTCB_L_ACT_OUTBLK(R10)
	BNEQ	20$		; BRANCH IF NOT OK.
	BRB	40$		; BYPASS THE SAVING OF THE CURRENT SIZES.
;
;		SAVE THE CURRENT OUTPUT RECORD AND BLOCK SIZES.
;
35$:	MOVL 	FTCB_L_ACT_OUTREC(R10),CUR_REC	; SAVE RECORD.
	MOVL	FTCB_L_ACT_OUTBLK(R10),CUR_BLK	; SAVE BLOCK.
;
;
;		CHECK FOR PADDING RECORDS ON OUTPUT OR KEEPING TRAILING
;		DATA IN INPUT RECORDS.
;
40$:	CMPL	FTCB_L_ACT_INREC(R10),FTCB_L_ACT_OUTREC(R10)
;		IF IN >= OUT, SIZES OK - DON'T CHECK TRAILING.
	BGEQ	60$
;
;		IF IN<OUT, CHECK THE PADDING.
50$:	BBS	#FLAG_V_PREC,FTCB_W_FLAG(R10),60$	; IF PAD SET, CONT.
;
; 		ABORT - NO PADDING SPECIFIED.
	CALL_MSG	PUT_SYS,#FTC_FTPADERR,#2,MSG_16,MSG_16+4,-
		#FTC_BLOCKNUM,#2,FTCB_L_BLK_READ(R10),FTCB_L_BLK_WRIT(R10)
	CALLS	#0,G^FT_COP_MSG		; MESSAGE ABOUT THE AMOUNT COPIED
	CALLS	#0,G^FT_STOP		; EXIT - WITH GRACE.
;
;
;		CHECK ON PAD BLOCK DATA.
;
60$:	TSTL	FTCB_L_OUTREM(R10)	; CHECK OUT REMAINDER FOR EXTRA BYTES.
	BEQL	OUT_BLK_SIZ			; IF NONE, CONTINUE.
;
	BBS	#FLAG_V_PBLK,FTCB_W_FLAG(R10),OUT_BLK_SIZ  ; IF PAD, CONT.
;
; 		ABORT - PADDING NOT SPECIFIED.
	CALL_MSG	PUT_SYS,#FTC_FTPADERR,#2,MSG_17,MSG_17+4,-
		#FTC_BLOCKNUM,#2,FTCB_L_BLK_READ(R10),FTCB_L_BLK_WRIT(R10)
	CALLS	#0,G^FT_COP_MSG		; MESSAGE ABOUT THE AMOUNT COPIED.
	CALLS	#0,G^FT_STOP		; EXIT WITH GRACE.
;
;
;		CHECK OUTPUT BLOCK SIZES.
;
OUT_BLK_SIZ:
	BBS	#FLAG_V_FTOUT,FTCB_W_FLAG(R10),3$	; IF NOT FT, BRANCH.
	BRW	10$
;
3$:	CMPL	#65535,FTCB_L_ACT_OUTBLK(R10)	; CHECK FOR MAX. FT BLOCK.
	BGEQ	5$		; IF OK, BRANCH.
;
; 		ABORT - ILLEGAL BLOCK SIZE.
	CALL_MSG	EXIT_SYS,#FTC_BLKSIZ,#4,MSG_2,MSG_2+4,MSG_7,-
		MSG_7+4,#FTC_BLOCKNUM,#2,FTCB_L_BLK_READ(R10),-
		FTCB_L_BLK_WRIT(R10),#FTC_MAXSIZE,#2,-
		NUM_1,FTCB_L_ACT_OUTBLK(R10)
;
;		CHECK FOR THE LOW SIZE LIMIT.
5$:	CMPL	FTCB_L_ACT_OUTBLK(R10),#14	; CHECK FOR BLOCK >= 14 BYTES.
	BLSS	7$
	BRW	COPY		; IF OK, GO AND COPY.
;
; 		FATAL - BLOCK TOO SMALL FOR TAPE.
7$:	CALL_MSG	EXIT_SYS,#FTC_BLKSIZ,#4,MSG_2,MSG_2+4,MSG_6,MSG_6+4,-
		#FTC_BLOCKNUM,#2,FTCB_L_BLK_READ(R10),FTCB_L_BLK_WRIT(R10),-
		#FTC_MINSIZE,#1,FTCB_L_ACT_OUTBLK(R10)
;
;		RMS BLOCK SIZES.
;
10$:	CMPB	#DC$_DISK,FTCB_B_OUT_CLAS(R10)	; CHECK FOR DISK OR TAPE.
	BEQL	20$		; IF DISK, BRANCH.
;
	CMPL	#9991,FTCB_L_ACT_OUTBLK(R10)	; CHECK OUT RMS TAPE BLOCK.
	BLSS	15$
	BRW	COPY		; IF OK, BRANCH.
;
; 		ABORT - ILLEGAL BLOCK SIZE.
15$:	CALL_MSG	EXIT_SYS,#FTC_BLKSIZ,#4,MSG_2,MSG_2+4,MSG_7,MSG_7+4,-
		#FTC_BLOCKNUM,#2,FTCB_L_BLK_READ(R10),FTCB_L_BLK_WRIT(R10),-
		#FTC_MAXSIZE,#2,NUM_2,FTCB_L_ACT_OUTBLK(R10)
;
20$:	CMPL	#32767,FTCB_L_ACT_OUTBLK(R10)	; CHECK FOR RMS DISK BLOCK.
	BGEQ	COPY		; IF OK, BRANCH.
;
; 		ABORT - ILLEGAL BLOCK SIZE.
	CALL_MSG	EXIT_SYS,#FTC_BLKSIZ,#4,MSG_2,MSG_2+4,MSG_7,MSG_7+4,-
		#FTC_BLOCKNUM,#2,FTCB_L_BLK_READ(R10),FTCB_L_BLK_WRIT(R10),-
		#FTC_MAXSIZE,#2,NUM_3,FTCB_L_ACT_OUTBLK(R10)
;
	.PAGE
	.SUBTITLE BLANK EDIT AND COPY OR TRANSLATE DATA.
;
COPY:	BBC	#FLAG_V_BLANK,FTCB_W_FLAG(R10),20$	; IF NOT BLANK, BRANCH.
;
	CALLS	#0,G^FT_BLANK		; BLANK EDIT DATA - DUMMY ROUTINE.
;
20$:	BBS	#FLAG_V_TRANS,FTCB_W_FLAG(R10),30$	; IF TRANSLATE, BRANCH.
;
	PUSHL	FTCB_L_OUTRECS(R10)	; # OUTPUT RECORDS/BLOCK
	PUSHL	FTCB_L_OUTREM(R10)	; OUTPUT REMAINDER.
	PUSHL	FTCB_L_INRECS(R10)	; # INPUT RECORDS/BLOCK.
	PUSHL	FTCB_L_INREM(R10)	; INPUT REMAINDER.
	PUSHL	FTCB_L_ACT_OUTREC(R10)	; DESTINATION LENGTH.
	PUSHL	FTCB_L_ACT_INREC(R10)	; SOURCE LENGTH.
	CALLS	#6,G^FT_PCOPY		; CALL PLAIN COPY.
;
	BRW	INPUT_REC		; GO READ NEXT RECORD.
;
30$:	PUSHL	FTCB_L_OUTRECS(R10)	; # OUTPUT RECORDS/BLOCK
	PUSHL	FTCB_L_OUTREM(R10)	; OUTPUT REMAINDER.
	PUSHL	FTCB_L_INRECS(R10)	; # INPUT RECORDS/BLOCK.
	PUSHL	FTCB_L_INREM(R10)	; INPUT REMAINDER.
	PUSHL	FTCB_L_ACT_OUTREC(R10)	; DESTINATION LENGTH.
	PUSHL	FTCB_L_ACT_INREC(R10)	; SOURCE LENGTH.
	CALLS	#6,G^FT_TRANS		; DUMMY TRANSLATION ROUTINE.
;
	BRW	INPUT_REC		; GO READ NEXT RECORD.
;
	.PAGE
	.SUBTITLE CLOSE FILES AND CHECK FILE COUNTER FOR MORE.
;
;		CHECK TO SEE IF OUTPUT JUST COMPLETED AND IF NOT,
;		WRITE THE FINAL BLOCK.
;
CLOSE_FILE:
;		CHECK FOR FINISH ING UP AT THE END OF FT INPUT.
	CMPB	FTCB_B_EOV(R10),#1	; IF > 1, THEN EOV FOUND ON FT.
	BLEQ	5$
;
	CALL_MSG	PUT_SYS,#FTC_FTEOV,#0	; END-OF-VOLUME FOUND.
	BRW	FINISH_UP		; GO TO CLOSE AN OUTPUT RMS FILE.
;
5$:	BBC	#FLAG_V_OUT_COMP,FTCB_W_FLAG(R10),10$	; IF CLEAR, WRITE.
;
	BRB	CLOSE_FILE_1		; JUST GO END THE FILES.
;
10$:	BBS	#FLAG_V_PBLK,FTCB_W_FLAG(R10),30$	; IF SET, PAD.
;
;
;		DO NOT PAD THE LAST BLOCK  --  JUST WRITE IT AS IS.
;
	CLRL	FTCB_L_OUTREM(R10)	; CLEAR THE NUMBER OF BYTES REMAINING.
	SUBL2	R8,FTCB_L_OUTRECS(R10)	; FIGURE THE NUMBER OF RECORDS ACTUALLY
					; WRITTEN TO THE BLOCK AND THEN
	MULL3	FTCB_L_ACT_OUTREC(R10),FTCB_L_OUTRECS(R10),-	; THE NUMBER OF
		FTCB_L_ACT_OUTBLK(R10)	; BYTES TO WRITE TO THE LAST BLOCK.
;
	BRB	40$		; GO WRITE.
;
;		PAD THE LAST BLOCK.
;
;		CALCULATE THE NUMBER OF BYTES REMAINING TO BE
;		PADDED INTO THE BLOCK.
30$:	MULL3	R8,FTCB_L_ACT_OUTREC(R10),R7	; PUT INTO TEMP. LOCATION AND
	ADDL2	R7,FTCB_L_OUTREM(R10)		; ADD IN THE CURRENT REMAINDER.
;
;		CALL THE OUTPUT ROUTINE
;
; 			IS TRANSLATION BEING DONE?
	BBS	#FLAG_V_TRANS,FTCB_W_FLAG(R10),35$
;			PUSH THE ADDRESS OF THE PLAIN COPY OUTPUT.
	PUSHL	R3
	BRB	40$
;			PUSH THE ADDRESS OF THE TRANSLATION ROUTINE.
35$:	PUSHL	R5
;
40$:	PUSHL	FTCB_L_OUTREM(R10)	; PUSH THE NUMBER OF BYTES REMAINING.
	CALLS	#2,G^FT_PADEVEN		; PAD/EVEN THE OUTPUT BLOCK.
;
	CALLS	#0,G^FT_OUTPUT		; WRITE THE LAST BLOCK.
;
;		CHECK ON CLOSING AN FT OR AN RMS FILE AND CLOSE.
;
CLOSE_FILE_1:
	BBS	#FLAG_V_FTOUT,FTCB_W_FLAG(R10),20$	; IF SET, FOREIGN TAPE.
;
	$CLOSE	FAB=OUT_FAB	; CLOSE THE OUTPUT RMS FILE.
;
	BLBC	R0,10$		; IF LBC, ERROR
	BRW	RECYCLE		; START THE CYCLE OVER AGAIN.
;
; 		FATAL - ERROR ON CLOSE.
10$:	MOVAL	OUT_NAM,R6	; GET ADDRESS OF OUTPUT NAM BLOCK.
	MOVZBL	NAM$B_ESL(R6),R5	; GET LENGTH OF EXPANDED STRING.
	CALL_MSG	EXIT_SYS,#FTC_RMSERROR,#4,MSG_12,MSG_12+4,-
		R5,NAM$L_ESA(R6),R0,OUT_FAB+FAB$L_STV
;
;
;		FOREIGN TAPE FINISH UP.
;
20$:	PUSHAL	FTCB+FTCB_Q_ISTAT	; ADDRESS OF STATUS BLOCK
	PUSHAL	FTCB+FTCB_L_OUTLUN	; ADDRESS OF LUN.
	CALLS	#2,G^TAPE_EOF
;
	CMPL	FTCB_Q_ISTAT(R10),#SS$_NORMAL	; CHECK FOR NORMAL COMPLETION.
	BNEQ	25$
	BRB	RECYCLE		; START CYCLE OVER AGAIN.
;
25$:	CMPL	#3,FTCB_Q_ISTAT(R10)	; CHECK FOR E-O-T FOUND.
	BNEQ	30$
;
	CALL_MSG	PUT_SYS,#FTC_FTEOT,#2,MSG_15,MSG_15+4,-
		#FTC_OPERTERM,#0	; END-OF-TAPE FOUND.
	CLRL	COUNT_FILE		; MAKE NUMBER OF FILES REMAINING = 0
	BRB	RE_CYC_2
;
30$:	CMPL	#5,FTCB_Q_ISTAT(R10)	; CHECK FOR DATACHECK.
	BNEQ	40$
;
; 		DATA CHECK FOUND - EXIT.
	CALL_MSG	EXIT_SYS,#FTC_FTERROR,#2,MSG_5,MSG_5+4,#SS$_DATACHECK
;
; 		UNKNOWN ERROR - EXIT.
40$:	CALL_MSG	EXIT_SYS,#FTC_FTERROR,#2,MSG_5,MSG_5+4,-
		#FTC_ERRCODE,#1,FTCB_Q_ISTAT(R10),FTCB_Q_ISTAT(R10)
;
;
;		RE START THE CYCLE OF READING AND DEBLOCKING AND WRITING.
;
RECYCLE:
	INCL	FTCB_L_FILCOP(R10)	; COUNT OF FILES COPIED.
RE_CYC_2:
	CALLS	#0,G^FT_COP_MSG		; PRINT THE NUMBER COPIED MESSAGE.
;
	SOBGTR	COUNT_FILE,RECYC_2	; DECREMENT THE FILE COUNT AND EXIT
					; IF NOT GREATER THAN 0.
;
;
;		EXIT PROGRAM WITH A NORMAL STATUS BUT DON'T
;		PRINT THE MESSAGE.
;
RECYC_1:
	CALLS	#0,G^FT_STOP		; EXIT THE PROGRAM WITH PROPER SEVERITY
;
;
;		SET THE INITIALIZE COPY FLAG TO START ALL OVER AND
;		CLEAR THE BLOCK AND RECORD COUNTERS.
;
RECYC_2:
	BBSS	#FLAG_V_INIT_COP,FTCB_W_FLAG(R10),15$
;
15$:	CLRL	FTCB_L_REC_READ(R10)	; CLEAR THE RECORDS READ.
	CLRL	FTCB_L_REC_WRIT(R10)	; CLEAR THE RECORDS WRITTEN.
	CLRL	FTCB_L_BLK_READ(R10)	; CLEAR THE BLOCKS READ.
	CLRL	FTCB_L_BLK_WRIT(R10)	; CLEAR THE BLOCKS WRITTEN.
;
;		CHECK TO SEE IF RMS AND CREATE NEW VERSION OF
;		FILE BEFORE GOING BACK FOR MORE.
;
20$:	BBC	#FLAG_V_FTOUT,FTCB_W_FLAG(R10),30$
;
	BRW	INPUT_REC		; GO TO READ NEXT INPUT BLOCK.
;
;		CALL THE CREATE ROUTINE.
;
30$:	PUSHAL	OUT_FAB		; ADDRESS OF THE OUTPUT FAB.
	PUSHAL	OUT_RAB		; ADDRESS OF THE OUTPUT RAB.
	CALLS	#2,G^FT_CREATE
;
	BRW	INPUT_REC		; GO BACK TO READ NEXT RECORD.
;
;
;		IF THE END OF FOREIGN TAPE INPUT, CHECK FOR RMS OUTPUT AND
;		CLOSE AN OPEN FILE IF NECESSARY.
;
FINISH_UP:
	BBS	#FLAG_V_FTOUT,FTCB_W_FLAG(R10),RECYC_1	; IF FT OUT, GO BACK.
;
	MOVAL	OUT_FAB,R8			; GET ADDRESS OF OUTPUT FAB
	BISL2	#FAB$M_DLT,FAB$L_FOP(R8)	; SET FLAG TO DELETE ON CLOSE.
	$CLOSE	FAB=R8			; CLOSE THE EXTRA OUTPUT FILE & DELETE.
;
	BLBC	R0,10$			; IF NOT GOOD, PUT ERROR MESSAGE.
	BRW	RECYC_1			; GOOD CLOSE, NORMAL EXIT.
;
; 		FATAL - RMS CLOSE FILE ERROR.
10$:	MOVL	FAB$L_NAM(R8),R6	; GET NAM ADDRESS.
	MOVZBL	NAM$B_ESL(R6),R5	; GET EXPANDED NAME STRING ADDRESS.
	CALL_MSG	EXIT_SYS,#FTC_RMSERROR,#4,MSG_12,MSG_12+4,-
		R5,NAM$L_ESA(R6),R0,FAB$L_STV(R8)
;
	.END	FTCOPY