.TITLE	MTEXCH	Read or Write Blocked Magtapes
	.IDENT	/1.01/
;  MTEXCH is a utility for copying files to and from a magnetic tape.
;  The tape records may be blocked.  Parameters on the command line 
;  specify the block and record sizes and formats for both tape and disk
;  files.  Each record in the input file generates one record in the output
;  file.  Each input file creates one output file.  Input files can be
;  specified using wildcard notation.  No file name information is assumed
;  for the tape (unlabeled).


;  Command syntax:
;	outfile/sw = infile/sw
;  where:
;	outfile - file spec for output file
;	infile  - file spec for input files, separated by commas
;	sw      - one or more of the following option switches.
;		  switches may be shortened to the shortest unique
;		  abbreviation.
;		ASCII - Tape file is/should be in ASCII (default)
;		EBCDIC - Tape file is/should be EBCDIC
;		BLOCKSZ:nnn - number of bytes in a block (Will be overriden
;			      by actual blocksize for volume)
;		RECLEN:nnn - number of bytes in a record (Ignored for disk
;			     input file.)
;		FIXED - records are fixed length (default for tape)
;		VARIABLE - records are variable length with 2 byte binary
;			   length (default for disk)
;		FB - blocks are fixed length with integral number of
;	     	     records.
;		CR - Set CR carriage control attribute for file (default)
;		FORTRAN - Set FTN carriage control attribute for file
;		REWIND - Rewind the magnetic tape.  Takes precedence over 
;			 SKIPF.
;		SKIPF:[-]n - Skip the tape forward [backward] n files.

;  Record/block format information is ignored for files being read from
;  disk.  Blocking information is ignored for files being written to disk.
;  If conflicting switches are specified for a file, the last one encountered
;  is used.

;  Program is installed with the following commands:
;	$MACRO MTEXCH
;	$LINK MTEXCH

;  Program is run by:
;	$RUN MTEXCH
;	*    enter command strings
;	*  ^Z to terminate
;  Commands are read from SYS$INPUT and messages written to SYS$OUTPUT.

;  Revision history

;  Written by Gary Grebus
;	      Computer Center
;             Battelle Columbus Labs
;	      505 King Ave.
;             Columbus, Ohio  43201

;  19-SEP-79   GLG   Initial version.
;  16-OCT-79   GLG   Initial complete version. (1.00)
;			Cleaned up initialization of FAB's, added
;			ASCII-EBCDIC code translation, Added CR switch,
;			Add blocksize mismatch error message and EOT
;			detection for MT:* get spec
;  06-JAN-80   GLG   Added REWIND and SKIPF switches and MT_PHYS routine
;			for doing tape positioning

	.PAGE
	.SBTTL	Local Macros

;  Local macros

	.MACRO	SWITCH	NAME,VAL1=0,VAL2=0
;  Macro to generate an entry in the switch table
	.ASCII	/NAME/			;Generate name blank filled
	.IF	GT <SWITCH_NAME_SZ-%LENGTH(NAME)>
	.BYTE	^A/ /[<SWITCH_NAME_SZ-%LENGTH(NAME)>]
	.IF_FALSE
	.IF	LT <SWITCH_NAME_SZ-%LENGTH(NAME)>
	.WARN				;Switch name too long
	.ENDC
	.ENDC
	.WORD	VAL1			;Value to store in vector
	.WORD	VAL2			;Offset of where to store it
	.ENDM	SWITCH

	.MACRO	MSG	DESC,ORAB=OUT_RAB
;  Macro to issue a message on the output file.  DESC is character string
;  descriptor of message.  ORAB is name of the output file RAB.
	$RAB_STORE -
		RAB='ORAB,-
		RBF=@'DESC+4,RSZ='DESC	;Point RAB at the message
	$PUT	RAB='ORAB		;Write the message
	.ENDM	MSG

	.MACRO	DESCBLOCK	SIZE,?LABEL
;   Generates character descriptor pointing to a block of SIZE bytes
	.LONG	SIZE
	.ADDRESS	LABEL
LABEL:	.BLKB	SIZE
	.ENDM	DESCBLOCK

	.PAGE
	.SBTTL	Symbol Definitions

	.ENABLE	DEBUG

;  Macro calls to define system symbols
	$DIBDEF
	$DEVDEF

;  Local symbol definitions
CMD_BUF_SZ=133				;Size of command input buffer (bytes)
					;Max command length is one less
ASCII=0					;Codes for character sets
EBCDIC=1
FIXED=0					;Codes for record formats
VARIABLE=1
FB=0					;Codes for block formats
CR=0					;Codes for carriage control attributes
FORTRAN=1
SWITCH_NAME_SZ=8			;Max length of switch name
SWITCH_T_NAME=0				;Offset in switch table entry-name
SWITCH_W_VAL=SWITCH_NAME_SZ		;	"	"	"    -value
SWITCH_W_OFF=SWITCH_W_VAL+2		;	"	"	"    -offset
SWITCH_ENT_SZ=SWITCH_NAME_SZ+4		;Size of a switch table entry
FAO_BUF_SZ=80				;Size of FAO scratch buffer
MAX_REC_SZ=32000			;Default maximum record size
CH.CR=^O15				;ASCII carriage control code
CH.LF=^O12				;ASCII line feed code
;  Offsets into file status vectors
VEC_L_COD=0				;Character set code
VEC_L_BLS=4				;Block size
VEC_L_REC=8				;Record size
VEC_L_STS=12				;Status flag word
VEC_L_RCF=16				;Record format code
VEC_L_BLF=20				;Block format code
VEC_L_CC=24				;Carriage control attribute code
VEC_L_SKP=28				;File skip count
VEC_L_REW=32				;Rewind flag
VEC_C_LEN=36				;Length of file status vector
;  Definitions of bits in status flag word
STS_M_BLK=^X0001			;File is block oriented (tape)
STS_M_REC=^X0002			;File is record oriented (disk)
	.PAGE
	.SBTTL	Read-Only Data Areas

	.PSECT	RODATA SHR,RD,NOWRT,NOEXE,LONG

PROMPT_STR:
	.ASCII	<CH.CR><CH.LF>/*/
PROMPT_SZ=.-PROMPT_STR

;  Switch decoding table
;  Table contains valid switch names and control information used by GET_SW.
;  Table entry fields are:
;	1)Switch name
;	2) >= 0   Value to store in file vector
;	    =-1   Get numeric value and store it
;	3)Offset in file vector at which the value should be stored.

SWITCH_TB:
	SWITCH	ASCII,ASCII,VEC_L_COD
	SWITCH	EBCDIC,EBCDIC,VEC_L_COD
	SWITCH	BLOCKSZ,-1,VEC_L_BLS
	SWITCH	RECLEN,-1,VEC_L_REC
	SWITCH	FIXED,FIXED,VEC_L_RCF
	SWITCH	VARIABLE,VARIABLE,VEC_L_RCF
	SWITCH	FB,FB,VEC_L_BLF
	SWITCH	FORTRAN,FORTRAN,VEC_L_CC
	SWITCH	CR,CR,VEC_L_CC
	SWITCH	SKIPF,-1,VEC_L_SKP
	SWITCH	REWIND,1,VEC_L_REW
END_SW_TB=.-1

;  Character dispatch table used to control scanning of command lines.
;  Table codes are:
;	0 - skip this character
;	1 - delimiter
;	2 - invalid character
ALPH_TBL:
	.BYTE	2[32]			;Control chars invalid
	.BYTE	0[12],1,0[2],1
	.BYTE	0[10],1,0,0,1,0[66]
	.BYTE	1			;End of string marker

;  Translation table address vectors
TO_ASC_ADR:
	.LONG	0			;Dummy entry - ASCII to ASCII
	.ADDRESS	EBC_TO_ASC	;EBCDIC to ASCII

FROM_ASC_ADR:
	.LONG	0			;Dummy entry - ASCII to ASCII
	.ADDRESS	ASC_TO_EBC	;ASCII to EBCDIC

;  Translation tables
;  EBCDIC to ASCII
EBC_TO_ASC:
	.ASCII	/................................/
	.ASCII	/................................/
	.ASCII	/ ...........<(+|&.........!$*);^/
	.ASCII	$-/........|,%_>?.........`:#@'="$
	.ASCII	/.abcdefghi.......jklmnopqr....../
	.ASCII	/..stuvwxyz...[...............]../
	.ASCII	/{ABCDEFGHI......}JKLMNOPQR....../
	.ASCII	/\.STUVWXYZ......0123456789....../

;  ASCII to EBCDIC
ASC_TO_EBC:
	.BYTE	75[32]			;Control chars map to .
	.BYTE	64,90,127,123,91,108,80,125
	.BYTE	77,93,92,78,107,96,75,97
	.BYTE	240,241,242,243,244,245,246,247
	.BYTE	248,249
	.BYTE	122,94,76,126,110,111,124
	.BYTE	193,194,195,196,197,198,199,200
	.BYTE	201,209,210,211,212,213,214,215
	.BYTE	216,217,226,227,228,229,230,231
	.BYTE	232,233
	.BYTE	173,224,189,95,109,121
	.BYTE	129,130,131,132,133,134,135,136
	.BYTE	137,145,146,147,148,149,150,151
	.BYTE	152,153,162,163,164,165,166,167
	.BYTE	168,169
	.BYTE	192,106,208,161,75

;  Error messages
BAD_FS_O:
	.ASCID	/%MTEXCH-E-BADFSO, Bad or missing filespec for output./
WC_IN_OUT:
	.ASCID	/%MTEXCH-E-WCINOUT, Wild character illegal in output spec./
BOTH_REC:
	.ASCID	/%MTEXCH-E-BOTHREC, Both input and output files are disk./
BOTH_BLK:
	.ASCID	/%MTEXCH-E-BOTHBLK, Both input and output files are tape./
IO_MSG:
	.ASCID	$%MTEXCH-F-IOERR, I/O error for file !AD.$
UNK_SW:
	.ASCID	/%MTEXCH-E-UNKSW, Unknown switch !AD./
AMBIG_SW:
	.ASCID	/%MTEXCH-E-AMBIG, Switch abbreviation !AD is ambiguous./
NOVAL_SW:
	.ASCID	/%MTEXCH-E-NOVAL, Value required for switch !AD./
BAD_VAL:
	.ASCID	/%MTEXCH-E-BADVAL, Illegal value !AD./
GET_TOO_LNG:
	.ASCID	/%MTEXCH-W-TRU, Input file record truncated./ -
		/ Length=!SL bytes./
REC_TOO_BLK:
	.ASCID	/%MTEXCH-W-RECBLK, Records do not exactly fill "B" type/ -
		$ block.  Last record truncated. $
PUT_TOO_LNG:
	.ASCID	/%MTEXCH-W-PUTTRU, Output file record truncated. Length=/ -
		/!SL bytes. /
SHRT_REC:
	.ASCID	/%MTEXCH-W-RECSHR, Short record encountered, Length=!SL bytes/
BLKSZ_BAD:
	.ASCID	/%MTEXCH-W-BLKSZ, BLOCKSZ value doesn't match volume./-
		/ Actual size of !SL bytes used./
MTF_CHAN:
	.ASCID	/%MTEXCH-E-CHAN, Couldn't position tape. Channel assignment/ -
		/ failed./
MTF_QIO:
	.ASCID	/%MTEXCH-E-QIO, Couldn't position tape. QIO call failed/
MTF_FAIL:
	.ASCID	/%MTEXCH-E-POSFAIL, Couldn't position tape. Tape error./

	.PAGE
	.SBTTL	Read/Write Data Areas

	.PSECT	RWDATA NOSHR,RD,WRT,NOEXE,LONG

;  FAB and RAB for command file
IN_FAB:	$FAB	FNM=<SYS$INPUT>,-
		FAC=GET,ORG=SEQ,-
		RFM=VAR

IN_RAB:	$RAB	FAB=IN_FAB,PBF=PROMPT_STR,-
		PSZ=PROMPT_SZ,ROP=<CVT,PMT>,-
		UBF=CMD_BUF,USZ=CMD_BUF_SZ

;  FAB and RAB for message output file
OUT_FAB:
	$FAB	FNM=<SYS$OUTPUT>,-
		FAC=PUT,ORG=SEQ,-
		RAT=CR,RFM=VAR

OUT_RAB:
	$RAB	FAB=OUT_FAB

;  FAB, NAM, and RAB skeletons for data input file
GET_FAB:
	$FAB	FAC=<GET,BRO>, NAM=GET_NAM,-
		FOP=<POS,NAM>,ORG=SEQ,FNA=GET_FSPEC

GET_RAB:
	$RAB	FAB=GET_FAB

GET_NAM:
	$NAM	ESA=GET_ESA,ESS=NAM$C_MAXRSS,-
		RSA=GET_RSA,RSS=NAM$C_MAXRSS

;  FAB, NAM, and RAB skeletons for data output file
PUT_FAB:
	$FAB	FAC=<PUT,BRO>,FOP=POS,ORG=SEQ,-
		FNA=PUT_FSPEC,NAM=PUT_NAM

PUT_RAB:
	$RAB	FAB=PUT_FAB

PUT_NAM:
	$NAM	RSA=PUT_RSA,RSS=NAM$C_MAXRSS

;  File name and command buffers
CMD_BUF:
	.BLKB	CMD_BUF_SZ		;Buffer to hold command line on input

GET_ESA:
	.BLKB	NAM$C_MAXRSS		;Expanded string area for GET filespec

GET_RSA:
	.BLKB	NAM$C_MAXRSS		;Result string area for GET filespec

PUT_RSA:
	.BLKB	NAM$C_MAXRSS		;Result string area for PUT filespec

GET_FSPEC:
	.BLKB	NAM$C_MAXRSS		;Buffer for GET file spec

PUT_FSPEC:
	.BLKB	NAM$C_MAXRSS		;Buffer for PUT file spec

;  Status vectors for GET and PUT files.  Used to hold information from
;  command parse and file status info.
;  GET file vector
GVEC:
GVEC_L_COD:
	.BLKL	1			;Character set code
GVEC_L_BLS:
	.BLKL	1			;Block size
GVEC_L_REC:
	.BLKL	1			;Record size
GVEC_L_STS:
	.BLKL	1			;Status bits
GVEC_L_RCF:
	.BLKL	1			;Record format code
GVEC_L_BLF:
	.BLKL	1			;Block format code
GVEC_L_CC:
	.BLKL	1			;Carriage control code
GVEC_L_SKP:
	.BLKL	1			;File skip count
GVEC_L_REW:
	.BLKL	1			;Rewind flag

;  PUT file vector
PVEC:
PVEC_L_COD:
	.BLKL	1
PVEC_L_BLS:
	.BLKL	1
PVEC_L_REC:
	.BLKL	1
PVEC_L_STS:
	.BLKL	1
PVEC_L_RCF:
	.BLKL	1
PVEC_L_BLF:
	.BLKL	1
PVEC_L_CC:
	.BLKL	1
PVEC_L_SKP:
	.BLKL	1
PVEC_L_REW:
	.BLKL	1

;  Dynamic buffer allocation control info
BLK_BUF_PTR:
	.BLKL	2			;Pointers to beginning and end of
					;block (tape) buffer
REC_BUF_PTR:
	.BLKL	2			;Pointers to beginning and end of
					;record (disk) buffer
BLK_BUF_SZ:
	.WORD	0			;Size of block buffer (bytes)
REC_BUF_SZ:
	.WORD	0			;Size of record buffer (bytes)

;  Command parse status info
CMD_NXTCH:
	.BLKL	1			;Pointer to next character in command 
CMD_LC:	.BLKL	1			;Length of remainder of command

;  Device type determination 
DEV_DESC:
	DESCBLOCK	NAM$C_DVI	;Descriptor to hold device name for
					;$GETDEV
DEV_CHR_BUF:
	DESCBLOCK	DIB$K_LENGTH	;Buffer for device characteristics

FAO_BUF:
	DESCBLOCK	FAO_BUF_SZ	;Buffer for formatting messages into

;  Control info for filling block buffer
BLK_FIL_PTR:
	.BLKL	1			;Address of next byte in block buffer
BLK_FIL_LC:
	.BLKL	1			;Number of bytes remaining in block

;  Counter for number of records read from a file
REC_RD_CNT:
	.BLKL	1

;  Storage used for QIO positioning functions
MT_CHAN:
	.BLKW	1			;Channel number
MT_IOSB:
	.BLKL	2			;I/O status block
MT_QIOPL:
	$QIOW	CHAN=0,-
		IOSB=MT_IOSB,-
		FUNC=IO$_SKIPFILE,-
		P1=0			;Parm block for SKIP QIO call.

	.PAGE
	.SBTTL	Main Program

	.PSECT	CODE RD,NOWRT,SHR,LONG,EXE
	.ENTRY	MTEXCH,^M<R2,R3,R4,R5,R6,R7,R8,R9>

;  Register usage:
;	No global values are held in registers
;	R0-R9 are used for scratch

;  Initialization

;  Open command and message files
	$OPEN	FAB=OUT_FAB		;Open message output file
	BLBS	R0,10$			;Branch if successful
	MOVAL	OUT_FAB,R1		;R1 points to bad FAB
	BRW	IO_ERR			;Handle error condition

10$:	$CONNECT	RAB=OUT_RAB	;Connect its RAB
	BLBS	R0,20$			;Branch if success
	MOVAL	OUT_FAB,R1		;R1 points to bad FAB
	BRW	IO_ERR			;Handle error condition

20$:	$OPEN	FAB=IN_FAB		;Open command input file
	BLBS	R0,30$			;Branch if success
	MOVAL	IN_FAB,R1		;R1 points to bad FAB
	BRW	IO_ERR			;Handle error conditions

30$:	$CONNECT	RAB=IN_RAB	;Connect its RAB
	BLBS	R0,READ_A_CMD		;Branch if success
	MOVAL	IN_FAB,R1		;Point at bad FAB
	BRW	IO_ERR			;Handle error condition

;  Read the next command line after issuing a prompt
READ_A_CMD:
	$GET	RAB=IN_RAB		;Read a command line
	BLBS	R0,20$			;Branch if success
	CMPL	R0,#RMS$_EOF		;End of file?
	BNEQ	10$			;Branch if not
	BRW	NORM_EXIT		;Clean up and stop
10$:	MOVAL	IN_FAB,R1		;R1 points to bad FAB
	BRW	IO_ERR			;Handle error condition

;  Initialize scan and start parsing
20$:	MOVAL	CMD_BUF,CMD_NXTCH	;Point to first char in command
	MOVZWL	IN_RAB+RAB$W_RSZ,-
		R1			;Get length of command
	BEQL	READ_A_CMD		;Ignore zero length commands
	ADDL3	R1,#1,CMD_LC		;Compute length including
					;end_of_string mark
	MOVB	#^X80,CMD_BUF[R1]	;Store end_of_string mark

	.PAGE
	.SBTTL	Setup PUT File

;  Get the PUT file spec and check it
	CLRB	PUT_NAM+NAM$B_RSL	;Zero length of name in NAM block
	MOVAL	PUT_FSPEC,R1		;Point to destination buffer
	BSBW	GET_SPEC		;Get file spec from command line
	TSTL	R0			;Test returned string length
	BNEQ	30$			;Branch if non-zero length
	MSG	BAD_FS_O		;Issue error message
	BRW	READ_A_CMD		;Get new command

30$:	MOVL	R0,R1			;$FAB_STORE zaps R0
	$FAB_STORE -
		FAB=PUT_FAB,FNS=R1	;Put the length in the FAB
	LOCC	#^A/*/,R1,PUT_FSPEC	;Look for a wild character
	BEQL	40$			;Branch if not found
	MSG	WC_IN_OUT		;Issue error message
	BRW	READ_A_CMD		;Get new command

;  Figure out the device type for the file spec
40$:	MOVC5	#0,.,#0,#VEC_C_LEN,PVEC	;Clear the PUT file vector
	$PARSE	FAB=PUT_FAB		;Parse the PUT file spec
	MOVZBL	PUT_NAM+NAM$T_DVI,-
		DEV_DESC		;Put length into descriptor
	MOVC3	DEV_DESC,-
		PUT_NAM+NAM$T_DVI+1,-
		DEV_DESC+8		;Move the device name to a desc
	$GETDEV_S -
		DEVNAM=DEV_DESC,-
		PRIBUF=DEV_CHR_BUF	;Get device characteristics
	BLBS	R0,50$			;Branch if successful
	BRW	ERR_EXIT		;Else handle error condition

50$:	BITL	#DEV$M_RND,-
		DEV_CHR_BUF+DIB$L_DEVCHAR+8 ;Is device random access?
	BEQL	60$			;Branch if not
	BISL2	#STS_M_REC,-
		PVEC_L_STS		;Disk is "record" device
	BRB	PVEC_INI
60$:	BISL2	#STS_M_BLK,-
		PVEC_L_STS		;Non-disk is "block" device

;  Based on device type, initialize PVEC
PVEC_INI:
	MOVL	#ASCII,PVEC_L_COD	;Set default character set ASCII
	MOVL	#CR,PVEC_L_CC		;Set default carriage control to CR
	BITL	#STS_M_BLK,PVEC_L_STS	;Is device tape?
	BEQL	10$			;Branch if not
	MOVL	#FB,PVEC_L_BLF		;Set default "FB" for tape output
	MOVL	#FIXED,PVEC_L_RCF	;Set default "FIXED" for tape output 
	MOVL	#80,PVEC_L_REC		;Set default record length=80
	BRB	20$
10$:	MOVL	#VARIABLE,PVEC_L_RCF	;Default of "VARIABLE" for disk output

;  Get the switches supplied, overriding the defaults
20$:	MOVAL	PVEC,R1			;Point to PUT file vector
	BSBW	GET_SW			;Get switches
	BLBS	R0,30$			;Branch if success
	BRW	READ_A_CMD		;Else get new command

;  Test for and execute any positioning functions if tape
30$:	BITL	#STS_M_BLK,PVEC_L_STS	;Is device tape?
	BEQL	40$			;Branch if not
	MOVAL	PVEC,R1			;Point to file vector
	BSBW	MT_PHYS			;Do the positioning
	BLBS	R0,40$			;Branch if successful
	BRW	READ_A_CMD		;Else read new command

;  Use the vector information to finish filling the FAB
40$:	MOVAL	PVEC,R1			;R1 points to vector
	MOVAL	PUT_FAB,R2		;R2 points to FAB
	BSBW	VEC_TO_FAB		;Move the data

	.PAGE
	.SBTTL	Setup Next GET File

;  Get the next GET file spec from the command
G_NXT_SPEC:
	CLRB	GET_NAM+NAM$B_RSL	;Clear name length in NAM
	MOVAL	GET_FSPEC,R1		;Point to destination buffer
	BSBW	GET_SPEC		;Get the file spec from the command
	TSTL	R0			;Test retured string length
	BNEQ	10$			;Branch if success
	BRW	READ_A_CMD		;No more GET files - get new command

10$:	MOVL	R0,R1			;$FAB_STORE zaps R0
	$FAB_STORE -
		FAB=GET_FAB,FNS=R1	;Put spec length in FAB

;  Figure out device type for file
	MOVC5	#0,.,#0,#VEC_C_LEN,GVEC	;Clear the GET file vector
	$PARSE	FAB=GET_FAB		;Parse the GET file spec
	MOVZBL	GET_NAM+NAM$T_DVI,-
		DEV_DESC		;Put length into descriptor
	MOVC3	#NAM$C_DVI,-
		GET_NAM+NAM$T_DVI+1,-
		DEV_DESC+8		;Move device name to desc
	$GETDEV_S -
		DEVNAM=DEV_DESC,-
		PRIBUF=DEV_CHR_BUF	;Get device characteristics
	BLBS	R0,20$			;Branch if success
	BRW	ERR_EXIT		;Handle error condition

20$:	BITL	#DEV$M_RND,-
		DEV_CHR_BUF+DIB$L_DEVCHAR+8 ;Is device random access?
	BEQL	30$			;Branch if not
	BISL2	#STS_M_REC,GVEC_L_STS	;Disk is "record" device
	BITL	#STS_M_REC,PVEC_L_STS	;Is PUT file also disk?
	BEQL	GVEC_INI		;Branch if not
	MSG	BOTH_REC		;Issue error message
	BRW	READ_A_CMD		;Get new command

30$:	BISL2	#STS_M_BLK,-
		GVEC_L_STS		;Non-disk is "block" device
	BITL	#STS_M_BLK,-
		PVEC_L_STS		;Is PUT file tape too?
	BEQL	GVEC_INI		;Branch if not
	MSG	BOTH_BLK		;Issue error message
	BRW	READ_A_CMD		;Get new command

;  Based on device type, initialize default GVEC
GVEC_INI:
	MOVL	#ASCII,GVEC_L_COD	;Set default character set ASCII
	MOVL	#CR,GVEC_L_CC		;Set default carriage control to CR
	BITL	#STS_M_BLK,GVEC_L_STS	;Is device tape?
	BEQL	10$			;Branch if not
	MOVL	#FB,GVEC_L_BLF		;Set default of "FB" for tape input
	MOVL	#FIXED,GVEC_L_RCF	;Set default of "FIXED" for tape input
	MOVL	#80,GVEC_L_REC		;Set default record length=80
	BRB	20$
10$:	MOVL	#VARIABLE,GVEC_L_RCF	;Default of "VARIABLE" for disk input

;  Get the switches supplied, overriding the defaults
20$:	MOVAL	GVEC,R1			;Point the GET file vector
	BSBW	GET_SW			;Get switches
	BLBS	R0,30$			;Branch if success
	BRW	READ_A_CMD		;Else get next command

;  Test for and execute any positioning functions, if tape
30$:	BITL	#STS_M_BLK,GVEC_L_STS	;Is device tape
	BEQL	40$			;Branch if not
	MOVAL	GVEC,R1			;Point to file vector
	BSBW	MT_PHYS			;Do the positioning
	BLBS	R0,40$			;Branch if success
	BRW	READ_A_CMD		;Else read new command

;  Use the vector info to finish filling the FAB
40$:	MOVAL	GVEC,R1			;R1 points to the vector
	MOVAL	GET_FAB,R2		;R2 points to FAB
	BSBW	VEC_TO_FAB		;Move the data

;  Here we get the next wild card name for the GET file spec
G_NXT_WC:
	BITL	#STS_M_BLK,-
		GVEC_L_STS		;Is GET file tape?
	BNEQ	OPEN_ALL		;Skip $SEARCH for tape
	$SEARCH	FAB=GET_FAB		;Look for a matching name
	BLBS	R0,OPEN_ALL		;Branch if one found
	CMPL	R0,#RMS$_NMF		;No more matching names?
	BNEQ	10$			;Branch if other error
	BRW	G_NXT_SPEC		;Else, get next spec in command
10$:	MOVAL	GET_FAB,R1		;Else point to bad FAB
	BRW	IO_ERR			;And handle error condition

	.PAGE
	.SBTTL	Open Files and Get Buffers

;  Open the files
;  If blocksizes were specified, check that they match blocksize for volume
OPEN_ALL:
	MOVZWL	GET_FAB+FAB$W_BLS,R2	;Save specified block size
	$OPEN	FAB=GET_FAB		;Open via NAM block for GET
	BLBS	R0,20$			;Branch if success
	MOVAL	GET_FAB,R1		;Point at bad FAB
	BRW	IO_ERR			;Handle error condition

20$:	TSTL	R2			;Was a blocksize specified?
	BEQL	25$			;Branch if not
	CMPW	R2,GET_FAB+FAB$W_BLS	;Is the blocksize what we asked for?
	BEQL	25$			;Branch if OK
	MOVZWL	GET_FAB+FAB$W_BLS,R2	;Get real blocksize
	$FAO_S	CTRSTR=BLKSZ_BAD,-
		OUTLEN=FAO_BUF,-
		OUTBUF=FAO_BUF,-
		P1=R2			;Fill in a warning message
	MSG	FAO_BUF			;Issue the warning
	MOVL	#FAO_BUF_SZ,FAO_BUF	;Reset message descriptor

25$:	$CONNECT	RAB=GET_RAB	;Connect its RAB
	BLBS	R0,30$			;Branch if success
	MOVAL	GET_FAB,R1		;Point at bad FAB
	BRW	IO_ERR			;Handle error condition

30$:	MOVZWL	PUT_FAB+FAB$W_BLS,R2	;Save specified blocksize
	$CREATE	FAB=PUT_FAB		;Create the PUT file
	BLBS	R0,40$			;Branch if success
	MOVAL	PUT_FAB,R1		;Point at bad FAB
	BRW	IO_ERR			;Handle error condition

40$:	TSTL	R2			;Was blocksize specified
	BEQL	45$			;Branch if not
	CMPW	R2,PUT_FAB+FAB$W_BLS	;Is size what we asked for?
	BEQL	45$			;Branch if OK
	MOVZWL	PUT_FAB+FAB$W_BLS,R2	;Get real blocksize
	$FAO_S	CTRSTR=BLKSZ_BAD,-
		OUTLEN=FAO_BUF,-
		OUTBUF=FAO_BUF,-
		P1=R2			;Fill in a warning message
	MSG	FAO_BUF			;Issue the warning message
	MOVL	#FAO_BUF_SZ,FAO_BUF	;Reset message descriptor

45$:	$CONNECT	RAB=PUT_RAB	;Connect its RAB
	BLBS	R0,GET_BUFS		;Branch if success
	MOVAL	PUT_FAB,R1		;Point at bad FAB
	BRW	IO_ERR			;Handle error condition

;  Allocate some buffers to do the work in

;  First, get the buffer to hold a record
GET_BUFS:
	BITL	#STS_M_REC,PVEC_L_STS	;Is PUT file disk?
	BEQL	10$			;Branch if not
	MOVL	PVEC_L_REC,R2		;Get max record length
	BRB	20$
10$:	MOVL	GVEC_L_REC,R2		;Get max record length
20$:	TSTL	R2			;Is record length unspecified?
	BNEQ	30$			;Branch if specified
	MOVL	#MAX_REC_SZ,R2		;Else use default maximum

30$:	CMPW	R2,REC_BUF_SZ		;Is current buffer big enough
	BLEQ	50$			;Branch if OK
	TSTW	REC_BUF_SZ		;Is there a current buffer?
	BEQL	40$			;Branch if not
	$DELTVA_S -
		INADR=REC_BUF_PTR	;Free old buffer
	BLBS	R0,40$			;Branch if success
	BRW	ERR_EXIT		;Else handle error condition
40$:	MOVW	R2,REC_BUF_SZ		;Set new buffer size
	DIVL2	#512,R2			;Compute nr of pages needed
	INCL	R2
	$EXPREG_S -
		PAGCNT=R2,-
		RETADR=REC_BUF_PTR	;Get new buffer
	BLBS	R0,50$			;Branch if success
	BRW	ERR_EXIT		;Else handle error condition

;  Now get block buffer
50$:	BITL	#STS_M_BLK,PVEC_L_STS	;Is PUT file tape?
	BEQL	60$			;Branch if not
	MOVZWL	PUT_FAB+FAB$W_BLS,R2	;Get PUT file block size
	MOVL	R2,BLK_FIL_LC		;Init buffer status to empty
	BRB	70$
60$:	MOVZWL	GET_FAB+FAB$W_BLS,R2	;Get GET file block size
	CLRL	BLK_FIL_LC		;Init buffer status to empty
70$:	CMPW	R2,BLK_BUF_SZ		;Is current buffer big enough?
	BLEQ	90$			;Branch if OK
	TSTW	BLK_BUF_SZ		;Is there a current buffer?
	BEQL	80$			;Branch if not
	$DELTVA_S -
		INADR=BLK_BUF_PTR	;Free old buffer
	BLBS	R0,80$			;Branch if success
	BRW	ERR_EXIT		;Handle error condition

80$:	MOVW	R2,BLK_BUF_SZ		;Set new buffer size
	DIVL2	#512,R2			;Compute number of pages needed
	INCL	R2
	$EXPREG_S -
		PAGCNT=R2,-
		RETADR=BLK_BUF_PTR	;Get new buffer
	BLBS	R0,90$			;Branch if successful
	BRW	ERR_RTN			;Handle error conditions
90$:	MOVL	BLK_BUF_PTR,BLK_FIL_PTR	;Init buffer fill pointer to 1st byte

	.PAGE
	.SBTTL	Loop Moving Records

;  Now everything is set up.  Loop getting from GET and putting to PUT until
;  end-of-file.
MOVE_THINGS:
	MOVL	#-1,REC_RD_CNT		;Init record read count

5$:	INCL	REC_RD_CNT		;Count a record
	BITL	#STS_M_BLK,GVEC_L_STS	;Is GET file tape?
	BEQL	10$			;Branch if not
	BSBW	BLK_TO_REC		;Move a record to the block
	BRB	20$
10$:	BSBW	REC_TO_BLK		;Move a record from the block
20$:	BLBS	R0,5$			;Loop until error

	CMPL	R0,#RMS$_EOF		;Is file at EOF?
	BEQL	40$			;Branch if so
	BRW	IO_ERR			;Else handle other errors..R1 points
					;to bad FAB

;  Done with current files - close them
40$:	BITL	#STS_M_BLK,PVEC_L_STS	;Is PUT file tape?
	BEQL	45$			;Branch if not
	BSBW	FLUSH_BLK		;Flush the last block
	BLBS	R0,45$			;Branch if success
	MOVAL	PUT_FAB,R1		;Else point at bad FAB
	BRW	IO_ERR			;And handle error condtion

45$:	$CLOSE	FAB=PUT_FAB		;Close PUT file
	BLBS	R0,50$			;Branch if success
	MOVAL	PUT_FAB,R1		;Point to bad FAB
	BRW	IO_ERR			;Handle error condition

50$:	$CLOSE	FAB=GET_FAB		;Close GET file
	BLBS	R0,60$			;Branch if success
	MOVAL	GET_FAB,R1		;Point to bad FAB
	BRW	IO_ERR			;Handle error condition

;  Determine where next input file spec should come from
60$:	BITL	#NAM$M_WILDCARD,-
		GET_NAM+NAM$L_FNB	;Was there a wildcard in current spec
	BEQL	70$			;Branch if not
	BITL	#STS_M_BLK,GVEC_L_STS	;Is GET file tape
	BEQL	65$			;Skip tape if not tape
	TSTL	REC_RD_CNT		;Were there any records in last file?
	BNEQ	65$			;Branch if records read

;  No records read for file MT:* - Assume end-of-tape.
	$ERASE	FAB=PUT_FAB		;Delete zero length file
	BRB	70$			

65$:	BRW	G_NXT_WC		;Loop on input wild cards
70$:	BRW	G_NXT_SPEC		;Loop for next input spec


	.PAGE
	.SBTTL	Exit Branches

;  Branch to here following an RMS error
;  Inputs:
;	R0 - RMS error code
;	R1 - Address of FAB
;  Function:
;	Issues a message giving the file name for the file on which the error
;  occured.  Then branches to ERR_EXIT to cleanup and return the R0 code.
;  If a $PARSE has been successful for the file, the expanded file name is 
;  printed.

IO_ERR:
	MOVL	FAB$L_NAM(R1),R2	;Get pointer to NAM block
	MOVZBL	NAM$B_RSL(R2),R3	;Get length of file name
	BEQL	10$			;Branch if no name here
	MOVL	NAM$L_RSA(R2),R2	;Get pointer to name
	BRB	20$
10$:	MOVL	FAB$L_FNA(R1),R2	;Settle for name in FAB
	MOVZBL	FAB$B_FNS(R1),R3	;And its length
20$:	MOVL	R0,R4			;Save the error code
	$FAO_S	CTRSTR=IO_MSG,-
		OUTLEN=FAO_BUF,-
		OUTBUF=FAO_BUF,-
		P1=R3,P2=R2		;Fill in the message
	MSG	FAO_BUF			;Issue the error message
	MOVL	#FAO_BUF_SZ,FAO_BUF	;Reset descriptor size
	MOVL	R4,R0			;Restore the error code

;  Fall through to ERR_EXIT

;  Branch to here to cleanup on fatal error and return system error code in R0
;  Inputs:
;	R0 - error code
ERR_EXIT:
	MOVL	R0,R4			;Save the error code
	$CLOSE	FAB=GET_FAB		;Close the world, don't worry about
					;errors
	$CLOSE	FAB=PUT_FAB
	$CLOSE	FAB=IN_FAB
	$CLOSE	FAB=OUT_FAB
	MOVL	R4,R0			;Restore the error code
	RET				;Return it

;  Branch to here to cleanup and terminate on normal completion.
;  No inputs expected.
NORM_EXIT:
	$CLOSE	FAB=IN_FAB		;Close the talk files
	$CLOSE	FAB=OUT_FAB
	MOVL	#SS$_NORMAL,R0		;Signal successful completion
	RET

	.PAGE
	.SBTTL	GET_SPEC Get Filespec from Command

;  Subroutine used to pickup next filespec from the command buffer
;  Inputs:
;	R1 - Address of buffer to receive spec
;	CMD_BUF - Command buffer containing spec
;	CMD_NXTCH - Address of next char in command
;	CMD_LC - Remaining length of command
;  Outputs:
;	File spec in buffer indicated by address in R1
;	R0 - Length of spec in chars (0 if error)
;  Function:
;	Scans CMD_BUF from CMD_NXTCH and extracts a file spec.  Blanks are
;	ignored.  Spec is terminated by =,/, or comma.  Delimiters are eaten
;	except for /.  No error messages are issued by this routine.
;  Register Usage:
;	R0 - Output parameter. Modified.
;	R1 - Input parameter. Modified.
;	R2-R5 - Scratch. Modified.

GET_SPEC:
	MOVL	R1,R5			;Save the return pointer
	MOVL	CMD_NXTCH,R1		;R1 points to the next char
	MOVL	CMD_LC,R0		;Length in R0

SCAN:	SCANC	R0,(R1),ALPH_TBL,#^XFF	;Scan for delimiters
	BNEQ	10$			;Branch if char found
	RSB				;No meaningful character - R0=0

10$:	MOVZBL	(R1),R2			;Get byte of interest
	MOVZBL	ALPH_TBL[R2],R2		;Get its code from the table
	CASEB	R2,#1,#2		;Dispatch based on table entry

20$:	.WORD	DELIM_CHR-20$		;Delimiter
	.WORD	BAD_CHR-20$		;Invalid character
	HALT

;  Current character is a delimiter
DELIM_CHR:
	CMPB	(R1),#^A/:/		;Is delimiter a ":"
	BNEQ	10$			;Branch if not
	INCL	R1			;Don't stop for ":" in filespec
	DECL	R0
	BRB	SCAN			;Continue scanning

10$:	MOVL	CMD_NXTCH,R3		;Save pointer to beginning of string
	MOVL	R1,CMD_NXTCH		;Update pointer to next command char
	MOVL	R0,CMD_LC		;Update length
	SUBL3	R3,R1,-(SP)		;Compute spec length and save on stack
	MOVC3	(SP),(R3),(R5)		;Return the string
	CMPB	@CMD_NXTCH,#^A$/$	;Is delimiter a "/"?
	BEQL	20$			;Branch if so
	INCL	CMD_NXTCH		;Eat all other delimiters
	DECL	CMD_LC
20$:	POPL	R0			;Return the length
	RSB

;  Character is invalid in a command string
BAD_CHR:
	CLRL	R0			;Return R0=0 - error
	RSB

	.PAGE
	.SBTTL	GET_SW Get Switches and Fill File Vector

;  Subroutine used to read switches from command buffer
;  Inputs:
;	R1 - pointer to status vector to receive switch data
;	CMD_BUF - Buffer holding command being scanned
;	CMD_NXTCH - Address of next character in command string
;	CMD_LC - Length of remaining command
;  Outputs:
;	Switch information is stored in vector specified.
;	R0 - 0=error, 1=ok
;  Function:
;	Picks up switches from current position in command buffer.  Looks
;	up switches in switch table, matching on most unique abbreviation.
;	The switch data in the table is stored into the file vector specified.
;	Error messages are issued for invalid switch names or values.
;  Register usage:
;	R1 - Input parameter. Not modified.
;	R0 - Output parameter. Modified.
;	R4 - Pointer to current switch name. Modified.
;	R5 - Length of current switch name. Modified.
;	R9 - Pointer to switch table entry, if found. Modified.
;	R2,R3,R6-R8 - Scratch. Modified.

GET_SW:
	PUSHL	R1			;Save vector address

NXT_SW:	CMPB	@CMD_NXTCH,#^A$/$	;Is next char a "/"?
	BEQL	20$			;Branch if so (another switch).

;  We are not looking at a switch
	CMPB	@CMD_NXTCH,#^A/=/	;Is it a "="
	BNEQ	10$			;Branch if not
	INCL	CMD_NXTCH		;Eat equal signs
	DECL	CMD_LC

10$:	MOVL	#1,R0			;Signal success
	POPL	R1			;Clear the stack
	RSB

;  Look for a delimiter terminating the switchname
20$:	INCL	CMD_NXTCH		;Eat the "/"
	DECL	CMD_LC
	SCANC	CMD_LC,@CMD_NXTCH,-
		ALPH_TBL,#^XFF		;Scan for delimiter
	MOVL	CMD_NXTCH,R4		;R4 points to switch name
	SUBL3	CMD_NXTCH,R1,R5		;R5 contains the length of name
	BEQL	UNK_SWITCH		;Branch if zero length name
	MOVL	R1,CMD_NXTCH		;Update pointer past name
	MOVL	R0,CMD_LC		;Update length

;  Now, R4 points to switch name and R5 contains name length.  Scan through
;  switch table to find an entry for which name is the most unique stem.
	CMPL	R5,#SWITCH_NAME_SZ	;Is name too long?
	BGTR	UNK_SWITCH		;Error if so
	CLRL	R9			;R9 will be pointer to matching entry
	MOVL	#1,R6			;R6 is number of characters to compare
					;for this iteration

SW_LOOP:
	CLRL	R8			;R8 is count of number of entries
					;matching the name for current compare
					;length
	MOVAL	SWITCH_TB,R7		;R7 points to current table entry

CMP_NAMES:
	CMPC3	R6,SWITCH_T_NAME(R7),-
		(R4)			;Compare R6 chars of name
	BNEQ	10$			;Branch if not a match
;  A match
	INCL	R8			;Count the matches
	MOVL	R7,R9			;Point at the matched entry

10$:	ACBL	#END_SW_TB,-
		#SWITCH_ENT_SZ,R7,-
		CMP_NAMES		;Loop through switch table
	TSTL	R8			;Were there any matches?
	BNEQ	ONE_OR_MORE		;Branch if at least one

;  No match in table
UNK_SWITCH:
	$FAO_S	CTRSTR=UNK_SW,-
		OUTLEN=FAO_BUF,-
		OUTBUF=FAO_BUF,-
		P1=R5,P2=R4		;Put switch name in message
	BRW	ERR_RTN

ONE_OR_MORE:
	CMPL	#1,R8			;Exactly one match?
	BNEQ	10$			;If not, continue
	CMPC3	R5,SWITCH_T_NAME(R9),-
		(R4)			;For single match, does
					;full name match table entry stem
	BEQL	FOUND			;If so, we have match
	BRB	UNK_SWITCH		;Else it is an unknown name

;  Multiple matches - loop through again comparing one more character
10$:	AOBLEQ	R5,R6,SW_LOOP		;Loop until full name compared

;  If we get here, the switch abbreviation is ambiguous
	$FAO_S	CTRSTR=AMBIG_SW,-
		OUTLEN=FAO_BUF,-
		OUTBUF=FAO_BUF,-
		P1=R5,P2=R4		;Put switch name into message
	BRW	ERR_RTN

;  A valid match was found in the table.  R9 points to the entry.
FOUND:	TSTW	SWITCH_W_VAL(R9)	;Check value field of entry
	BLSS	10$			;Branch if negative (special case)

;  Normal switch entry.  Table contains value to be stored into vector and
;  offset at which to store it.
	MOVZWL	SWITCH_W_OFF(R9),R0	;Get offset field of entry
	ADDL2	(SP),R0			;Add in vector address
	MOVZWL	SWITCH_W_VAL(R9),(R0)	;Store {value into vector
	BRW	NXT_SW			;Look for next switch

;  Special case switch values

;  Construction is    /sw:n
;  Get the value
10$:	CMPB	@CMD_NXTCH,#^A/:/	;Is next char colon?
	BEQL	20$			;Branch if ok

;  No value for this switch
	$FAO_S	CTRSTR=NOVAL_SW,-
		OUTLEN=FAO_BUF,-
		OUTBUF=FAO_BUF,-
		P1=R5,P2=R4		;Put switch name into message
	BRW	ERR_RTN

;  Extract switch value
20$:	INCL	CMD_NXTCH		;Eat the colon
	DECL	CMD_LC
	MOVL	CMD_NXTCH,R6		;Save pointer to the value
	SCANC	CMD_LC,@CMD_NXTCH,-
		ALPH_TBL,#^XFF		;Find next delimiter
	SUBL3	R6,R1,R7		;Compute length of string
	MOVL	R1,CMD_NXTCH		;Update scan pointer
	MOVL	R0,CMD_LC		;And length

;  Convert switch value to binary
	MOVZWL	SWITCH_W_OFF(R9),R0	;Get offset entry from table
	ADDL3	(SP),R0,-(SP)		;Compute destination for value
					;and push it (arg 3)
	PUSHL	R6			;Address of string (arg 2)
	PUSHL	R7			;String length (arg 1)
	CALLS	#3,LIB$CVT_DTB		;Convert to binary
	BLBC	R0,30$			;Branch if error
	BRW	NXT_SW			;Else loop for next switch
;  Invalid value for switch
30$:	$FAO_S	CTRSTR=BAD_VAL,-
		OUTLEN=FAO_BUF,-
		OUTBUF=FAO_BUF,-
		P1=R7,P2=R6		;Put value into message
	BRW	ERR_RTN


;  Branch to here if GET_SW subroutine encounters error.
;  Error message must be formatted in FAO_BUF.
ERR_RTN:
	MSG	FAO_BUF			;Issue the error message
	MOVL	#FAO_BUF_SZ,FAO_BUF	;Reset descriptor length
	CLRL	R0			;Return error status
	POPL	R1			;Clear the stack
	RSB
	.PAGE
	.SBTTL	VEC_TO_FAB Fill in FAB from File Vector

;  Subroutine to move information from file vector to FAB and RAB.
;  Inputs:
;	R1 - Pointer to file vector
;	R2 - Pointer to FAB being filled
;  Outputs:
;	Initialized FAB indicated by R2
;  Function:
;	Takes the blocksize, record length, and record attributes stored
;	in the file vector and initializes the FAB.
;  Register Usage:
;	R1-R2 - Input parameters.

VEC_TO_FAB:
	MOVW	VEC_L_REC(R1),-
		FAB$W_MRS(R2)		;Move record length
	MOVW	VEC_L_BLS(R1),-
		FAB$W_BLS(R2)		;Move block size
	CMPL	#VARIABLE,VEC_L_RCF(R1)	;Are records "VARIABLE"?
	BNEQ	10$			;Branch if not
	$FAB_STORE -
		FAB=R2,RFM=VAR		;Set the attribute
	BRB	20$
10$:	CMPL	#FIXED,VEC_L_RCF(R1)	;Are records "FIXED"?
	BNEQ	20$			;Branch if not
	$FAB_STORE -
		FAB=R2,RFM=FIX		;Set the attribute

20$:	CMPL	#FORTRAN,VEC_L_CC(R1)	;Is carriage control "FORTRAN"
	BNEQ	30$			;Branch if not
	$FAB_STORE -
		FAB=R2,RAT=FTN		;Set FTN attribute

30$:	CMPL	#CR,VEC_L_CC(R1)	;Is carriage control "CR"
	BNEQ	40$			;Branch if not
	$FAB_STORE -
		FAB=R2,RAT=CR		;Set CR attribute

40$:	RSB
	.PAGE
	.SBTTL	MT_PHYS Test For and Do Tape Physical Operations

;  Subroutine used to test if the /REWIND or /SKIPF switches have been
;  specified, and to do the tape operations if needed.
;  Inputs:
;	R1 - Pointer to file vector of magtape file
;	DEV_DESC - Character string descriptor containing device name of tape
;  Outputs:
;	R0 - Return code.  Set zero if error
;  Function:
;	This routine checks the file vector pointed by R1 to see if it 
;	specifies the SKIPF or REWIND switches.  If so, the tape device
;	specified in DEV_DESC is assigned and logical I/O is done to
;	position the tape.  The channel is deassigned when done.  
;	Error messages are issued when the requested functions cannot
;	be performed.
;  Register usage:
;	R0 - Return status. Modified.
;	R1 - Input parameter. Modified.
;	R2 - Pointer to tape file vector

MT_PHYS:
;  Test for the physical positioning switches in the vector
	MOVL	R1,R2			;Preserve file vector pointer
	TSTL	VEC_L_REW(R2)		;Is REWIND specified?
	BNEQ	ASG_CHN			;Branch if so
	TSTL	VEC_L_SKP(R2)		;Is there a non_zero skip count?
	BNEQ	ASG_CHN			;Branch if so
	MOVL	#1,R0			;No work. Signal success
	RSB

;  Assign the channel for the device
ASG_CHN:
	$ASSIGN_S -
		DEVNAM=DEV_DESC,-
		CHAN=MT_CHAN		;Assign a channel
	BLBS	R0,10$			;Branch if success
	MSG	MTF_CHAN		;Issue error message
	RSB

10$:	TSTL	VEC_L_REW(R2)		;Is REWIND requested?
	BEQL	SKIP_MT			;Branch if not
	$QIOW_S	CHAN=MT_CHAN,-
		FUNC=#IO$_REWIND,-
		IOSB=MT_IOSB		;Rewind and wait for completion
	BLBS	R0,20$			;Branch if QIOW succeeded
	MSG	MTF_QIO			;Issue error message
	BRW	DEA_CHN

20$:	BLBS	MT_IOSB,30$		;Branch if tape function succeeded
	MSG	MTF_FAIL		;Issue error message
	CLRL	R0			;Signal failure
30$:	BRW	DEA_CHN

;  Handle skip by files forward or backward
SKIP_MT:
	TSTL	VEC_L_SKP(R2)		;Check skip count
	BGTR	10$			;Branch if positive
	DECL	VEC_L_SKP(R2)		;Bump negative skip count
10$:	MOVL	VEC_L_SKP(R2),-
		MT_QIOPL+QIOW$_P1	;Store skip count in parm block
	MOVL	MT_CHAN,-
		MT_QIOPL+QIOW$_CHAN	;Store channel number in parm block
	$QIOW_G	MT_QIOPL		;Skip the files
	BLBS	R0,20$			;Branch if QIO succeeded
	MSG	MTF_QIO			;Issue error message
	BRW	DEA_CHN

20$:	BLBS	MT_IOSB,30$		;Branch if tape function succeeded
	MSG	MTF_FAIL		;Issue error message
	CLRL	R0			;Signal failure
	BRW	DEA_CHN

30$:	TSTL	VEC_L_SKP(R2)		;Check the skip count
	BGTR	40$			;Branch if positive

;  For negative skips, we are positioned just before the end of previous
;  file, unless we are at BOT.
	MNEGL	VEC_L_SKP(R2),R0	;Get skip count specified
	CMPW	R0,MT_IOSB+2		;Does it match count of EOF's
	BNEQ	40$			;No - we are at BOT
	MOVL	#1,VEC_L_SKP(R2)	;Yes - Skip forward one EOF
	BRW	10$			;by dummying the file vector

40$:	MOVL	#1,R0			;Signal success

DEA_CHN:
;  Deassign the magtape channel.
	MOVL	R0,R2			;Preserve exit status
	$DASSGN_S -
		CHAN=MT_CHAN		;Deassign the channel
	MOVL	R2,R0			;Restore exit status
	RSB

	.PAGE
	.SBTTL	REC_TO_BLK Move a Record to Tape

;  Subroutine to move the next record from the disk GET file to the tape
;  PUT file.  
;  Inputs:
;	GET_RAB, PUT_RAB
;	BLK_BUF_PTR, BLK_BUF_SZ, REC_BUF_PTR, REC_BUF_SZ
;	BLK_FIL_PTR, BLK_FIL_LC
;  Outputs:
;	R0 - Return code.
;	R1 - FAB address of bad FAB (if error)
;  Function:
;	Performs a $GET to read the next record from the disk GET file.
;	The record is transferred to the block buffer in the appropriate
;	format.  Character code translation is done if required.  Warning
;	messages are issued if a record is too long or if it cannot be
;	properly blocked.  The block buffer is emptied when it becomes full.

;  Register Usage:
;	R0-R1 - Output parameters. Modified.
;	R2-R8 - Scratch. Modified.

;  NOTE:  For, now, we only handle "B" block type and "F" record types.

REC_TO_BLK:

;   Get the next input record from disk
	$RAB_STORE -
		RAB=GET_RAB,-
		UBF=@REC_BUF_PTR,-
		USZ=REC_BUF_SZ		;Point RAB at buffer
	$GET	RAB=GET_RAB		;Get the next record
	BLBS	R0,20$			;Branch if success
	CMPL	R0,#RMS$_RTB		;Was record too big?
	BNEQ	10$			;Branch if other error

	$FAO_S	CTRSTR=GET_TOO_LNG,-
		OUTLEN=FAO_BUF,-
		OUTBUF=FAO_BUF,-
		P1=<GET_RAB+RAB$L_STV>	;Put length in warning message
	MSG	FAO_BUF			;Issue warning
	MOVL	#FAO_BUF_SZ,FAO_BUF	;Reset descriptor length
	BRB	20$

10$:	MOVAL	GET_FAB,R1		;Point to bad FAB
	RSB				;Return on other I/O errors

;  Handle "B" type blocks with "F" type records
;  Record length fixed from PVEC
;  Will this record fit in current block?
20$:	CMPL	PVEC_L_REC,-
		BLK_FIL_LC		;Will record fit?
	BLEQ	30$			;Branch if yes
	TSTL	BLK_FIL_LC		;Is buffer completely full?
	BEQL	30$			;Branch if yes, record really goes
					;into next block
	MSG	REC_TOO_BLK		;Issue warning message
	MOVL	BLK_FIL_LC,R6		;Truncated record length in R6
	BRB	40$
30$:	MOVL	PVEC_L_REC,R6		;Get record length

40$:	MOVL	REC_BUF_PTR,R7		;R7 points to source data
	MOVC5	GET_RAB+RAB$W_RSZ,-
		(R7),#^A/ /,R6,(R7)	;Truncate or blank fill to fixed
					;record length
	BSBW	FILL_BLK		;Move the data to the block
					;doing translation if needed
	BLBS	R0,50$			;Branch if success
	MOVAL	PUT_RAB,R1		;Point at bad FAB
50$:	RSB
	.PAGE
	.SBTTL	FILL_BLK Move Bytes to Block Buffer

;  Subroutine to move and possible translate a string of bytes to the block
;  buffer.
;  Inputs:
;	R6 - Length of string to move
;	R7 - Address of string to move
;	PVEC, BLK_FIL_LC, BLK_FIL_PTR
;  Outputs:
;	R0 - Return code
;  Function:
;	The data specified by the input parameters is moved to the end
;	of the block buffer.  If the buffer becomes full, it is flushed.
;	Thus, the data is split across block boundaries.  If PVEC_L_COD
;	is non-zero, the value is used as an index into a table containing
;	the addresses of translation tables, and the data is translated
;	as it is moved.

;  Register Usage:
;	R0 - Output parameter. Modified.
;	R6-R7 - Input parameter. Modified.
;	R1-R8 - Scratch. Modified.

FILL_BLK:
	MOVL	BLK_FIL_LC,R8		;Get number of free bytes in block
					;Used as destination length
	CMPL	R8,R6			;Compare to number of bytes to store
	BLSS	10$			;Branch if it won't fit
	MOVL	R6,R8			;Make dest length same as source

;  Here should go code to test for code conversions
10$:	MOVL	PVEC_L_COD,R1		;Get char translation code
	BEQL	15$			;Branch if no translation
	MOVL	FROM_ASC_ADR[R1],R1	;Get translation table address
	MOVTC	R6,(R7),#0,(R1),R8,-
		@BLK_FIL_PTR		;Move text with translation
	BRB	20$

15$:	MOVC5	R6,(R7),#0,R8,-
		@BLK_FIL_PTR		;Move text to buffer/ no translation

20$:	SUBL2	R8,BLK_FIL_LC		;Update buffer byte count
	ADDL2	R8,BLK_FIL_PTR		;Update next byte pointer
	TSTL	R0			;Check for unmoved bytes
	BNEQ	30$			;Branch if text remains

	MOVL	#1,R0			;Signal success
	RSB

;  Buffer full and text remains to be moved
30$:	MOVL	R0,R6			;Update remaining length
	MOVL	R1,R7			;Update pointer to data
	BSBW	FLUSH_BLK		;Write the block and reset pointers
	BLBS	R0,FILL_BLK		;Loop if successful
	RSB
	.PAGE
	.SBTTL	FLUSH_BLK Write Block Buffer to File

;  Subroutine to flush the block buffer to the PUT file
;  Inputs:
;	PUT_RAB - RAB for file being written to
;	BLK_FIL_LC - Number of bytes in buffer
;	BLK_BUF_PTR - Pointer to beginning of buffer
;  Outputs:
;	R0 - Return code
;	BLK_FIL_LC - Reset to empty buffer condition
;	BLK_FIL_PTR - Reset to empty buffer condition
;  Function:
;	The data in the block buffer, as indicated by BLK_FIL_LC is 
;	written the the PUT file using block_mode I/O.

;  Register Usage:
;	R0 - Return code. Modified.
;	R1 - Scratch.  Modified.

FLUSH_BLK:
	SUBL3	BLK_FIL_LC,-
		PUT_FAB+FAB$W_BLS,R1	;Compute number of bytes in block
	$RAB_STORE -
		RAB=PUT_RAB,-
		RBF=@BLK_BUF_PTR,-
		RSZ=R1			;Point RAB at the buffer
	$WRITE	RAB=PUT_RAB		;Write the block
	BLBS	R0,10$			;Branch if success
	RSB

;  Reset buffer status
10$:	MOVL	BLK_BUF_PTR,BLK_FIL_PTR	;Fill pointer at beginning of buffer
	MOVZWL	PUT_FAB+FAB$W_BLS,-	
		BLK_FIL_LC		;Make buffer empty
	RSB
	.PAGE
	.SBTTL	BLK_TO_REC Move a Record to Disk

;  Subroutine to move the next record from the tape block buffer to the disk
;  PUT file.  
;  Inputs:
;	GET_RAB, PUT_RAB
;	BLK_BUF_PTR, BLK_BUF_SZ, REC_BUF_PTR, REC_BUF_SZ
;	BLK_FIL_PTR, BLK_FIL_LC
;  Outputs:
;	R0 - Return code
;	R1 - FAB address of bad FAB (if error)
;  Function:
;	Extracts the next record from the block buffer based on the record
;	type.  The record is moved to the record buffer, and then written
;	to the disk PUT file.  When the data in the block buffer is 
;	exhausted, the next block is read from the file.  Character code
;	translation is done when required.  A warning message is issued
;	if a record is too long for the buffer.

;  Register Usage:
;	R0-R1 - Output parameters. Modified.
;	R2-R9 - Scratch. Modified.

;  NOTE:  For now, we only handle "B" type blocking and "F" type tape 
;  records.

BLK_TO_REC:

;  Extract the next record from the block buffer

;  For "F" type records, just get the next GVEC_L_REC characters
	MOVL	GVEC_L_REC,R6		;Get record length
	CMPL	R6,BLK_FIL_LC		;Are there enough chars in this block
	BLEQ	5$			;Branch if ok
	TSTL	BLK_FIL_LC		;Is buffer empty?
	BEQL	5$			;OK, record comes from next block
	$FAO_S	CTRSTR=SHRT_REC,-
		OUTLEN=FAO_BUF,-
		OUTBUF=FAO_BUF,-
		P1=BLK_FIL_LC		;Put length into message
	MSG	FAO_BUF			;Issue warning
	MOVL	#FAO_BUF_SZ,FAO_BUF	;Reset descriptor length
	MOVL	BLK_FIL_LC,R6		;Return only remainder of block

5$:	TSTL	PVEC_L_REC		;Is output record size limited
	BEQL	10$			;Branch if not
	CMPL	R6,PVEC_L_REC		;Compare record sizes
	BLEQ	10$			;Branch if record will fit

	$FAO_S	CTRSTR=PUT_TOO_LNG,-
		OUTLEN=FAO_BUF,-
		OUTBUF=FAO_BUF,-
		P1=R6			;Put length into warning message
	MSG	FAO_BUF			;Issue warning message
	MOVL	#FAO_BUF_SZ,FAO_BUF	;Reset descriptor size
	MOVL	PVEC_L_REC,R6		;Truncate to max record length

10$:	MOVL	R6,R9			;Save the length for later
	MOVL	REC_BUF_PTR,R7		;Point to destination
	BSBW	EMTY_BLK		;Get the bytes and translate if
					;needed
	BLBS	R0,20$			;Branch if success
	MOVAL	GET_FAB,R1		;Point to bad FAB
	RSB

;  Write the record to the PUT file
20$:	$RAB_STORE -
		RAB=PUT_RAB,-
		RBF=@REC_BUF_PTR,-
		RSZ=R9			;Point the RAB at the record
	$PUT	RAB=PUT_RAB		;Write the record
	BLBS	R0,30$			;Branch if success
	MOVAL	PUT_FAB,R1		;Point at bad FAB
30$:	RSB
	.PAGE
	.SBTTL	EMTY_BLK Move Bytes from the Block Buffer

;  Subroutine to move a string of bytes from the block buffer and possibly
;  perform character code translation.
;  Inputs:
;	R6 - Length of string to move
;	R7 - Destination of data
;	BLK_FIL_PTR, BLK_FIL_LC, BLK_BUF_PTR, GVEC
;  Outputs:
;	R0 - Return code.
;	BLK_FIL_PTR, BLK_FIL_LC - Updated to reflect data addes to buffer.
;  Function:
;	The next R6 bytes in the block buffer, beginning at the byte
;	pointed by BLK_FIL_PTR are moved to the address given by R7.
;	If the buffer becomes empty, the next block is read.  Thus the
;	data returned by one call may come from several blocks.  If
;	GVEC_L_COD is non_zero, its value is used as the index into a
;	table of translation table addresses.  If the value is non-zero
;	character code translation takes place.

;  Register Usage:
;	R0 - Output parameter. Modified.
;	R6-R7 - Input parameters. Modified.
;	R1-R8 - Scratch. Modified.

;  NOTE: For now, all character code translation is to ASCII

EMTY_BLK:
	TSTL	R6			;While move length >0
	BGTR	5$
	BRW	50$			;Branch out of loop if length <=0

5$:	TSTL	BLK_FIL_LC		;Is buffer empty?
	BGTR	20$			;Branch if not empty

;  Buffer empty - read a block
	$RAB_STORE -
		RAB=GET_RAB,-
		UBF=@BLK_BUF_PTR,-
		USZ=BLK_BUF_SZ		;Point the RAB at the buffer
	$READ	RAB=GET_RAB		;Read a block
	BLBS	R0,10$			;Branch if ok
	RSB				;Return error status

10$:	MOVZWL	GET_RAB+RAB$W_RSZ,-
		BLK_FIL_LC		;Set length of buffer contents
	MOVL	BLK_BUF_PTR,BLK_FIL_PTR	;And point to first byte

;  Compute number of bytes we can move, and move them
20$:	MOVL	R6,R8			;Assume we can move entire request
	CMPL	R8,BLK_FIL_LC		;Are there enough bytes in buffer
	BLEQ	30$			;Branch if ok
	MOVL	BLK_FIL_LC,R8		;No - move only as many as exist

30$:	MOVL	GVEC_L_COD,R1		;Get translation code
	BEQL	35$			;Branch if no translation
	MOVL	TO_ASC_ADR[R1],R1	;Get translation table address
	MOVTC	R8,@BLK_FIL_PTR,-
		#0,(R1),R8,(R7)		;Move the data, translated
	BRB	40$

35$:	MOVC3	R8,@BLK_FIL_PTR,-
		(R7)			;Move the data, untranslated

40$:	SUBL2	R8,R6			;Subtract bytes moved from request
	SUBL2	R8,BLK_FIL_LC		;And from buffer count
	ADDL2	R8,BLK_FIL_PTR		;Update next-byte pointer.
	BRW	EMTY_BLK		;Loop

50$:	MOVL	#1,R0			;Signal success
	RSB

	.END	MTEXCH