.TITLE	AVATU	AMDOHL - VAX ASCII TAPE UTILITY
.IDENT	/V00.0e/
;
;;;;
; Modified:
;+001	ADDED ABILITY TO READ FIX LENGTH RECORDS FROM MAGTAPE. 30-MAR-81
;
;	J. Downward	JGD4	Convert a zero length record to a
;	Jan-Oct 1983			record with a single space
;					Catch ^Z. Do not abominate
;					Convert UC messages to LC
;					Allow logical device names
;					with "$" and "_" in them.
;
;	J. Downward	JGD5	Change MSA0: (TS11) over to MUA0: (TU81:)
;	21-Dec-1984
;
;	J. Downward	JGD6    Remove device allocation code for V4.0.  
;				When a tape is mounted foreign, it is
;				automatically allocated
;
;DEBUG=1
;
;;;;
;
;
;
;THIS UTILITY IS VAX PROGRAM WHICH WILL GENERATE OR READ STANDARD EBCDIC(ASCII)
;IBM TAPES.  ONLY ASCII DATA IS ALLOWED, NO BINARY DATA IS ALLOWED.
;THIS UTILITY WILL TRANSLATE EBCDIC TAPES TO ASCII FILES.
;
;
.PAGE
.SUBTITLE	EQUATES
;
.SUBTITLE	SYSTEM EQUATES
;
;SYSTEM EQUATES.
;
	$IODEF				;DEFINE IO EQUATES.
	$TPADEF				;TPARSE EQUATES.
	$DIBDEF				;DEVICE INFO BLOCK EQUATES.
;
.SUBTITLE	DEFAULT EQUATES
;
SPACE=32				; Define the space character	;JGD4
;
;DEFAULT EQUATES.
;
DEF_BLOLEN=400				;DEFAULT BLOCK SIZE FOR MAGTAPE.
DEF_NEWALLOC=100			;DEFAULT NEW FILE ALLOCATION.
DEF_NEWEXTENT=100			;DEFAULT NEW FILE EXTENT ALLOCATION.
DEF_VOLSER=999999			;DEFAULT VOLUME SERIAL NUMBER.
DEF_DSIDDESC:				;DEFAULT DATASET ID.
	.ASCID	\MPDVAX.DAT\		;
.SUBTITLE	EXECUTION EQUATES
;
;
;EXECUTION EQUATES.
;
X_OLDEOF=1				;SET WHEN OLD IS COMPLETELY PROCESSED.
X_ERROR=2				;SET WHENEVER AN ASY OR SYN ERROR OCCURS.
X_MTALOC=4				;MAGTAPE ALLOCATED.
X_NEWOPN=8				;NEW FILE OPENED.
X_OLDOPN=16				;OLD FILE OPENED.
X_NEWVOL=32				;NEW VOLUME.
X_NEWCON=64				;NEW FILE CONNECTED.
X_OLDCON=128				;OLD FILE CONNECTED.
X_PROMPTNEWVOL=256			;PROMPT FOR NEW VOLUME.
X_ENDOFTAPE=512				;END OF TAPE DETECTED.
X_MTINPROG=1024				;MAGTAPE IN PROGRESS.
X_MTREQ=2048				;MAGTAPE HAS REQUESTED.
X_MTSUSPEND=4096			;TASK SUSPENDED DUE TO MAGTAPE.
X_VAXINPROG=8192			;VAX IN PROGRESS.
X_VAXREQ=16384				;VAX HAS REQUESTED.
X_VAXSUSPEND=32768			;TASK SUSPENDED DUE TO VAX.
X_WRITE=65536				;WRITE REQUEST.
X_AST=131072				;IN AST.
;
.SUBTITLE	BUFFER POOL FLAG EQUATES.
;
;BUFFER POOL FLAG EQUATES.
;
B_GOOD=8				;GOOD BUFFER.
B_EOF=2					;EOF BUFFER.
;
;
.SUBTITLE	BUFFER POOL OFFSETS
;
;BUFFER POOL OFFSETS.
;
OF_POOL_BUF=0				;BUFFER ADDRESS OFFSET.
OF_POOL_FLG=4				;FLAG OFFSET.
OF_POOL_CURBYT=8			;CURRENT BYTE OFFSET.
OF_POOL_BUFLEN=12			;ACTUAL BUFFER SIZE.
.SUBTITLE	VAX FILE ATTRIBUTE EQUATES
;
;
;NEW FILE EQUATES.
;
NEWALQ=10000			;ALLOCATION.
NEWCTX=0			;USER CONTEXT.
NEWDEQ=1000			;DEFAULT EXTENSION ALLOCATION.
;
;RAB ATTRIBUTES.
;
NEWCTX=0			;USER CONTEXT.
NEWMBC=3			;MULTIBLOCK COUNT FOR SEQ I/O.
NEWMBF=5			;MULTIBUFFER COUNT.
;
;
;NAM CONTROL BLOCK EQUATES.
;
NEWESS=100			;EXPAND STRING SIZE.
;
;
;OLD FILE EQUATES
;
OLDCTX=0			;USER CONTEXT.
OLDMBC=3			;MULTIBLOCK COUNT.
OLDMBF=5			;MUTIBUFFER COUNT.
OLDESS=100			;EXPANDED STRING SIZE.
;
.SUBTITLE	AMDOHL MAGTAPE OFFSETS AND EQATES
;
;
;AMDOHL MAGTAPE OFFSETS AND EQUATES.
;
;
;LABEL SIZE.
;
LH_VOL1LEN=80			;VOL1 LABEL.
LH_DSL1LEN=80			;HDR1/EOV1/EOF1 LABEL.
LH_DSL2LEN=80			;HDR2/EOV2/EOF2 LABEL.
;
;
;VOL1 LABEL.
;
OF_MTVOL1LBLID=0		;OFFSET TO LABEL ID.
LH_MTVOL1LBLID=4		;LENGTH.
OF_MTVOL1SER=4			;OFFSET TO VOLUME SERIAL NUMBER.
LH_MTVOL1SER=6			;LENGTH.
OF_MTVOL1RS1=10			;OFFSET TO RESERVED 1.
LH_MTVOL1RS1=1			;LENGTH.
OF_MTVOL1VTOC=11		;OFFSET TO VTOC POINTER.
LH_MTVOL1VTOC=10		;LENGTH.
OF_MTVOL1RS2=21			;OFFSET TO RESERVED 2.
LH_MTVOL1RS2=10			;LENGTH.
OF_MTVOL1RS3=31			;OFFSET TO RESERVED 3.
LH_MTVOL1RS3=10			;LENGTH.
OF_MTVOL1OWNER=41		;OFFSET TO OWNER NAME AND ADDRESS CODE.
LH_MTVOL1OWNER=10		;LENGTH.
OF_MTVOL1RS4=51			;OFFSET TO RESERVED 4.
LH_MTVOL1RS4=29			;LENGTH.
;
;
;HDR1/EOV1/EOF1 OFFSETS AND EQUATES.
;
OF_MTDSL1LBLID=0		;OFFSET TO LABEL ID.
LH_MTDSL1LBLID=4		;LENGTH.
OF_MTDSL1DSID=4			;OFFSET TO DATA SET ID.
LH_MTDSL1DSID=17		;LENGTH.
OF_MTDSL1DSSER=21		;DATA SET SERIAL NUMBER.
LH_MTDSL1DSSER=6		;LENGTH.
OF_MTDSL1VOLSEQ=27		;VOLUME SEQUENCE NUMBER.
LH_MTDSL1VOLSEQ=4		;LENGTH.
OF_MTDSL1DSSEQ=31		;DATA SET SEQUENCE NUMBER.
LH_MTDSL1DSSEQ=4		;LENGTH.
OF_MTDSL1GENNUM=35		;DATA SET GENERATION NUMBER.
LH_MTDSL1GENNUM=4		;LENGTH.
OF_MTDSL1VERNUM=39		;DATA SET VERSION NUMBER.
LH_MTDSL1VERNUM=2		;LENGTH.
OF_MTDSL1CREDAT=41		;CREATION DATE.
LH_MTDSL1CREDAT=6		;LENGTH.
OF_MTDSL1EXPDAT=47		;EXPIRATION DATE.
LH_MTDSL1EXPDAT=6		;EXPIRATION DATE.
OF_MTDSL1SECUR=53		;SECURITY.
LH_MTDSL1SECUR=1		;LENGTH.
OF_MTDSL1BLOCNT=54		;BLOCK COUNT.
LH_MTDSL1BLOCNT=6		;LENGTH.
OF_MTDSL1SYSCOD=60		;SYSTEM CODE.
LH_MTDSL1SYSCOD=13		;LENGTH.
OF_MTDSL1RS1=73			;RESERVED 1.
LH_MTDSL1RS1=7			;LENGTH.
;
;
;HDR2/EOV2/EOF2 LABEL OFFSETS AND EQUATES.
;
OF_MTDSL2LBLID=0		;LABEL ID.
LH_MTDSL2LBLID=4		;LENGTH.
OF_MTDSL2RFM=4			;RECORD FORMAT.
LH_MTDSL2RFM=1			;LENGTH.
OF_MTDSL2BLOLEN=5		;BLOCK LENGTH.
LH_MTDSL2BLOLEN=5		;LENGTH.
OF_MTDSL2RECLEN=10		;RECORD LENGTH.
LH_MTDSL2RECLEN=5		;LENGTH.
OF_MTDSL2TAPDEN=15		;TAPE DENSITY.
LH_MTDSL2TAPDEN=1		;LENGTH.
OF_MTDSL2DSPOS=16		;DATA SET POSITION.
LH_MTDSL2DSPOS=1		;LENGTH.
OF_MTDSL2JOBSTP=17		;JOB STEP.
LH_MTDSL2JOBSTP=17		;LENGTH.
OF_MTDSL2TAPTNQ=34		;TAPE RECORDING TECHNIQUE.
LH_MTDSL2TAPTNQ=2		;LENGTH.
OF_MTDSL2CONCHA=36		;CONTROL CHARACTER.
LH_MTDSL2CONCHA=1		;LENGTH.
OF_MTDSL2RS1=37			;RESERVED 1.
LH_MTDSL2RS1=1			;LENGTH.
OF_MTDSL2BLOATT=38		;BLOCK ATTRIBUTE.
LH_MTDSL2BLOATT=1		;LENGTH.
OF_MTDSL2RS2=39			;RESERVED 2.
LH_MTDSL2RS2=8			;LENGTH.
OF_MTDSL2CHKPNT=47		;CHECK POINT DATA SET.
LH_MTDSL2CHKPNT=1		;LENGTH.
OF_MTDSL2RS3=48			;RESERVED 3.
LH_MTDSL2RS3=32			;LENGTH.
.SUBTITLE	LABEL TABLE OFFSETS
;
;
;LABEL TABLE OFFSETS.
;
OF_LBLTBL_ID=0			;LABEL ASCII ID.
OF_LBLTBL_ACT=4			;ACTION TABLE ADDRESS.
OF_LBLTBL_NEXT=8		;NEXT LABEL STATE TABLE ADDRESS.
OF_LBLTBL_EBC=12		;ASSCOCIATED EBCDIC BUFFER.
OF_LBLTBL_ASC=16		;ASSOCIATED ASCII BUFFER.
OF_LBLTBL_ASC2=20		;ASSOCIATED ASCII 2 BUFFER.
;
.SUBTITLE	ACTION TABLE OFFSETS
;
;
;ACTION TABLE OFFSETS
;
OF_ACTTBL_OFF=0			;OFFSET INTO ASCII LABEL BUFFER.
OF_ACTTBL_LEN=4			;LENGTH.
OF_ACTTBL_ACT=8			;ACTION ROTUINE ADDRESS.
.PAGE
.SUBTITLE	MAGTAPE LABEL BUFFERS AND TABLES
;
;
;MAGTAPE LABEL BUFFERS AND TABLES.
;
VOL1_EBCDIC:			;EBCDIC VOL1 LABEL.
	.BLKB	LH_VOL1LEN	;BUFFER.
;
HDR1_EBCDIC:			;EBCDIC HDR1 LABEL.
	.BLKB	LH_DSL1LEN	;BUFFER.
;
EOF1_EBCDIC:			;EBCDIC EOF1 LABEL.
	.BLKB	LH_DSL1LEN	;BUFFER.
;
EOV1_EBCDIC:			;EBCDIC EOV1 LABEL.
	.BLKB	LH_DSL1LEN	;BUFFER.
;
HDR2_EBCDIC:			;EBCDIC HDR2 LABEL.
	.BLKB	LH_DSL2LEN	;BUFFER.
;
EOF2_EBCDIC:			;EBCDIC EOF2 LABEL.
	.BLKB	LH_DSL2LEN	;BUFFER.
;
EOV2_EBCDIC:			;EBCDIC EOV2 LABEL.
	.BLKB	LH_DSL2LEN	;BUFFER.
;
VOL1_ASCII:			;ASCII VOL1 LABEL.
	.BLKB	LH_VOL1LEN	;BUFFER.
;
VOL1_ASCII2:			;ASCII 2 VOL1 LABEL.
	.BLKB	LH_VOL1LEN	;BUFFER.
;
HDR1_ASCII:			;ASCII HDR1 LABEL.
	.BLKB	LH_DSL1LEN	;BUFFER.
;
HDR1_ASCII2:			;ASCII 2 HDR1 LABEL.
	.BLKB	LH_DSL1LEN	;BUFFER.
;
EOF1_ASCII:			;ASCII EOF1 LABEL.
	.BLKB	LH_DSL1LEN	;BUFFER.
;
EOF1_ASCII2:			;ASCII 2 EOF1 LABEL.
	.BLKB	LH_DSL1LEN	;BUFFER.
;
EOV1_ASCII:			;ASCII EOV1 LABEL.
	.BLKB	LH_DSL1LEN	;BUFFER.
;
EOV1_ASCII2:			;ASCII 2 EOV1 LABEL.
	.BLKB	LH_DSL1LEN	;BUFFER.
;
HDR2_ASCII:			;ASCII HDR2 LABEL.
	.BLKB	LH_DSL2LEN	;BUFFER.
;
HDR2_ASCII2:			;ASCII 2 HDR2 LABEL.
	.BLKB	LH_DSL2LEN	;BUFFER.
;
EOF2_ASCII:			;ASCII EOF2 LABEL.
	.BLKB	LH_DSL2LEN	;BUFFER.
;
EOF2_ASCII2:			;ASCII 2 EOF2 LABEL.
	.BLKB	LH_DSL2LEN	;BUFFER.
;
EOV2_ASCII:			;ASCII EOV2 LABEL.
	.BLKB	LH_DSL2LEN	;BUFFER.
;
EOV2_ASCII2:			;ASCII EOV2 LABEL.
	.BLKB	LH_DSL2LEN	;BUFFER.
;
;
;LABEL TABLE.
;
LBLTBL:				;LABEL TABLE.
LBL_VOL1:
	.ASCII	/VOL1/		;LABEL ID.
	.LONG	VOL1_ACTTBL	;ACTION TABLE.
	.LONG	LBL_HDR1	;NEXT LABEL.
	.LONG	VOL1_EBCDIC	;EBCDIC BUFFER.
	.LONG	VOL1_ASCII	;ASCII BUFFER.
	.LONG	VOL1_ASCII2	;ASCII 2 BUFFER.
LH_LBLTBL_ENTRY=.-LBLTBL	;NOTE SIZE OF ENTRY.
;
LBL_HDR1:
	.ASCII	/HDR1/		;
	.LONG	HDR1_ACTTBL	;
	.LONG	LBL_HDR2	;
	.LONG	HDR1_EBCDIC	;
	.LONG	HDR1_ASCII	;
	.LONG	HDR1_ASCII2	;
;
LBL_HDR2:
	.ASCII	/HDR2/		;
	.LONG	HDR2_ACTTBL	;
	.LONG	LBL_DATA	;
	.LONG	HDR2_EBCDIC	;
	.LONG	HDR2_ASCII	;
	.LONG	HDR2_ASCII2	;
;
LBL_EOF1:
	.ASCII	/EOF1/		;
	.LONG	EOF1_ACTTBL	;
	.LONG	LBL_EOF2	;
	.LONG	EOF1_EBCDIC	;
	.LONG	EOF1_ASCII	;
	.LONG	EOF1_ASCII2	;
;
LBL_EOF2:
	.ASCII	/EOF2/		;
	.LONG	EOF2_ACTTBL	;
	.LONG	LBL_HDR1	;
	.LONG	EOF2_EBCDIC	;
	.LONG	EOF2_ASCII	;
	.LONG	EOF2_ASCII2	;
;
LBL_EOV1:
	.ASCII	/EOV1/		;
	.LONG	EOV1_ACTTBL	;
	.LONG	LBL_EOV2	;
	.LONG	EOV1_EBCDIC	;
	.LONG	EOV1_ASCII	;
	.LONG	EOV1_ASCII2	;
;
LBL_EOV2:
	.ASCII	/EOV2/		;
	.LONG	EOV2_ACTTBL	;
	.LONG	LBL_VOL1	;
	.LONG	EOV2_EBCDIC	;
	.LONG	EOV2_ASCII	;
	.LONG	EOV2_ASCII2	;
;
LBL_DATA:
	.ASCII	/DATA/		;
	.LONG	DATA_ACTTBL	;
	.LONG	LBL_DATAEND	;
	.LONG	0		;
	.LONG	0		;
	.LONG	0		;
;
LBL_DATAEND:
	.ASCII	/****/		;
	.LONG	DATAEND_ACTTBL	;
	.LONG	LBL_EOF1	;
	.LONG	0
	.LONG	0
	.LONG	0
;
;
;LABEL TABLE POINTER.
;
LBLTBL_PTR:			;LABEL TABLE POINTER.
	.LONG	0			;
;
;
;ACTION TABLES.
;
;VOL1 ACTION TABLE.
;
VOL1_ACTTBL:				;VOL1 ACTION TABLE.
LH_ACTTBL_ENTRY=.-VOL1_ACTTBL		;ENTRY SIZE.
	.LONG	0,0,AC_TFRMOD		;TRANSFER MODE.
LH_ACTTBL_ENTRY=.-VOL1_ACTTBL		;ENTRY SIZE.
	.LONG	0,0,AC_VOL1		;VOL1.
	.LONG	OF_MTVOL1LBLID,LH_MTVOL1LBLID,AC_MTVOL1LBLID	;VOL1 LABEL.
	.LONG	OF_MTVOL1SER,LH_MTVOL1SER,AC_MTVOL1SER	;VOLUME SERIAL NUMBER.
	.LONG	OF_MTVOL1RS1,LH_MTVOL1RS1,AC_ZERO	;RESERVED 1.
	.LONG	OF_MTVOL1VTOC,LH_MTVOL1VTOC,AC_BLANK	;VTOC.
	.LONG	OF_MTVOL1RS2,LH_MTVOL1RS2,AC_BLANK	;RESERVED 2.
	.LONG	OF_MTVOL1RS3,LH_MTVOL1RS3,AC_BLANK	;RESERVED 3.
	.LONG	OF_MTVOL1OWNER,LH_MTVOL1OWNER,AC_BLANK	;OWNER.
	.LONG	OF_MTVOL1RS4,LH_MTVOL1RS4,AC_BLANK	;RESERVED 4
	.LONG	0,0,AC_VOL1END				;VOL1 END.
	.LONG	0,0,0			;END OF VOL1 TABLE.
;
;
;DSL1 ACTION TABLE.
;
HDR1_ACTTBL:				;
EOF1_ACTTBL:				;
EOV1_ACTTBL:				;
	.LONG	0,0,AC_DSL1		;DATA SET LABEL 1 TABLE.
	.LONG	OF_MTDSL1LBLID,LH_MTDSL1LBLID,AC_MTDSL1LBLID	;LABEL ID.
	.LONG	OF_MTDSL1DSID,LH_MTDSL1DSID,AC_MTDSL1DSID	;DATA SET ID.
	.LONG	OF_MTDSL1DSSER,LH_MTDSL1DSSER,AC_ZERO	;SERIAL NUMBER.
	.LONG	OF_MTDSL1VOLSEQ,LH_MTDSL1VOLSEQ,AC_ZERO	;VOLUME SEQUENCE.
	.LONG	OF_MTDSL1DSSEQ,LH_MTDSL1DSSEQ,AC_MTDSL1DSSEQ	;DATASET SEQUENCE.
	.LONG	OF_MTDSL1GENNUM,LH_MTDSL1GENNUM,AC_ZERO	;GENERATION NUMBER.
	.LONG	OF_MTDSL1VERNUM,LH_MTDSL1VERNUM,AC_ZERO	;VERSION NUMBER.
	.LONG	OF_MTDSL1CREDAT,LH_MTDSL1CREDAT,AC_ZERO	;CREATION DATE.
	.LONG	OF_MTDSL1EXPDAT,LH_MTDSL1EXPDAT,AC_MTDSL1EXPDAT	;EXPIRATION DATE.
	.LONG	OF_MTDSL1SECUR,LH_MTDSL1SECUR,AC_ZERO	;SECURITY.
	.LONG	OF_MTDSL1BLOCNT,LH_MTDSL1BLOCNT,AC_MTDSL1BLOCNT	;BLOCK COUNT.
	.LONG	OF_MTDSL1SYSCOD,LH_MTDSL1SYSCOD,AC_BLANK	;SYSTEM CODE.
	.LONG	OF_MTDSL1RS1,LH_MTDSL1RS1,AC_BLANK		;RESERVED 1.
	.LONG	0,0,AC_DSL1END				;DSL1 END.
	.LONG	0,0,0			;END OF DSL1 ACTION TABLE.
;
;
;DATA SET LABEL 2 ACTION TABLE (HDR2/EOF2/EOV2)
;
HDR2_ACTTBL:				;
EOF2_ACTTBL:				;
EOV2_ACTTBL:				;
	.LONG	0,0,AC_DSL2		;DSL2 LABEL.
	.LONG	OF_MTDSL2LBLID,LH_MTDSL2LBLID,AC_MTDSL2LBLID	;LABEL ID.
	.LONG	OF_MTDSL2RFM,LH_MTDSL2RFM,AC_MTDSL2RFM	;RECORD FORMAT.
	.LONG	OF_MTDSL2BLOLEN,LH_MTDSL2BLOLEN,AC_MTDSL2BLOLEN	;BLOCK LENGTH.
	.LONG	OF_MTDSL2RECLEN,LH_MTDSL2RECLEN,AC_MTDSL2RECLEN	;RECORD LENGTH.
	.LONG	OF_MTDSL2TAPDEN,LH_MTDSL2TAPDEN,AC_BLANK	;TAPE DENSITY.
	.LONG	OF_MTDSL2DSPOS,LH_MTDSL2DSPOS,AC_ZERO	;DATA SET POSITION.
	.LONG	OF_MTDSL2JOBSTP,LH_MTDSL2JOBSTP,AC_BLANK	;JOB STEP.
	.LONG	OF_MTDSL2TAPTNQ,LH_MTDSL2TAPTNQ,AC_BLANK	;TAPE RECORD TECHIQUE.
	.LONG	OF_MTDSL2CONCHA,LH_MTDSL2CONCHA,AC_BLANK	;CONTROL CHARACTER.
	.LONG	OF_MTDSL2RS1,LH_MTDSL2RS1,AC_BLANK	;RESERVED 1.
	.LONG	OF_MTDSL2BLOATT,LH_MTDSL2BLOATT,AC_MTDSL2BLOATT	;BLOCK ATTRIBUTE.
	.LONG	OF_MTDSL2RS2,LH_MTDSL2RS2,AC_BLANK	;RESERVED 2.
	.LONG	OF_MTDSL2CHKPNT,LH_MTDSL2CHKPNT,AC_BLANK	;CHECK POINT.
	.LONG	OF_MTDSL2RS3,LH_MTDSL2RS3,AC_BLANK	;RESERVED 3.
	.LONG	0,0,AC_DSL2END				;DSL2 END.
	.LONG	0,0,0			;END OF DSL2 ACTION TABLE.
;
;
;DATA ACTION TABLE.
;
DATA_ACTTBL:				;DATA ACTION TABLE.
	.LONG	0,0,AC_DATA		;DATA.
	.LONG	0,0,0			;END OF DATA ACTION TABLE.
;
;
;DATA END ACTION TABLE.
;
DATAEND_ACTTBL:				;DATA END ACTION TABLE.
	.LONG	0,0,AC_DATAEND		;DATA END.
	.LONG	0,0,0			;END DATA END ACTION TABLE.
;
;
;ACTION TABLE POINTER.
;
ACTTBL_PTR:				;ACTION TABLE POINTER.
	.LONG	0			;
;
;
;CURRENT ASCII BUFFER POINTER.
;
CURASCIIPTR:				;CURRENT ASCII BUFFER POINTER.
	.LONG	0			;
;
;
.PAGE
.SUBTITLE	EXECUTION CONTROL AND DATA BUFFERS
;
;
;EXECUTION CONTROL AND DATA BUFFERS.
;
;
;EXECUTION CONTROL LONG WORD.
;
XTLLONG:			;EXECUTION CONTROL LONG WORD.
	.LONG	0		;
;
;
;
TFRMOD:			;TRANSFER MODE.
	.BYTE	0		;	0=IBM TO VAX.
				;	1=VAX TO IBM.
;
;
;
;VOL1 MODE.
;
VOL1MOD:				;VOL1 MODE.
	.BYTE	0			;0=VOL1 LABEL EXIST.
					;1=VOL1 LABEL CREATE.
;
;
;
MTPRIBUFDESC:	.LONG	DIB$K_LENGTH	;MTPRIBUF DESCRIPTOR.
		.LONG	MTPRIBUF	;
;
;
MTPRILENWRD:				;MTPRIBUF ACTUAL LENGTH.
	.WORD	0			;
;
MTPRIBUF:				;MT DEVICE GET BLOCK.
	.BLKB	DIB$K_LENGTH		;BUFFER.
;
.PAGE
.SUBTITLE	DATA ITEMS
;
;
;DATA ITEMS.
;
;
;
BLOCKDESCPTR:				;BLOCK DESCRIPTOR POINTER.
	.LONG	0			;
;
;
;
RECORDDESCPTR:				;RECORD DESCRIPTOR POINTER.
	.LONG	0			;
;
MTPOOLBLOLEN:				;MT POOL BLOCK LENGTH FROM DESCRIPTOR.
	.LONG	0			;
;
;
MTPOOLRECLEN:				;MT POOL RECORD LENGTH.
	.LONG	0			;
;
;
MTPOOLRECMOD:				;MT POOL RECORD MODE.
	.BYTE	0			;
;
;
;EOF DUMMY BUFFER.
;
EOFLEN=80				;DUMMY BUFFER.
EOFBUF:					;EOF DUMMY BUFFER.
	.BLKB	EOFLEN			;
;
;
;DATA END READ IN BUFFER FOR CHECKING LINKAGE TO EITHER EOF1 OR EOV1.
;
DATAENDBUF:				;DATA END BUFFER.
	.BLKB	LH_DSL1LEN		;
;
;
;NEXT VOLUME BUFFER.
;
NEXVOLBUF:				;NEXT VOLUME BUFFER. USED FOR CHECKING
	.BLKB	LH_VOL1LEN		;THAT MT IS READY FOR QIO'S.
;
;
;VOLUME SEQUENCE NUMBER.
;
VOLSEQ:					;VOLUME SEQUENCE NUMBER.
	.LONG	0			;
;
;
;DATASET SEQUENCE NUMBER.
;
DSSEQ:					;DATA SET SEQUENCE NUMBER.
	.LONG	0			;
;
;
;DATA SET SEQUENCE NUMBER(ACTUAL.
;
DSSEQACT:				;DATA SET SEQUENCE NUMBER ACTUAL.
	.LONG	0			;
;
;
;MAGTAPE NAME DESCRIPTOR.
;
MTNAMEDESC:				;MAGTAPE NAME DESCRIPTOR.
	.LONG	MTNAMELEN		;LENGTH.
	.LONG	MTNAME			;ADDRESS.
MTNAME:					;MAGTAPE NAME STRING.
	.ASCII	/MUA/			;				;JGD5
MTUNIT:					;MAGTAPE UNIT NUMBER.
	.BYTE	0			;
MTNAMELEN=.-MTNAME
;
;
;
;MAGTAPE CHANNEL.
;
MTCHANNEL:				;MAGTAPE CHANNEL.
	.WORD	0			;WORD.
;
;
;
;MAGTAPE IO STATUS BLOCK.
;
MTIOSB:					;MAGTAPE IO STATUS BLOCK.
	.BLKL	2			;
;
;
;CONVERT ASCII/BINARY DESCRIPTOR.
;
CVTDESC:				;CONVERT ASCII/BINARY DESCRIPTOR.
	.BLKL	2			;
;
;
;BLOCK COUNT BUFFER.
;
BLOCNT:					;BLOCK COUNT BUFFER.
	.LONG	0			;
;
;
;ACCUM BLOCK COUNT BUFFER.
;
BLOCNTACCUM:				;ACCUM BLOCK COUNT BUFFER.
	.LONG	0			;
;
;
;RECORD FORMAT MODE INDICATOR.
;
RFM:					;RECORD FORMAT MODE INDICATOR.
	.BYTE	0			;
;
;
;BLOCK LENGTH FOR MAGTAPE.
;
BLOLEN:					;BLOCK LENGTH FOR MAGTAPE.
	.LONG	0			;
;
;
;RECORD LENGTH.
;
RECLEN:					;RECORD LENGTH.
;
	.LONG	0			;
;
;
;BLOCK ATTRIBUTE INDICATOR.
;
BLOATT:					;BLOCK ATTRIBUTE INDICATOR.
	.BYTE	0			;
;
;
;NEW FILE ALLOCATION.
;
NEWALLOC:				;NEW FILE ALLOCATION.
	.LONG	0			;
;
;
;NEW FILE EXTENT ALLOCATION.
;
NEWEXTENT:				;NEW FIEL EXTENT ALLOCATION.
	.LONG	0			;
;
;
;VOLUME SERIAL NUMBER.
;
VOLSER:					;VOLUME SERIAL NUMBER.
	.LONG	0			;
;
;
;DATA SET ID DESC.
;
DSIDDESC:				;DATASET ID DESC.
	.ASCID	\12345678901234567\	;17 CHARACTERS.
;
;
;EXPIRATION DATE DESC.
;
EXPDATDESC:				;EXPIRATION DATE DESC.
	.ASCID	\ 98003\		;
.PAGE
.SUBTITLE	RMS CONTROL BLOCKS
;
;
;NEW FILE RMS CONTROL BLOCK.
;
	.SAVE_PSECT	LOCAL_BLOCK
	.PSECT	P_RMS,LONG
NEWFAB:	$FAB	ALQ=NEWALQ,-	;ALLOCATION.
		CTX=NEWCTX,-	;USER CONTEXT.
		DEQ=NEWDEQ,-	;DEFAULT EXTENT ALLOCATION.
		DNA=NEWDNA,-	;DEFAULT FILENAME ADDRESS.
		DNS=NEWDNS,-	;DEFAULT FILENAME SIZE.
		FAC=<PUT,DEL>,-	;PUT AND DELETE FILE ACCESS.
;;;;		FOP=<WCK>,-	;WRITE CHECK.
		NAM=NEWNAM,-	;NAME BLOCK ADDRESS.
		ORG=SEQ,-	;SEQUENTIAL.
		RAT=<CR>,-	;CARRIAGE RETURN CONTROL.
		RFM=VAR,-	;VARIABLE LENGTH.
		SHR=<NIL>	;NO FILE SHARING.
;
;
;RAB CONTROL BLOCK.
;
NEWRAB:	$RAB	CTX=NEWCTX,-	;USER CONTEXT.
		FAB=NEWFAB,-	;ASSOCIATED FAB BLOCK ADDRESS.
		MBC=NEWMBC,-	;MULTIBLOCK COUNT FOR SEQUENTIAL FILE.
		MBF=NEWMBF,-	;MULTIBUFFER COUNT FOR RAH OR WBH.
		RAC=SEQ,-	;RECORD ACCESS MODE.
		ROP=<WBH>	;RECORD PROCCESSING OPTION.
NEWNAM:	$NAM	ESA=NEWESA,-	;EXPANDED STRING AREA ADDRESS.
		ESS=NEWESS	;EXPANDED STRING AREA SIZE.
NEWDNA:	.ASCII	/SYS$DISK:IBM.DAT/	;DEFAULT FILENAME STRING.
NEWDNS=.-NEWDNA			;NOTE LENGTH OF DEFAULT FILENAME STRING.
NEWESA:	.BLKB	NEWESS		;EXPANDED STRING BUFFER.
;
;
;OLD FILE RMS CONTROL BLOCKS.
;
	.ALIGN	LONG		;
OLDFAB:	$FAB	CTX=OLDCTX,-	;USER CONTEXT.
		DNA=OLDDNA,-	;DEFAULT FILENAME ADDRESS.
		DNS=OLDDNS,-	;DEFAULT FILENAME SIZE.
		FAC=<GET>,-	;FILE ACCESS.
;;;;		FOP=<RCK>,-	;FILE OPEN OPTION.
		NAM=OLDNAM,-	;NAME BLOCK ADDRESS.
		SHR=<GET>,-	;FILE SHARING.
		XAB=OLDXAB	;XAB TO GET LRL.
;
;RAB.
;
OLDRAB:	$RAB	CTX=OLDCTX,-	;USER CONTEXT.
		FAB=OLDFAB,-	;ASSOCIATED FAB BLOCK ADDRESS.
		MBC=OLDMBC,-	;MULTIBLOCK COUNT FOR SEQUENTIAL FILE.
		MBF=OLDMBF,-	;MULTIBUFFER COUNT FOR RAH OR WBH.
		RAC=SEQ,-	;RECORD ACCESS MODE.
		ROP=<RAH>	;RECORD PROCCESSING OPTION.
;
;NAM BLOCK.
;
OLDNAM:	$NAM	ESA=OLDESA,-	;EXPANDED STRING AREA ADDRESS.
		ESS=OLDESS	;EXPANDED STRING AREA SIZE.
;
;XAB FOR FILE HEADER CHARACTERISTICS.
;
OLDXAB:	$XABFHC			;USED TO GET LONGEST RECORD LENGTH.
;
;DEFAULT FILENAME STRING.
;
OLDDNA:	.ASCII	/SYS$DISK:VAX.DAT/	;DEFAULT FILENAME STRING.
OLDDNS=.-OLDDNA			;NOTE LENGTH.
;
;EXPANDED STRING BUFFER.
;
OLDESA:	.BLKB	OLDESS		;BUFFER FOR EXPANDED STRING.
	.RESTORE_PSECT		;BACK TO OLD PSECT.
.PAGE
.SUBTITLE	TPARSE STATE TABLES AND ELEMENT ACTION ROUTINES
;
;
;BUFFERS ASSOCIATED WITH ELEMENT ACTION ROUTINES.
;
TL_TOKENCNT:			;TOKEN SIZE.
	.LONG	0		;
TL_TOKENPTR:			;TOKEN POINTER.
	.LONG	0		;
TL_CHAR:			;CHARACTER TOKEN.
	.BYTE	0		;
TL_NUMBER:			;NUMBER (BINARY).
	.LONG	0		;

;+++++++++++++++++++++++++++++++++++++++++++++++++
; Local Input Macro
;
	.MACRO	M_GTINP	PROMPT,?A
	.SAVE_PSECT	LOCAL_BLOCK
	.PSECT	P_MESSAGE,CON,LCL,NOEXE,NOWRT
TMPDSD=.
	.ASCID	\PROMPT\
	.RESTORE_PSECT
	PUSHAL	L_INP1SIZE
	PUSHAL	TMPDSD
	PUSHAL	L_INP1DESC
	CALLS	#3,G^LIB$GET_INPUT
	.ENDM	M_GTINP

;+++++++++++++++++++++++++++++++++++++++++++++



;
;
;ELEMENT ACTION ROUTINES.
;
;ANY SINGLE CHARACTER.
;
	.ENTRY	TA_ANY	^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	MOVB	TPA$B_CHAR(AP),TL_CHAR	;SAVE CHARACTER.
	RET			;RETURN.
;
;ANY ALPHA CHARACTER.
;
	.ENTRY	TA_ALPHA	^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	MOVB	TPA$B_CHAR(AP),TL_CHAR	;SAVE CHARACTER.
	RET			;RETURN.
;
;ANY NUMERIC CHARACTER.
;
	.ENTRY	TA_DIGIT	^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	MOVB	TPA$B_CHAR(AP),TL_CHAR	;SAVE CHARACTER.
	RET			;RETURN.
;
;ANY ALPHANUMERIC STRING.
;
	.ENTRY	TA_STRING	^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	MOVL	TPA$L_TOKENCNT(AP),TL_TOKENCNT	;SAVE STRING SIZE.
	MOVL	TPA$L_TOKENPTR(AP),TL_TOKENPTR	;SAVE STRING POINTER.
	RET			;RETURN.
;
;ANY VAX SYMBOL STRING.
;
	.ENTRY	TA_SYMBOL	^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	MOVL	TPA$L_TOKENCNT(AP),TL_TOKENCNT	;SAVE STRING SIZE.
	MOVL	TPA$L_TOKENPTR(AP),TL_TOKENPTR	;SAVE STRING POINTER.
	RET			;RETURN.
;
;ANY BLANK STRING.
;
	.ENTRY	TA_BLANK	^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	RET			;RETURN.
;
;DECIMAL NUMBER.
;
	.ENTRY	TA_DECIMAL	^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	MOVL	TPA$L_NUMBER(AP),TL_NUMBER	;SAVE NUMBER.
	RET			;RETURN.
;
;OCTAL NUMBER.
;
	.ENTRY	TA_OCTAL	^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	MOVL	TPA$L_NUMBER(AP),TL_NUMBER	;SAVE NUMBER.
	RET			;RETURN.
;
;HEX NUMBER.
;
	.ENTRY	TA_HEX	^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	MOVL	TPA$L_NUMBER(AP),TL_NUMBER	;SAVE NUMBER.
	RET			;RETURN.
;
;EMPTY STRING.
;
	.ENTRY	TA_LAMBDA	^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	RET			;RETURN.
;
;
;TPARSE STATE TABLES.
;
	$TPADEF			;DEFINE TPARSE SYMBOLS.
;
;
	$INIT_STATE	T_AVATUSTB,T_AVATUKTB	;STATE TABLE AND KEY TABLE.
;
;THIS STATE TABLE IS BROKEN INTO TWO SECTIONS.
;THE FIRST SECTION CONTAINS STATES OF ELEMENTS.
;THE SECOND SECTION CONTAINS STATES WHICH TIES TOGETHER THE FIRST SECTION.
;
;FIRST SECTION - ELEMENTS.
;
	$STATE	T_ANY		;ANY SINGLE CHARACTER.
	$TRAN	TPA$_ANY,TPA$_EXIT,TA_ANY	;
;
	$STATE	T_ALPHA		;ANY ALPHA CHARACTER.
	$TRAN	TPA$_ALPHA,TPA$_EXIT,TA_ALPHA	;
;
	$STATE	T_DIGIT		;ANY NUMERIC CHARACTER.
	$TRAN	TPA$_DIGIT,TPA$_EXIT,TA_DIGIT	;
;
	$STATE	T_STRING	;ANY ALPHANUMERIC STRING.
	$TRAN	TPA$_STRING,TPA$_EXIT,TA_STRING	;
;
	$STATE	T_SYMBOL	;ANY VAX SYMBOL STRING.
	$TRAN	TPA$_SYMBOL,TPA$_EXIT,TA_SYMBOL	;
;
	$STATE	T_BLANK		;ANY BLANK STRING.
	$TRAN	TPA$_BLANK,TPA$_EXIT,TA_BLANK	;
;
	$STATE	T_DECIMAL	;DECIMAL NUMBER.
	$TRAN	TPA$_DECIMAL,TPA$_EXIT,TA_DECIMAL	;
;
	$STATE	T_OCTAL		;OCTAL NUMBER.
	$TRAN	TPA$_OCTAL,TPA$_EXIT,TA_OCTAL	;
;
	$STATE	T_HEX		;HEX NUMBER.
	$TRAN	TPA$_HEX,TPA$_EXIT,TA_HEX	;
;
	$STATE	T_LAMBDA		;EMPTY STRING.
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,TA_LAMBDA	;
;
	$STATE	T_EOS		;END OF STRING STATE.
	$TRAN	TPA$_EOS,TPA$_EXIT	;
;
;
;
;SECOND SECTION OF THE STATE TABLE IS TASK DEPENDENT.
;
;
;TRANSFER MODE.
;
	$STATE	T_TFRMOD	;TRANSFER MODE.
	$TRAN	!T_DIGIT,T_EOS,TA_TFRMOD	;EXPECTS A DIGIT OR <CR>.
	$TRAN	!T_LAMBDA,T_EOS		;JUST <CR>.
;
;MAGTAPE UNIT.
;
	$STATE	T_MTUNIT	;MAPTAPE UNIT.
	$TRAN	!T_DIGIT,T_EOS,TA_MTUNIT	;EXPECTS A DIGIT OR.
	$TRAN	!T_LAMBDA,T_EOS		;<CR>.
;
;
;DATASET ID.
;
	$STATE	T_DSID			;DATASET ID.
	$TRAN	!T_ANY,T_DSID		;
	$TRAN	TPA$_EOS,TPA$_EXIT	;
;
;FILESPEC.
;
;TPARSE SHOULD BE CALLED WITH BLANKS SIGNIFICANT.
;
	$STATE	T_FILSPC	;FILESPEC.
;	$TRAN	!T_ALPHA,T_FILSP1	;DEVICE OR FILENAME.	;JGD4
	$TRAN	!T_SYMBOL,T_FILSP1	;Allow "$" and "_" in device name. JGD4
	$TRAN	'[',T_FILSP2		;MUST BE A UIC.
	$TRAN	!T_DIGIT,T_FILSP1	;DEVICE OR FILENAME.
	$TRAN	!T_EOS,TPA$_EXIT		;<CR>.
	$STATE	T_FILSP1	;DEVICE OR FILENAME.
	$TRAN	!T_ALPHA,T_FILSP1	;LOOP TILL ':' OR '.'.
	$TRAN	!T_DIGIT,T_FILSP1	;
	$TRAN	':'			;A DEVICE, SO CHECK UIC OR FILENAME.
	$TRAN	'.',T_FILSP4		;A FILENAME, SO CHECK EXTENSION.
	$TRAN	!T_EOS,TPA$_EXIT	;IF END OF STRING THEN FILENAME.
	$STATE				;FALL THROUGH MEANS DEVICE FOUND.
	$TRAN	'[',T_FILSP2		;MUST BE UFD.
	$TRAN	!T_ALPHA,T_FILSP5	;MUST BE A FILENAME.
	$TRAN	!T_DIGIT,T_FILSP5	;MUST BE A FILENAME.
	$TRAN	!T_EOS,TPA$_EXIT	;THAT'S ALL.
	$STATE	 T_FILSP2			;UIC CHECK.
	$TRAN	!T_ALPHA,T_FILSP2	;LOOP TILL ']'.
	$TRAN	!T_DIGIT,T_FILSP2	;
	$TRAN	'.',T_FILSP2		;
	$TRAN	^%','%,T_FILSP2		;
	$TRAN	^%']'%			;END OF UIC,SO FALL THROUGH.
	$STATE				;
	$TRAN	!T_ALPHA,T_FILSP5	;MUST BE A FILENAME.
	$TRAN	!T_DIGIT,T_FILSP5	;
	$TRAN	!T_EOS,TPA$_EXIT	;THAT'S ALL.
	$STATE	T_FILSP5		;FILENAME CHECK.
	$TRAN	!T_ALPHA,T_FILSP5	;LOOP TILL EOS OR '.'.
	$TRAN	!T_DIGIT,T_FILSP5	;
	$TRAN	!T_EOS,TPA$_EXIT	;THAT'S ALL.
	$TRAN	'.',T_FILSP4		;MUST BE EXTENSION.
	$STATE	T_FILSP4		;EXTENSION CHECK.
	$TRAN	!T_ALPHA		;LOOP TILL EOS OR ';'.
	$TRAN	!T_DIGIT		;MUST CONTAIN AT LEAST ONE CHARACTER
	$STATE	T_FILSP6		;LOOP.
	$TRAN	!T_ALPHA,T_FILSP6	;
	$TRAN	!T_DIGIT,T_FILSP6	;
	$TRAN	!T_EOS,TPA$_EXIT	;THAT'S ALL.
	$TRAN	^%';'%			;IF ';', FALL THROUGH.
	$STATE				;VERSION CHECK, ONE DIGIT AT LEAST.
	$TRAN	!T_DIGIT,T_FILSP7	;
	$STATE	T_FILSP7		;LOOP TILL EOS.
	$TRAN	!T_DIGIT,T_FILSP7	;
	$TRAN	!T_EOS,TPA$_EXIT	;THAT'S ALL.
;
;
;NO YES ANSWER.
;
	$STATE	T_NOYES			;NO DEFAULT YES.
	$TRAN	!T_LAMBDA,,TA_DEFNO	;DEFAULT IS NO CLEAR TL_NUMBER.
	$STATE
	$TRAN	'YES',T_EOS,TA_YES	;
	$TRAN	'NO',T_EOS,TA_NO	;
	$TRAN	TPA$_EOS,TPA$_EXIT	;
	$END_STATE			;END STATE TABLE.
;
;
;TPARSE PARAMETER BLOCK.
;
TPARSE_PAR:				;TPARSE PARAMETER BLOCK.
	.LONG	TPA$K_COUNT0		;NUMBER OF PARAMETERS.
	.BLKB	TPA$K_LENGTH0		;RESERVE SPACE FOR PARAMETERS.
.PAGE
.SUBTITLE	TASK DEPENDENT TPARSE ACTION ROUTINES
;
;
;TASK DEPENDENT TPARSE ACTION ROUTINES.
;
;DEFAULT NO.
;
	.ENTRY	TA_DEFNO	^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	CLRL	TL_NUMBER		;NO MEANS CLEAR TL_NUMBER.
	RET				;
;
;
;YES.
;
	.ENTRY	TA_YES	^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	MOVL	#1,TL_NUMBER		;
	RET				;
;
;
;NO.
;
	.ENTRY	TA_NO	^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	CLRL	TL_NUMBER		;
	RET				;
;
;TRANSFER MODE.
;
	.ENTRY	TA_TFRMOD	^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	MOVB	TPA$B_CHAR(AP),TL_CHAR	;STORE DIGIT.
	RET			;RETURN.
;
;MAGTAPE UNIT.
;
	.ENTRY	TA_MTUNIT	^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	MOVB	TPA$B_CHAR(AP),TL_CHAR	;STORE DIGIT.
	RET			;RETURN.
.PAGE
.SUBTITLE	MESSAGE TEXT
;
;
;OPTION NOT IMPLEMENTED YET.
;
MES_OPTNOTIMP:			;
	.ASCID	\ Option not implemented yet\
;
;
;TRANSFER MODE INPUT OUT OF RANGE.
;
MES_TFROUTRGE:			;
	.ASCID	\ Transfer mode input /!1UB/ out of range\
;
.PAGE
.SUBTITLE	MAIN CODE
;
;
;
START:
	.WORD	0		;ENTRY MASK.
	CLRL	XTLLONG		;CLEAR CONTROL LONGWORD.
	MOVL	#LBL_VOL1,LBLTBL_PTR	;VOLUME LABEL IS FIRST STATE.
	JSB	PRC_LBLTBL		;GO PROCESS.
	BITL	#X_MTALOC,XTLLONG	;MT ALLOCATED AND ASSIGNED??
	M_IF_EQL	1$		;BRANCH IF NOT.
	$QIOW_S	-
		CHAN=MTCHANNEL,-
		FUNC=#IO$_REWIND!IO$M_NOWAIT,-
		IOSB=MTIOSB
	M_ON0ERR	,<SYSONLY>
	M_ONIOSERR	,MTIOSB,<SYSONLY>
1$:
	$EXIT_S				;EXIT.
.PAGE
.SUBTITLE	PROCESS LABEL TABLE ROUTINE
;
;
;PROCESS LABEL TABLE ROUTINE.
;
;EXPECTS
;
;	NOTHING.
;
;
PRC_LBLTBL:			;PROCESS LABEL TABLE ROUTINE.
	JSB	J_SAVREG	;SAVE R0-R11.
PRC_NEXTLBL:			;PROCESS NEXT LABEL STATE.
	MOVL	LBLTBL_PTR,R2	;R2 HAS LABEL TABLE POINTER.
	MOVL	OF_LBLTBL_ACT(R2),ACTTBL_PTR	;ACTION TABLE ADDRESS.
	JSB	PRC_ACTTBL		;GO PROCESS ACTION TABLE.
	M_IF_CS	FINISH			;BRANCH IF FINISHED.
	MOVL	OF_LBLTBL_NEXT(R2),LBLTBL_PTR	;NEXT LABEL STATE.
	BRW	PRC_NEXTLBL		;GO PROCESS NEXT LABEL STATE.
FINISH:
	JSB	J_RESREG		;RESTORE R0-R11.
	RSB				;RETURN.
.PAGE
.SUBTITLE	PROCESS ACTION TABLE ROUTINE
;
;
;PROCESS ACTION TABLE ROUTINE.
;
;EXPECTS
;
;	NOTHING.
;
;
PRC_ACTTBL:				;PROCESS ACTION TABLE ROUTINE.
	JSB	J_SAVREG		;SAVE R0-R11.
PRC_NEXTACT:				;PROCESS NEXT ACTIVE.
	MOVL	ACTTBL_PTR,R2		;GET ACTION TABLE ADDRESS.
	TSTL	OF_ACTTBL_ACT(R2)	;END OF TABLE??
	BEQL	1$			;BRANCH IF END OF TABLE.
	JSB	@OF_ACTTBL_ACT(R2)	;CALL ACTION ROUTINE.
	BCS	2$			;BRANCH IF FINISHED.
	BITL	#X_ERROR,XTLLONG	;ANY ASY ERRORS.
	M_IF_NEQ	2$		;EXIT IF SO.
	ADDL	#LH_ACTTBL_ENTRY,ACTTBL_PTR	;POINT TO NEXT ACTION.
	BRW	PRC_NEXTACT		;PROCESS ACTION.
1$:					;END OF ACTION TABLE.
	BICPSW	#1			;CLEAR C-BIT.
	BRB	3$			;RETURN.
2$:
	BISPSW	#1			;ABNORMAL FINISH.
3$:
	JSB	J_RESREG		;RESTORE R0-R11.
	RSB				;BYE.
.PAGE
.SUBTITLE	INIT MT POOL TABLE AND POINTER ROUTINE
;
;
;THIS ROUTINE INIT THE MT TABLE AND POINTER ACORDING TO BLOLEN.
;
;
INITMTPOOL:				;INIT MT POOL TABLE AMD POINTER ROUTINE.
	JSB	J_SAVREG		;SAVE R0-R11.
	MOVL	#MAXMTPOOLLONG,R0	;NUMBER OF LONG WORDS PER TABLE ENTRY.
	MOVL	#MAXMTPOOLBYTE,R1	;NUMBER OF BYTES PER TABLE ENTRY.
	MOVL	#MAXMTPOOLDIV,R2	;MAXIMUM NUMBER OF ENTRIES IN TABLE.
;
;
;
	MOVAL	MTPOOLTBL,R3		;START OF MT POOL TABLE.
	MOVL	R2,R4			;NUMBER OF ENTRIES.
1$:					;CLEAR TABLE.
	MOVL	R0,R5			;NUMBER OF LONGWORDS PER ENTRY.
2$:
	CLRL	(R3)+			;CLEAR IT.
	SOBGTR	R5,2$			;LOOP TILL ENTRY DONE.
	SOBGTR	R4,1$			;LOOP TILL TABLE DONE.
;
;
;
	MOVAL	MTPOOL,R6		;MAG TAPE POOL BUFFER START.
	MOVL	R6,R3			;DUP IT.
	MOVAL	MTPOOLTBL,R4		;START OF POOL TABLE.
	CLRL	R5			;COUNTER TO KEEP NUMBER OF ENTRIES SO FAR.
3$:
	ADDL	BLOLEN,R3		;ADD IN NEXT BLOCK SIZE.
	CMPL	R3,#MTPOOL+MAXMTPOOL	;PAST END OF BUFFER POOL??
	M_IF_GEQ	4$		;BRANCH IF PAST END OF BUFFER POOL.
	CMPL	R5,#MAXMTPOOLDIV	;ANY MORE ENTRY TO PUT INFO??
	M_IF_GEQ	4$		;BRANCH IF NOT.
	INCL	R5			;ONE MORE ENTRY.
	MOVAL	(R6),(R4)		;SAVE BUFFER START ADDRESS FOR THIS ENTRY.
	ADDL	BLOLEN,R6		;POINT TO NEXT BUFFER SPACE.
	ADDL	R1,R4			;POINT TO START OF NEXT ENTRY.
	BRW	3$			;LOOP TILL NO MORE ENTRY OR OUT OF POOL SPACE.
4$:
	TSTL	R5			;ANY ENTRIES??
	M_IF_NEQ	5$		;BRANCH IF SOME ENTRIES.
	M_MESS	<Block size /!XL/ too large for pool buffer>,<BLOLEN>
	BRW	30$			;EXIT.
5$:
;
;FIX POINTERS.
;
	MOVAL	(R4),MTPOOLENDPTR	;END OF TABLE POINTER.
	MOVAL	MTPOOLBEG,MTPOOLPTR	;BEGIN OF TABLE POINTER.
	MOVAL	MTPOOLBEG,MTPOOLWKPTR	;WORK TABLE POINTER.
20$:					;RETURN SUCCESS C-BIT CLEARED.
	BICPSW	#1			;CLEAR C-BIT.
	BRB	40$			;RETURN.
30$:
	BISPSW	#1			;ERROR RETURN. C-BIT SET.
40$:
	JSB	J_RESREG		;RESTORE R0-R11.
	RSB				;BYE.
.PAGE
.SUBTITLE	INIT VAX POOL TABLE AND POINTER ROUTINE
;
;
;THIS ROUTINE INIT THE VAX TABLE AND POINTER ACORDING TO RECLEN.
;
;
INITVAXPOOL:				;INIT VAX POOL TABLE AMD POINTER ROUTINE.
	JSB	J_SAVREG		;SAVE R0-R11.
	MOVL	#MAXVAXPOOLLONG,R0	;NUMBER OF LONG WORDS PER TABLE ENTRY.
	MOVL	#MAXVAXPOOLBYTE,R1	;NUMBER OF BYTES PER ENRTY.
	MOVL	#MAXVAXPOOLDIV,R2	;MAXIMUM NUMBER OF ENTRIES IN TABLE.
;
;
;
	MOVAL	VAXPOOLTBL,R3		;START OF VAX POOL TABLE.
	MOVL	R2,R4			;NUMBER OF ENTRIES.
1$:					;CLEAR TABLE.
	MOVL	R0,R5			;NUMBER OF LONGWORDS PER ENTRY.
2$:
	CLRL	(R3)+			;CLEAR IT.
	SOBGTR	R5,2$			;LOOP TILL ENTRY DONE.
	SOBGTR	R4,1$			;LOOP TILL TABLE DONE.
;
;
;
	MOVAL	VAXPOOL,R6		;VAX TAPE POOL BUFFER START.
	MOVL	R6,R3			;DUP IT.
	MOVAL	VAXPOOLTBL,R4		;START OF POOL TABLE.
	CLRL	R5			;COUNTER TO KEEP NUMBER OF ENTRIES SO FAR.
3$:
	ADDL	RECLEN,R3		;ADD IN NEXT BLOCK SIZE.
	CMPL	R3,#VAXPOOL+MAXVAXPOOL	;PAST END OF BUFFER POOL??
	M_IF_GEQ	4$		;BRANCH IF PAST END OF BUFFER POOL.
	CMPL	R5,#MAXVAXPOOLDIV	;ANY MORE ENTRY TO PUT INFO??
	M_IF_GEQ	4$		;BRANCH IF NOT.
	INCL	R5			;ONE MORE ENTRY.
	MOVAL	(R6),(R4)		;SAVE BUFFER START ADDRESS FOR THIS ENTRY.
	ADDL	RECLEN,R6		;POINT TO NEXT BUFFER SPACE.
	ADDL	R1,R4			;POINT TO START OF NEXT ENTRY.
	BRW	3$			;LOOP TILL NO MORE ENTRY OR OUT OF POOL SPACE.
4$:
	TSTL	R5			;ANY ENTRIES??
	M_IF_NEQ	5$		;BRANCH IF SOME ENTRIES.
	M_MESS	<Record size /!XL/ too large for pool buffer>,<RECLEN>
	BRW	30$			;EXIT.
5$:
;
;FIX POINTERS.
;
	MOVAL	(R4),VAXPOOLENDPTR	;END OF TABLE POINTER.
	MOVAL	VAXPOOLBEG,VAXPOOLPTR	;BEGIN OF TABLE POINTER.
	MOVAL	VAXPOOLBEG,VAXPOOLWKPTR	;WORK TABLE POINTER.
20$:					;RETURN SUCCESS C-BIT CLEARED.
	BICPSW	#1			;CLEAR C-BIT.
	BRB	40$			;RETURN.
30$:
	BISPSW	#1			;ERROR RETURN. C-BIT SET.
40$:
	JSB	J_RESREG		;RESTORE R0-R11.
	RSB				;BYE.
.PAGE
.SUBTITLE	MOVE TRANSLATE ROUTINE
;
;
;MOVE TRANSLATE ROUTINE.
;
;
;EXPECTS
;
;	R0	=	NUMBER OF BYTES IN SOURCE STRING.
;	R1	=	SOURCE STRING ADDRESS.
;	R3	=	TRANLATION TABLE ADDRESS.
;	R4	=	OUTPUT NUMBER OF BYTES.
;	R5	=	OUTPUT ADDRESS.
;
;RETURNS
;
;	R0-R5 AS AFFECTED BY MOVTUC INSTRUCTION.
;	R6	=	# OF ILLEGAL CHARACTERS.
;
;
;MESSAGE.
;
BADCHA:	.ASCID	\Bad character detected=/!XB/ translation table=!XL!/-AT PC=!XL\
;
MOVETRANSLATE:				;MOVE TRANSLATE STRING.
	CLRL	R6			;CLEAR FOR NO ERROR.
1$:
	MOVTC	R0,(R1),#^A/?/,(R3),R4,(R5)	;MOVE TRANSLATE.
	M_IF_VC	2$			;BRANCH IF DONE.
	M_MESX	#BADCHA,<(R1),R3,4(SP)>	;TELL USER.
	MOVB	#^A/?/,(R5)+		;MOVE IN DEFAULT FOR ILLEGAL CHAR.
	TSTB	(R1)+			;POINT TO NEXT CHAR IN INPUT STRING.
	DECL	R0			;ONE LESS.
	DECL	R4			;ONE LESS.
	INCL	R6			;ONE MORE ERROR.
	BRW	1$			;DO NEXT CHAR.
2$:
	RSB			;BYE.
.PAGE
.SUBTITLE	MAG TAPE READ ROUTINE
;
;MAGTAPE READ ROUTINE.
;
;EXPECTS
;
;	MT POOL POINTER (MT) CORRECT.
;
MTREAD:
;;;;	JSB	J_SAVREG		;SAVE R0-R11.
	MOVL	R10,-(SP)		;SAVE R10,R11.
	MOVL	R11,-(SP)		;
	BICL	#X_MTREQ,XTLLONG	;CLEAR MT READ REQUEST.
	MOVL	MTPOOLPTR,R11		;GET MT BUFFER POINTER.
	MOVL	OF_POOL_BUF(R11),R10	;BUFFER ADDRESS.
	BITL	#X_MTINPROG,XTLLONG	;MAG TAPE ALREADY IN PROGRESS.
	M_IF_EQL	1$		;BRANCH IF NOT IN PROGRESS.
	M_MESS	<Try access on magtape while it is in progress>
	BRW	30$			;EXIT.
1$:
	BISL	#X_MTINPROG,XTLLONG	;INDICATE MAGTAPE IN PROGRESS.
	$QIO_S -			;READ IN BLOCK.
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_READVBLK,-	;
		IOSB=MTIOSB,-		;
		ASTADR=MTREADAST,-	;
		P1=(R10),-		;
		P2=BLOLEN		;
	M_ON0ERR	30$,<SYSONLY>
20$:
	BICPSW	#1			;CLEAR C-BIT.
	BRW	40$			;RETURN.
30$:
	BISPSW	#1			;SET C-BIT.
40$:
;;;;	JSB	J_RESREG		;RESTORE R0-R11.
	MOVL	(SP)+,R11		;RESTORE R11,R10.
	MOVL	(SP)+,R10		;
	RSB				;BYE.
.PAGE
.SUBTITLE	VAX READ ROUTINE
;
;VAX READ ROUTINE.
;
;EXPECTS
;
;	VAX POOL POINTER (VAX) CORRECT.
;
VAXREAD:
;;;;	JSB	J_SAVREG		;SAVE R0-R11.
	MOVL	R10,-(SP)		;SAVE R10.
	MOVL	R11,-(SP)		;SAVE R11.
	BICL	#X_VAXREQ,XTLLONG	;CLEAR VAX READ REQUEST.
	MOVL	VAXPOOLPTR,R11		;GET VAX BUFFER POINTER.
	MOVL	OF_POOL_BUF(R11),R10	;BUFFER ADDRESS.
	BITL	#X_VAXINPROG,XTLLONG	;VAX ALREADY IN PROGRESS.
	M_IF_EQL	1$		;BRANCH IF NOT IN PROGRESS.
	M_MESS	<Try access on VAX while it is in progress>
	BRW	30$			;EXIT.
1$:
	BISL	#X_VAXINPROG,XTLLONG	;INDICATE VAX IN PROGRESS.
	MOVL	R10,OLDRAB+RAB$L_UBF	;USER BUFFER.
	MOVW	RECLEN,OLDRAB+RAB$W_USZ	;SIZE.
	$GET	-			;GET NEXT RECORD.
		RAB=OLDRAB,-		;
		ERR=VAXREADAST,-	;
		SUC=VAXREADAST		;
	CMPL	#RMS$_EOF,R0		;EOF??
	M_IF_EQL	20$		;EOF IS OKAY.
	M_ON0ERR	30$,<SYSONLY>
20$:
	BICPSW	#1			;CLEAR C-BIT.
	BRW	40$			;RETURN.
30$:
	BISPSW	#1			;SET C-BIT.
40$:
;;;;	JSB	J_RESREG		;RESTORE R0-R11.
	MOVL	(SP)+,R11		;RESTORE R11.
	MOVL	(SP)+,R10		;RESTORE R10.
	RSB				;BYE.
.PAGE
.SUBTITLE	VAX WRITE ROUTINE
;
;VAX WRITE ROUTINE.
;
;
VAXWRITE:				;VAX WRITE ROUTINE.
;;;;	JSB	J_SAVREG		;SAVE R0-R11.
	MOVL	R10,-(SP)		;SAVE R10.
	MOVL	R11,-(SP)		;SAVE R11.
	BITL	#X_AST,XTLLONG		;CALL FROM AST??
	M_IF_NEQ	10$		;BRANCH IF CALL FROM AST.
	$SETAST_S	ENBFLG=#0	;DISABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
10$:
	BITL	#X_VAXINPROG,XTLLONG	;VAX IN PROGRESS??
	M_IF_NEQ	21$		;RETRUN IF VAX IN PROGRESS ALREADY.
	MOVL	VAXPOOLPTR,R11		;VAX POOL TABLE POINTER.
	BITL	#B_GOOD,OF_POOL_FLG(R11)	;GOOD VAX BUFFER??
	M_IF_NEQ	1$		;BRANCH IF GOOD BUFFER.
	M_MESS	<Trying to write a bad VAX buffer>
	BRW	30$			;EXIT IF ERROR.
1$:
	BISL	#X_VAXINPROG,XTLLONG	;INDICATE VAX IN PROGRESS.
	BITL	#X_AST,XTLLONG		;CALLED FROM AST??
	M_IF_NEQ	11$		;BRANCH IF CALLED FROM AST.
	$SETAST_S	ENBFLG=#1	;ENABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
11$:
	MOVL	OF_POOL_BUF(R11),NEWRAB+RAB$L_RBF ;SET RBF.
	MOVW	OF_POOL_BUFLEN(R11),NEWRAB+RAB$W_RSZ ;SET RSZ.
	$PUT	-			;PUT THE RECORD.
		RAB=NEWRAB,-		;
		ERR=VAXWRITEAST,-	;
		SUC=VAXWRITEAST		;
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	BRW	20$			;RETURN.
21$:
	BITL	#X_AST,XTLLONG		;CALL FROM AST??
	M_IF_NEQ	12$		;BRANCH IF CALLED FROM AST.
	$SETAST_S	ENBFLG=#1	;ENABLE AST JUST IN CASE.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
12$:
20$:
	BICPSW	#1			;CLEAR C-BIT.
	BRB	40$			;RETURN.
30$:
	BITL	#X_AST,XTLLONG		;CALLED FROM AST??
	M_IF_NEQ	13$		;BRANCH IF CALLED FROM AST.
	$SETAST_S	ENBFLG=#1	;ENABLE AST JUST IN CASE.
	M_ON0ERR	,<SYSONLY>	;TELL USER IF ERROR.
13$:
	BISPSW	#1			;SET C-BIT.
40$:
;;;;	JSB	J_RESREG		;RESTORE R0-R11.
	MOVL	(SP)+,R11		;RESTORE R11.
	MOVL	(SP)+,R10		;RESTORE R10.
	RSB				;BYE.
.PAGE
.SUBTITLE	MAGTAPE READ AST ROUTINE
;
;MAGTAPE READ AST ROUTINE.
;
;
	.ENTRY	MTREADAST	^M<R10,R11>
	BISL	#X_AST,XTLLONG		;INDICATE IN AST.
	BITL	#X_MTSUSPEND,XTLLONG	;SUPENDED DUE TO MT??
	M_IF_EQL	10$		;BRANCH IF NOT.
	BICL	#X_MTSUSPEND,XTLLONG	;CLEAR SUSPEND FLAG.
	.IF	DF	DEBUG
	M_MESS	<Task hibernate, going to wake up...>
	.ENDC
	$WAKE_S				;WAKE UP TASK.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
10$:
	MOVL	MTPOOLPTR,R11		;MT POOL TABLE POINTER.
	.IF	DF	DEBUG
	M_MESS	<MTPOOLPTR=!XL>,<R11>
	.ENDC
	BICL	#X_MTINPROG,XTLLONG	;CLEAR MAGTAPE IN PROGRESS.
	CMPW	#SS$_ENDOFFILE,MTIOSB	;END OF FILE??
	M_IF_EQL	1$		;BRANCH IF EOF.
	CMPW	#SS$_ENDOFTAPE,MTIOSB	;END OF TAPE??
	M_IF_NEQ	2$		;BRANCH IF NOT EOT.
	BISL	#X_ENDOFTAPE,XTLLONG	;INDICATE EOT DETECTED.
	BRW	3$			;EOT IS OKAY.
2$:
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
3$:
	INCL	BLOCNTACCUM			;ONE MORE BLOCK.
	BISL	#B_GOOD,OF_POOL_FLG(R11)	;INDICATE MT BUF GOOD.
	MOVZWL	MTIOSB+2,OF_POOL_BUFLEN(R11)	;ACTUAL LENGTH OF MT BUF.
	CLRL	OF_POOL_CURBYT(R11)	;CURRENT BYTE IS ZERO.
	MOVL	#MAXMTPOOLBYTE,R10	;NUMBER OF BYTES PER ENTRY.
	ADDL	R10,R11			;POINT TO NEXT ENTRY.
	CMPL	R11,MTPOOLENDPTR		;END OF MT POOL TABLE??
	M_IF_NEQ	4$		;BRANCH IF NOT.
	MOVL	#MTPOOLBEG,R11		;WRAP AROUND.
4$:
	MOVL	R11,MTPOOLPTR		;UPDATE MT POOL TABLE POINTER.
	BITL	#B_GOOD,OF_POOL_FLG(R11)	;A GOOD BUFFER??
	M_IF_EQL	5$		;BRANCH IF NOT GOOD.
	BISL	#X_MTREQ,XTLLONG		;MAGTAPE NEEDS TO WAIT.
	.IF	DF	DEBUG
	M_MESS	<No free buffer, magtape wait...>
	.ENDC
	BRW	20$			;RETURN.
5$:
	JSB	MTREAD			;DO ANOTHER READ.
	M_IF_CS	30$			;EXIT IF ERROR.
	BRW	20$			;RETURN.
;
;EOF.
;
1$:
	BISL	#B_GOOD,OF_POOL_FLG(R11)	;INDICATE EOF.
	BISL	#B_EOF,OF_POOL_FLG(R11)	;
	CLRL	OF_POOL_BUFLEN(R11)	;NO BYTES.
	CLRL	OF_POOL_CURBYT(R11)	;CURRENT BYTE IS ZERO.
	BRW	20$			;DON'T INITIATE ANOTHER READ.
;
;
;
20$:
	BRB	40$			;RETURN.
30$:
	BISL	#X_ERROR,XTLLONG	;INDICATE ERROR.
40$:
	BICL	#X_AST,XTLLONG		;INDICATE GETTING OUT OF AST.
	RET				;
.PAGE
.SUBTITLE	PROCESS MT BUFFER ROUTINE
;
;PROCESS MT BUFFER ROUTINE.
;
;
PRC_MTBUF:
;;;;	JSB	J_SAVREG		;SAVE REGS 0-11.
	MOVL	R11,-(SP)		;SAVE R11.
	.IF	DF	DEBUG
	M_MESS	<PRC_MTBUF>
	.ENDC
1$:
	BITL	#X_ERROR,XTLLONG	;ANY ASY ERROR.
	M_IF_NEQ	30$		;EXIT IF ASY ERROR.
	$SETAST_S	ENBFLG=#0	;DISABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	MOVL	VAXPOOLWKPTR,R11	;CURRENT VAX BUFFER POINTER.
	.IF	DF	DEBUG
	M_MESS	<VAXPOOLWKPTR=!XL>,<R11>	;
	.ENDC
	BITL	OF_POOL_FLG(R11),#B_GOOD	;A GOOD VAX BUFFER??
	M_IF_EQL	2$		;BRANCH IF BUFFER IS BAD.
	BISL	#X_VAXSUSPEND,XTLLONG	;GO TO SLEEP, UNITL A BAD VAX BUFFER.
	.IF	DF	DEBUG
	M_MESS	<No bad VAX buffer to write to, goto sleep>
	.ENDC
	$SETAST_S	ENBFLG=#1	;ENABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	$HIBER_S			;GOTO SLEEP.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	BRW	1$			;WOKE UP, SO SEE IF ANY BAD BUFFER.
;
;
;GOT A BAD VAX BUFFER.
;
2$:
	$SETAST_S	ENBFLG=#1	;ENABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	MOVL	MTPOOLWKPTR,R10		;CURRENT MT BUFFER POINTER.
	MOVL	OF_POOL_BUF(R10),R8	;START OF MT BUFFER.
	ADDL	OF_POOL_CURBYT(R10),R8	;POINT TO CURRENT BYTE.
	BITL	#B_GOOD,OF_POOL_FLG(R10)	;DOUBLE CHECK FOR GOOD MT BUFFER.
	M_IF_NEQ	3$		;BRANCH IF GOOD MT BUFFER.
	M_MESS	<bad MT buffer to process>
	BRW	30$			;EXIT.
3$:
	MOVL	OF_POOL_BUF(R11),R9	;START OF VAX BUFFER.
	ADDL	OF_POOL_CURBYT(R11),R9	;POINT TO CURRENT BYTE.
;
;MT BUFFER EXHAUSTED??
;
	CMPL	OF_POOL_BUFLEN(R10),OF_POOL_CURBYT(R10)	;MT BUFFER EXHAUSETED??
	M_IF_EQL	20$		;RETURN IF EXHAUSTED
	TSTL	OF_POOL_CURBYT(R10)	;FIRST BYTE IN MT BUFFER??
	M_IF_GTR	6$		;BRANCH IF NOT FIRST BYTE.
	CASEB	RFM,#0,#1		;WHAT RECORD FORMAT??
70$:
	.WORD	71$-70$			;VARIABLE.
	.WORD	72$-70$			;FIX.
	M_MESS	<RFM mode /!UB/ out of range>,<RFM>
	BRW	30$			;BYE.
;
;VARIABLE.
;
71$:
	CLRL	MTPOOLBLOLEN		;GET MTBUFFER SIZE.
	MOVB	1(R8),MTPOOLBLOLEN	;SWAP BYTES.
	MOVB	(R8),MTPOOLBLOLEN+1	;
	CMPL	OF_POOL_BUFLEN(R10),MTPOOLBLOLEN	;SHOULD MATCH WITH MT BUFFER SIZE.
	M_IF_EQL	7$		;BRANCH IF MATCHED.
	M_MESS	<MT buffer size /!UL/ not matched with MT block size /!UL/>,-
		<OF_POOL_BUFLEN(R10),MTPOOLBLOLEN>
	BRW	30$			;EXIT.
7$:
	ADDL	#4,OF_POOL_CURBYT(R10)	;UPDATE CURRENT BYTE IN MT BUFFER.
	ADDL	#4,R8			;UPDATE MT BUFFER ADDRESS.
	BRW	6$			;REJOIN.
;
;
;FIX.
;
72$:
	MOVL	OF_POOL_BUFLEN(R10),MTPOOLBLOLEN	;BLOCK LENGTH.
	BRW	6$			;REJOIN.
;
;REJOIN.
;
6$:
;
;GET MT RECORD LENGTH AND MODE.
;
	CASEB	RFM,#0,#1		;+001	FIX OR VARIABLE??
10$:
	.WORD	11$-10$			;+001	VARIABLE.
	.WORD	12$-10$			;+001	FIX.
	M_MESS	<RFM mode /!UB/ out of range>,<RFM>	;TELL USER BAD NEWS.
	BRW	30$			;+001	BYE.
;
;VARIABLE.
;
11$:
	CLRL	MTPOOLRECLEN		;GET MT RECORD LENGTH.
	MOVB	1(R8),MTPOOLRECLEN	;SWAP BYTES.
	MOVB	(R8),MTPOOLRECLEN+1	;
	SUBL	#4,MTPOOLRECLEN		;MINUS 4 BYTES FOR RECORD DESC.
	MOVB	2(R8),MTPOOLRECMOD	;GET MT POOL RECORD MODE.
	ADDL	#4,OF_POOL_CURBYT(R10)	;UPDATE CURRENT BYTE IN MT BUFFER.
	ADDL	#4,R8			;UPDATE MT BUFFER ADDRESS.
	BRW	15$			;REJOIN.
;
;FIX.
;
12$:
	MOVL	RECLEN,MTPOOLRECLEN	;FIX LENGTH.
	MOVB	#0,MTPOOLRECMOD		;ALL.
	BRW	15$			;REJOIN.
;
;
;REJOIN.
;
15$:
;
;
;GO TO RIGHT ROUTINE TO PROCESS MT POOL RECORD.
;DEPENDING ON THE RECORD MODE.
;
	CASEB	MTPOOLRECMOD,#0,#3	;GO THERE.
100$:
	.WORD	200$-100$		;ALL.
	.WORD	300$-100$		;FIRST.
	.WORD	400$-100$		;LAST.
	.WORD	500$-100$		;MIDDLE.
;
;
	M_MESS	<Unknown mtpool record mode /!UB/>,<MTPOOLRECMOD>
	BRW	30$			;EXIT.
;
;
;ALL.
;
200$:					;ALL.
	TSTL	OF_POOL_CURBYT(R11)	;EXPECT NO CURRENT BYTE.
	M_IF_EQL	201$		;BRANCH IF NO CURRENT BYTE.
	M_MESS	<Zero current byte expected in VAX buffer /!UL/>,-
		<OF_POOL_CURBYT(R11)>
	BRW	30$			;EXIT.
201$:
;
;TRANSLATE EBCDIC TO ASCII.
;
	MOVL	MTPOOLRECLEN,R0		;LENGTH OF TRANSLATION.
	MOVL	R8,R1			;MT BUFFER ADDRESS.
	MOVAL	EBCASCTBL,R3		;EBCDIC TO ASCII TRANSLATION TABLE.
	MOVL	R0,R4			;OUTPUT IN VAX BUFFER.
	MOVL	R9,R5			;
	JSB	MOVETRANSLATE		;GO TRNASLATE.
	TSTL	R6			;ANY ERRORS.
;
;CONTINUE EVEN IF ERROR.
;
	ADDL	MTPOOLRECLEN,R9		;UPDATE VAX BUFFER ADDRESS.
	MOVL	MTPOOLRECLEN,OF_POOL_BUFLEN(R11) ;UPDATE VAX BUFFER SIZE.
	MOVL	MTPOOLRECLEN,OF_POOL_CURBYT(R11) ;UPDATE VAX CURRENT BYTE.
	ADDL	MTPOOLRECLEN,R8		;UPDATE MT BUFFER ADDRESS.
	ADDL	MTPOOLRECLEN,OF_POOL_CURBYT(R10) ;UPDATE MT CURRENT BYTE.
	BISL	#B_GOOD,OF_POOL_FLG(R11)	;MAKE VAX BUFFER A GOOD BUFFER.
	JSB	VAXWRITE		;WRITE VAX BUFFER.
	M_IF_CS	30$			;EXIT IF ERROR.
	BRW	50$			;GET NEXT BAD VAX BUFFER.
;
;
;FIRST.
;
300$:					;FIRST.
	TSTL	OF_POOL_CURBYT(R11)	;EXPECT NO CURRENT BYTE.
	M_IF_EQL	301$		;BRANCH IF NO CURRENT BYTE.
	M_MESS	<Zero current byte expected in VAX buffer /!UL/>,-
		<OF_POOL_CURBYT(R11)>
	BRW	30$			;EXIT.
301$:
;
;TRANSLATE EBCDIC TO ASCII.
;
	MOVL	MTPOOLRECLEN,R0		;LENGTH OF TRANSLATION.
	MOVL	R8,R1			;MT BUFFER ADDRESS.
	MOVAL	EBCASCTBL,R3		;EBCDIC TO ASCII TRANSLATION TABLE.
	MOVL	R0,R4			;OUTPUT IN VAX BUFFER.
	MOVL	R9,R5			;
	JSB	MOVETRANSLATE		;GO TRNASLATE.
	TSTL	R6			;ANY ERRORS.
;
;CONTINUE EVEN IF ERROR.
;
	ADDL	MTPOOLRECLEN,R9		;UPDATE VAX BUFFER ADDRESS.
	MOVL	MTPOOLRECLEN,OF_POOL_BUFLEN(R11) ;UPDATE VAX BUFFER SIZE.
	MOVL	MTPOOLRECLEN,OF_POOL_CURBYT(R11) ;UPDATE VAX CURRENT BYTE.
	ADDL	MTPOOLRECLEN,R8		;UPDATE MT BUFFER ADDRESS.
	ADDL	MTPOOLRECLEN,OF_POOL_CURBYT(R10) ;UPDATE MT CURRENT BYTE.
	CMPL	OF_POOL_BUFLEN(R10),OF_POOL_CURBYT(R10) ;MT BUFFER SHOULD
					;BE EXHAUSTED.
	M_IF_EQL	302$		;BRANCH IF MT BUFFER EXHAUSTED.
	M_MESS	<MT pool buffer not exhausted /!UL/ /!UL/>,-
		<OF_POOL_BUFLEN(R10),OF_POOL_CURBYT(R10)>
	BRW	30$			;EXIT.
302$:
	BRW	20$			;FINISH MT BUFFER, SO RETURN.
;
;
;END.
;
400$:					;END.
	TSTL	OF_POOL_CURBYT(R11)	;EXPECT SOME VURRENT BYTE.
	M_IF_NEQ	401$		;BRANCH IF SOME CURRENT BYTE.
	M_MESS	<Non zero current byte expected>
	BRW	30$			;EXIT.
401$:
;
;TRANSLATE EBCDIC TO ASCII.
;
	MOVL	MTPOOLRECLEN,R0		;LENGTH OF TRANSLATION.
	MOVL	R8,R1			;MT BUFFER ADDRESS.
	MOVAL	EBCASCTBL,R3		;EBCDIC TO ASCII TRANSLATION TABLE.
	MOVL	R0,R4			;OUTPUT IN VAX BUFFER.
	MOVL	R9,R5			;
	JSB	MOVETRANSLATE		;GO TRNASLATE.
	TSTL	R6			;ANY ERRORS.
;
;CONTINUE EVEN IF ERROR.
;
	ADDL	MTPOOLRECLEN,R9		;UPDATE VAX BUFFER ADDRESS.
	ADDL	MTPOOLRECLEN,OF_POOL_BUFLEN(R11) ;UPDATE VAX BUFFER SIZE.
	ADDL	MTPOOLRECLEN,OF_POOL_CURBYT(R11) ;UPDATE VAX CURRENT BYTE.
	ADDL	MTPOOLRECLEN,R8		;UPDATE MT BUFFER ADDRESS.
	ADDL	MTPOOLRECLEN,OF_POOL_CURBYT(R10) ;UPDATE MT CURRENT BYTE.
	BISL	#B_GOOD,OF_POOL_FLG(R11)	;MAKE VAX BUFFER GOOD.
	JSB	VAXWRITE		;WRITE VAX BUFFER.
	M_IF_CS	30$			;EXIT IF ERROR.
	BRW	50$			;GET NEXT VAX BUFFER.
;
;
;MIDDLE.
;
500$:					;MIDDLE.
	TSTL	OF_POOL_CURBYT(R11)	;EXPECT SOME CURRENT BYTES.
	M_IF_NEQ	501$		;BRANCH IF SOME.
	M_MESS	<Non zero current byte expected>
	BRW	30$			;EXIT.
501$:
;
;TRANSLATE EBCDIC TO ASCII.
;
	MOVL	MTPOOLRECLEN,R0		;LENGTH OF TRANSLATION.
	MOVL	R8,R1			;MT BUFFER ADDRESS.
	MOVAL	EBCASCTBL,R3		;EBCDIC TO ASCII TRANSLATION TABLE.
	MOVL	R0,R4			;OUTPUT IN VAX BUFFER.
	MOVL	R9,R5			;
	JSB	MOVETRANSLATE		;GO TRNASLATE.
	TSTL	R6			;ANY ERRORS.
;
;CONTINUE EVEN IF ERROR.
;
	ADDL	MTPOOLRECLEN,R9		;UPDATE VAX BUFFER ADDRESS.
	ADDL	MTPOOLRECLEN,OF_POOL_BUFLEN(R11) ;UPDATE VAX BUFFER SIZE.
	ADDL	MTPOOLRECLEN,OF_POOL_CURBYT(R11) ;UPDATE VAX CURRENT BYTE.
	ADDL	MTPOOLRECLEN,R8		;UPDATE MT BUFFER ADDRESS.
	ADDL	MTPOOLRECLEN,OF_POOL_CURBYT(R10) ;UPDATE MT CURRENT BYTE.
	CMPL	OF_POOL_BUFLEN(R10),OF_POOL_CURBYT(R10) ;MT SHOULD BE EXHAUSTED.
	M_IF_EQL	502$		;BRANCH IF EXHAUSETED.
	M_MESS	<MT buffer not exhausted /!UL/ /!UL/>,-
		<OF_POOL_BUFLEN(R10),OF_POOL_CURBYT(R10)>
	BRW	30$			;EXIT.
502$:
	BRW	20$			;FINISH WITH MT BUFFER, SO THAT'S ALL.
;
;
;GET NEXT BAD VAX BUFFER.
;
50$:					;GET NEXT BAD VAX BUFFER.
	MOVL	#MAXVAXPOOLBYTE,R3	;# OF BYTES PER MT POOL TABLE ENTRY.
	ADDL	R3,R11			;POINT TO NEXT ENTRY.
	CMPL	R11,VAXPOOLENDPTR	;AT END OF TABLE.
	M_IF_NEQ	51$		;BRANCH IF NOT.
	MOVL	#VAXPOOLBEG,R11		;WRAP AROUND.
51$:
	MOVL	R11,VAXPOOLWKPTR	;UPDATE CURRENT WORK VAX POINTER.
	BRW	1$			;GO VERIFY IT IS BAD
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	$SETAST_S	ENBFLG=#1	;ENABLE AST.
	M_ON0ERR	,<SYSONLY>	;TELL USER IF ERROR.
	BISPSW	#1		;SET C-BIT.
40$:
;;;;	JSB	J_RESREG	;RESTORE REGS 0-11.
	MOVL	(SP)+,R11	;RESTORE R11.
	RSB			;BYE.
.PAGE
.SUBTITLE	VAX WRITE AST ROUTINE
;
;
;VAX WRITE AST ROUTINE.
;
;
	.ENTRY	VAXWRITEAST	^M<R10,R11>
	BISL	#X_AST,XTLLONG		;INDICATE IN AST.
	BITL	#X_VAXSUSPEND,XTLLONG	;TASK SLEEPING DUE TO THIS??
	M_IF_EQL	1$		;BRANCH IF NOT ASLEEP.
	BICL	#X_VAXSUSPEND,XTLLONG	;CLEAR ASLEEP FLAG.
	.IF	DF	DEBUG
	M_MESS	<Task asleep, VAXWRITE wakes it up>
	.ENDC
	$WAKE_S				;WAKE UP.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
1$:
	MOVL	VAXPOOLPTR,R11		;VAX POOL TABLE POINTER.
	.IF	DF	DEBUG
	M_MESS	<VAXPOOLPTR=!XL>,<R11>
	.ENDC
	BICL	#X_VAXINPROG,XTLLONG	;CLEAR VAX IN PROGRESS FLAG.
	M_ONRMSERR	30$,NEWRAB,<SYSONLY>	;EXIT IF ERROR.
	BICL	#B_GOOD,OF_POOL_FLG(R11)	;CLEAR GOOD BUFFER FLAG.
	CLRL	OF_POOL_BUFLEN(R11)	;CLEAR BUFFER SIZE.
	CLRL	OF_POOL_CURBYT(R11)	;INIT CURRENT BYTE.
	MOVL	#MAXVAXPOOLBYTE,R10	;# OF BYTES IN ENTRY.
	ADDL	R10,R11			;POINT TO NEXT ENTRY.
	CMPL	R11,VAXPOOLENDPTR	;END OF TABLE.
	M_IF_NEQ	2$		;BRANCH IF NOT END OF TABLE.
	MOVL	#VAXPOOLBEG,R11		;WRAP AROUND.
2$:
	MOVL	R11,VAXPOOLPTR		;UPDATE VAX TABLE POINTER.
	BITL	#B_GOOD,OF_POOL_FLG(R11)	;GOOD BUFFER?
	M_IF_EQL	3$		;BRANCH IF NOT GOOD BUFFER.
	JSB	VAXWRITE		;START ANOTHER WRITE.
	M_IF_CS	30$			;EXIT IF ERROR.
3$:
20$:
	BRB	40$			;RETURN.
30$:
	BISL	#X_ERROR,XTLLONG	;INDICATE ASY ERROR.
40$:
	BICL	#X_AST,XTLLONG		;INDICATE OUT OF AST.
	RET
.PAGE
.SUBTITLE	PROCESS VAX BUFFER ROUTINE
;
;PROCESS VAX BUFFER ROUTINE.
;
PRC_VAXBUF:				;PROCESS VAX BUFFER ROUTINE.
;;;;	JSB	J_SAVREG		;SAVE R0-R11.
	MOVL	R11,-(SP)		;SAVE R11.
	CLRB	MTPOOLRECMOD		;INT MT POOL RECORD MODE.
1$:
	BITL	#X_ERROR,XTLLONG	;ANY ASY ERROR.
	M_IF_NEQ	30$		;EXIT IF ASY ERROR.
	$SETAST_S	ENBFLG=#0	;DISABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	MOVL	MTPOOLWKPTR,R11		;CURRENT MT POINTER.
	.IF	DF	DEBUG
	M_MESS	<MTPOOLWKPTR=!XL>,<R11>
	.ENDC
	BITL	OF_POOL_FLG(R11),#B_GOOD	;GOOD MT BUFFER??
	M_IF_EQL	2$		;BRANCH IF BAD MT BUFFER.
	BISL	#X_MTSUSPEND,XTLLONG	;GO TO SLLEEP UNTIL BAD MT BUFFER.
	.IF	DF	DEBUG
	M_MESS	<No bad MT buffer to write to, so go to sleep>
	.ENDC
	$SETAST_S	ENBFLG=#1	;ENABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	$HIBER_S			;GO TO SLEEP.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	BRW	1$			;WOKE UP, SO CHECK IF BAD MT BUFFER.
;
;GOT A BAD MT BUFFER TO WRITE TO, SO PROCESS VAX BUFFER.
;
2$:
	$SETAST_S	ENBFLG=#1	;ENABLE AST.
	MOVL	VAXPOOLWKPTR,R10	;VAX POOL CURRENT WORK POINTER.
	MOVL	OF_POOL_BUF(R10),R8	;CURRENT VAX BUFFER ADDRESS.
	ADDL	OF_POOL_CURBYT(R10),R8	;POINT TO CURRENT BYTE.
	BITL	#B_GOOD,OF_POOL_FLG(R10)	;MAKE SURE VAX BUFFER GOOD.
	M_IF_NEQ	3$		;BRANCH IF GOOD VAX BUFFER.
	M_MESS	<Bad VAX buffer to process>
	BRW	30$			;EXIT.
3$:
	MOVL	OF_POOL_BUF(R11),R9	;CURRENT MT BUFFER ADDRESS.
	ADDL	OF_POOL_CURBYT(R11),R9	;POINT TO CURRENT BYTE.
;
;CHECK TO SEE IF VAX BUFFER EXHAUSTED.
;
	CMPL	OF_POOL_BUFLEN(R10),OF_POOL_CURBYT(R10)	;COMPARE.
	M_IF_EQL	500$		;BRANCH IF EXHAUSTED. GO SEE IF LAST VAX BUFFER.
	M_IF_GTR	10$		;BRANCH IF MORE TO DO.
	M_MESS	<Reading pass end of VAX buffer /!UL/ /!UL/>,-
		<OF_POOL_BUFLEN(R10),OF_POOL_CURBYT(R10)>
	BRW	30$			;EXIT.
10$:
	TSTL	OF_POOL_CURBYT(R11)	;BRAND NEW MT BUFFER??
	M_IF_GTR	6$		;BRANCH IF NOT BRAND NEW.
	MOVL	R9,BLOCKDESCPTR		;REMEMBER CURRENT MT BUFFER ADDRESS.
	ADDL	#4,OF_POOL_CURBYT(R11)	;RESERVED SPACE FOR BLOCK DESC.
	ADDL	#4,OF_POOL_BUFLEN(R11)	;UPDATE BUFFER SIZE.
	ADDL	#4,R9			;UPDATE BUFFER POSITION.
6$:
	MOVL	BLOLEN,R7		;MAX MT BLOCK SIZE.
	SUBL	OF_POOL_CURBYT(R11),R7	;HOW MANY BYTES LEFT IN MT BUFFER.
	CMPL	#4,R7			;MUST BE BIGGER THAN 4 BYTES.
	M_IF_GEQ	50$		;NOT GREATER THAN 4 BYTES SO GET ANOTHER MT BUFFER.
	MOVL	R9,RECORDDESCPTR	;REMEMBER CURRENT MT BUFFER ADDRESS.
	ADDL	#4,OF_POOL_CURBYT(R11)	;RESERVED 4 BYTES FOR RECORD DESC.
	ADDL	#4,OF_POOL_BUFLEN(R11)	;UPDATE BUFFER SIZE.
	ADDL	#4,R9			;UPDATE BUFFER POSITION.
	MOVL	OF_POOL_BUFLEN(R10),R6	;ACTUAL VAX BUFFER SIZE. (RECORD).
	SUBL	OF_POOL_CURBYT(R10),R6	;NUMBER OF BYTES LEFT IN VAX BUFFER.
	TSTL	R6			;NUMBER OF BYTES LEFT.
	M_IF_GTR	7$		;MUST BE POSITIVE.
	M_MESS	<Negative number of bytes /!UL/ LEFT IN VAX BUFFER>,-
		<R6>
	BRW	30$			;EXIT.
7$:
	MOVL	BLOLEN,R7		;MAXIMUM MT BLOCK SIZE.
	SUBL	OF_POOL_CURBYT(R11),R7	;NUMBER OF BYTES LEFT IN MT BUFFER.
	TSTL	R7			;MUST BE POSITIVE.
	M_IF_GTR	8$		;BRANCH IF POSITIVE.
	M_MESS	<Negative number of bytes /!UL/ left in MT buffer>,<R7>
	BRW	30$			;EXIT.
8$:
	CMPL	R6,R7			;SEE WHICH BUFFER LEFT IS BIGGER.
	M_IF_LEQ	100$		;BRANCH IF MT BUFFER IS BIGGER.
	M_IF_GTR	200$		;BRANCH IF VAX BUFFER IS BIGGER.
;
;
;MT BUFFER IS BIGGER OR SAME SIZE.
;
100$:
	MOVL	R6,MTPOOLRECLEN		;WRITE ONLY WHAT IS LEFT IN VAX BUFFER.
	MOVL	RECORDDESCPTR,R7	;UPDATE RECORD DESC.
	ADDL	#4,MTPOOLRECLEN		;RECORD DESC INCLUDES ITSELF.
	MOVB	MTPOOLRECLEN,1(R7)	;SWAP BYTES.
	MOVB	MTPOOLRECLEN+1,(R7)	;
	SUBL	#4,MTPOOLRECLEN		;ACTUAL MT POOL RECORD SIZE.
	MOVL	MTPOOLRECLEN,R0		;LENGTH OF TRANSLATION.
	MOVL	R8,R1			;VAX BUFFER ADDRESS.
	MOVAL	ASCEBCTBL,R3		;ASCII TO EBCDIC TRANSLATION TABLE.
	MOVL	R0,R4			;OUTPUT IN MT BUFFER.
	MOVL	R9,R5			;
	JSB	MOVETRANSLATE		;GO TRNASLATE.
	TSTL	R6			;ANY ERRORS.
;
;CONTINUE EVEN IF ERROR.
;
	ADDL	MTPOOLRECLEN,OF_POOL_CURBYT(R11) ;UPDATE MT CURRENT BYTE.
	ADDL	MTPOOLRECLEN,OF_POOL_BUFLEN(R11) ;UPDATE MT BUFFER SIZE.
	ADDL	MTPOOLRECLEN,R9		;UPDATE MT BUFFER POSITION.
	ADDL	MTPOOLRECLEN,OF_POOL_CURBYT(R10) ;UPDATE VAX CURRENT BYTE.
	ADDL	MTPOOLRECLEN,R8		;UPDATE VAX BUFFER POSITION.
	CASEB	MTPOOLRECMOD,#0,#1	;GO UPDATE RECORD MODE DEPENDING:
300$:
	.WORD	310$-300$		;ALL.
	.WORD	320$-300$		;END.
;
	M_MESS	<MT record mode /!UB/ out of range>,<MTPOOLRECMOD>
	BRW	30$			;EXIT.
;
;
;ALL.
;
310$:
	MOVB	#0,2(R7)		;ALL IS '0'.
	MOVB	#0,3(R7)		;ALWAYS '0'.
	MOVB	#0,MTPOOLRECMOD		;FOR NEXT STATE.
	BRW	350$			;REJOIN.
;
;
;END.
;
320$:
	MOVB	#2,2(R7)		;END IS '2'.
	MOVB	#0,3(R7)		;ALWAYS '0'.
	MOVB	#0,MTPOOLRECMOD		;FOR NEXT STATE.
	BRW	350$			;REJOIN.
;
;REJOIN.
;
350$:
	CMPL	OF_POOL_BUFLEN(R10),OF_POOL_CURBYT(R10)	;VAX BUFFER SHOULD BE EXHAUSTED.
	M_IF_EQL	351$		;BRANCH IF EXHAUSTED.
	M_MESS	<VAX buffer not exhausted /!UL/ /!UL/>,-
		<OF_POOL_BUFLEN(R10),OF_POOL_CURBYT(R10)>
	BRW	30$			;EXIT.
351$:
500$:
;
;LAST VAX BUFFER??
;
	BITL	#B_EOF,OF_POOL_FLG(R10)	;EOF??
	M_IF_EQL	352$		;BRANCH IF NOT EOF.
;
;LAST VAX BUFFER, SO FLUSH LAST MT BUFFER.
;
	BISL	#B_EOF,OF_POOL_FLG(R11)	;INDICATE LAST MT BUFFER.
	BRW	50$			;GO WRITE IT.
;
;NOT EOF.
;
352$:
;
;VAX BUFFER EXHAUSTED, SO RETURN.
;
	BRW	20$			;BYE.
;
;
;VAX BUFFER LARGER THAN MT BUFFER.
;
200$:
	MOVL	R7,MTPOOLRECLEN		;WRITE WHAT CAN FIT INTO MT BUFFER.
	MOVL	RECORDDESCPTR,R7	;UPDATE RECORD DESC.
	ADDL	#4,MTPOOLRECLEN		;RECORD DESC LENGTH INCLUDES ITSELF.
	MOVB	MTPOOLRECLEN,1(R7)	;SWAP BYTES.
	MOVB	MTPOOLRECLEN+1,(R7)	;
	SUBL	#4,MTPOOLRECLEN		;ACTUAL MT RECORD LENGTH.
	MOVL	MTPOOLRECLEN,R0		;LENGTH OF TRANSLATION.
	MOVL	R8,R1			;VAX BUFFER ADDRESS.
	MOVAL	ASCEBCTBL,R3		;ASCII TO EBCDIC TRANSLATION TABLE.
	MOVL	R0,R4			;OUTPUT IN MT BUFFER.
	MOVL	R9,R5			;
	JSB	MOVETRANSLATE		;GO TRNASLATE.
	TSTL	R6			;ANY ERRORS.
;
;CONTINUE EVEN IF ERROR.
;
	ADDL	MTPOOLRECLEN,OF_POOL_CURBYT(R11) ;UPDATE MT CURRENT BYTE.
	ADDL	MTPOOLRECLEN,OF_POOL_BUFLEN(R11) ;UPDATE MT BUFFER SIZE.
	ADDL	MTPOOLRECLEN,R9		;UPDATE MT BUFFER POSITION.
	ADDL	MTPOOLRECLEN,OF_POOL_CURBYT(R10) ;UPDATE VAX CURRENT BYTE.
	ADDL	MTPOOLRECLEN,R8		;UPDATE VAX BUFFER POSITION.
	CASEB	MTPOOLRECMOD,#0,#1	;UPDATE RECORD MODE DEPENDING:
400$:
	.WORD	410$-400$		;FIRST.
	.WORD	420$-400$		;MIDDLE.
;
	M_MESS	<MT pool record mode /!UB/ out of range>,<MTPOOLRECMOD>
	BRW	30$			;EXIT.
;
;
;FIRST.
;
410$:
	MOVB	#1,2(R7)		;FIRST IS '1'.
	MOVB	#0,3(R7)		;ALWAYS '0'.
	MOVB	#1,MTPOOLRECMOD		;FOR NEXT STATE.
	BRW	450$			;REJOIN.
;
;
;MIDDLE.
;
420$:
	MOVB	#3,2(R7)		;MIDDLE IS '3'.
	MOVB	#0,3(R7)		;ALWAYS '0'.
	MOVB	#1,MTPOOLRECMOD		;FOR NEXT STATE.
	BRW	450$			;REJOIN.
;
;REJOIN.
;
450$:
	CMPL	BLOLEN,OF_POOL_BUFLEN(R11)	;MUST WRITE MAXIMUM MT BLOCK SIZE.
	M_IF_EQL	451$		;BRANCH IF MAXIMUM.
;
	M_MESS	<Magtape block not completely filled>,-
		<BLOLEN,OF_POOL_BUFLEN(R11)>
	BRW	30$			;EXIT.
451$:
	BRW	50$			;MT BUFFER FULL, SO WRITE IT.
;
;
;WRITE MT BUFFER AND GET NEXT MT BUFFER.
;
50$:
	MOVL	BLOCKDESCPTR,R7		;UPDATE BLOCK DESC.
	MOVB	OF_POOL_BUFLEN(R11),1(R7)	;SWAP BYTES.
	MOVB	OF_POOL_BUFLEN+1(R11),(R7)	;
	MOVW	#0,2(R7)		;ALWAYS '00'.
	CMPL	BLOLEN,OF_POOL_BUFLEN(R11)	;CAN NOT WRITE MORE THAN MAX.
	M_IF_GEQ	51$		;BRANCH IF NOT MORE THAN MAX.
;
	M_MESS	<MT buffer larger than maximum block size /!UB/ /!UB/>,-
		<OF_POOL_BUFLEN(R11),BLOLEN>
	BRW	30$			;EXIT.
;
51$:
	BISL	#B_GOOD,OF_POOL_FLG(R11)	;INDICATE GOOD MT BUFFER.
	JSB	MTWRITE			;GO WRITE IT.
	M_IF_CS	30$			;EXIT IF ERROR.
;
;LAST VAX BUFFER??
;
	BITL	#B_EOF,OF_POOL_FLG(R10)	;LAST VAX BUFFER??
	M_IF_NEQ	20$		;RETURN IF EOF.
;
;GET NEXT MT BUFFER.
;
	MOVL	#MAXMTPOOLBYTE,R3	;NUMBER OF BYTES IN MT TABLE ENTRY.
	ADDL	R3,R11			;POINT TO NEXT MT ENTRY.
	CMPL	R11,MTPOOLENDPTR	;END OF TABLE??
	M_IF_NEQ	52$		;BRANCH IF NOT END OF MT TABLE.
	MOVL	#MTPOOLBEG,R11		;WRAP AROUND.
52$:
	MOVL	R11,MTPOOLWKPTR		;UPDATE CURRENT MT WORK POINTER.
	BRW	1$			;CHECK IF IT IS BAD.
20$:
	BICPSW	#1			;CLEAR C-BIT.
	BRB	40$			;RETURN.
30$:
	$SETAST_S	ENBFLG=#1	;ENABLE AST JUST IN CASE.
	M_ON0ERR	,<SYSONLY>	;TELL USER IF ERROR.
	BISPSW	#1			;SET C-BIT.
40$:
;;;;	JSB	J_RESREG		;RESTORE R0-R11.
	MOVL	(SP)+,R11		;RESTORE R11.
	RSB				;BYE.
.PAGE
.SUBTITLE	MAGTAPE WRITE ROUTINE
;
;MAGTAPE WRITE ROUTINE.
;
;
MTWRITE:				;MAGTAPE WRITE ROUTINE.
;;;;	JSB	J_SAVREG		;SAVE R0-R11.
	MOVL	R10,-(SP)		;SAVE R10.
	MOVL	R11,-(SP)		;SAVE R11.
	BITL	#X_AST,XTLLONG		;CALLED FROM AST??
	M_IF_NEQ	10$		;BRANCH IF CALLED FROM AST.
	$SETAST_S	ENBFLG=#0	;DISABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
10$:
	BITL	#X_MTINPROG,XTLLONG	;MAGTAPE IN PROGRESS??
	M_IF_NEQ	21$		;IF IN PROGRESS , JUST RETURN.
	MOVL	MTPOOLPTR,R11		;CURRENT MT POINTER.
	BITL	#B_GOOD,OF_POOL_FLG(R11)	;MAKE SURE IT'S A GOOD BUFFER.
	M_IF_NEQ	1$		;BRANCH IF GOOD BUFFER.
;
	M_MESS	<Trying to write a bad MT buffer>
	BRW	30$			;EXIT.
;
1$:
	BISL	#X_MTINPROG,XTLLONG	;INDICATE MT IN PROGRESS.
	BITL	#X_AST,XTLLONG		;CALLED FROM AST??
	M_IF_NEQ	11$		;BRANCH IF CALLED FROM AST.
	$SETAST_S	ENBFLG=#1	;ENABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
11$:
;
;WRITE MT BUFFER.
;
	$QIO_S	-			;WRITE MT BUFFER.
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_WRITEVBLK,-	;
		IOSB=MTIOSB,-		;
		ASTADR=MTWRITEAST,-	;
		P1=@OF_POOL_BUF(R11),-	;
		P2=OF_POOL_BUFLEN(R11)	;
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	BRW	20$			;RETURN.
21$:
	BITL	#X_AST,XTLLONG		;CALLED FROM AST??
	M_IF_NEQ	12$		;BRANCH IF CALLED FROM AST.
	$SETAST_S	ENBFLG=#1	;ENABLE AST JUST IN CASE.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
12$:
20$:
	BICPSW	#1			;CLEAR C-BIT.
	BRB	40$			;RETURN.
30$:
	BITL	#X_AST,XTLLONG		;CALLED FROM AST??
	M_IF_NEQ	13$		;BRANCH IF CALLED FROM AST.
	$SETAST_S	ENBFLG=#1	;ENABLE AST JUST IN CASE.
	M_ON0ERR	,<SYSONLY>	;TELL USER IF ERROR.
13$:
	BISPSW	#1			;SET C-BIT.
40$:
;;;;	JSB	J_RESREG		;RESTORE R0-R11.
	MOVL	(SP)+,R11		;RESTORE R11.
	MOVL	(SP)+,R10		;RESTORE R10.
	RSB				;BYE.
.PAGE
.SUBTITLE	MAGTAPE WRITE AST ROUTINE
;
;MAGTAPE WRITE AST ROUTINE.
;
	.ENTRY	MTWRITEAST	^M<R10,R11>
	BISL	#X_AST,XTLLONG		;INDICATE IN AST.
	BITL	#X_MTSUSPEND,XTLLONG	;TASK ASLEEP DUE TO MT??
	M_IF_EQL	1$		;BRANCH IF NOT ASLEEP DUE MT.
	BICL	#X_MTSUSPEND,XTLLONG	;CLEAR ASLEEP FLAG FOR NEXT TIME.
	.IF	DF	DEBUG
	M_MESS	<Task asleep.  MTWRITE ast wakes it up.>
	.ENDC
	$WAKE_S				;GO WAKE UP.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
1$:
	MOVL	MTPOOLPTR,R11		;CURRENT MT POINTER.
	.IF	DF	DEBUG
	M_MESS	<MTPOOLPTR=!XL>,<R11>
	.ENDC
	BICL	#X_MTINPROG,XTLLONG	;MT NOT IN PROGRESS.
	CMPW	#SS$_ENDOFTAPE,MTIOSB	;END OF TAPE??
	M_IF_NEQ	2$		;BRANCH IF NOT END OF TAPE.
	BITL	#B_EOF,OF_POOL_FLG(R11)	;LAST MT BUFFER??
	M_IF_NEQ	3$		;IF EOF THEN EOF TAKES PRECEDENCE OVER EOT.
	BISL	#X_ENDOFTAPE,XTLLONG	;INDICATE EOT DETECTED.
	BRW	3$			;EOT IS OKAY.
2$:
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
3$:
	INCL	BLOCNTACCUM		;INCREMENT BLOCK COUNT ACCUM.
	BICL	#B_GOOD,OF_POOL_FLG(R11)	;CLEAR GOOD FLAG.
	CLRL	OF_POOL_BUFLEN(R11)	;INIT MT BUFFER LENGTH.
	CLRL	OF_POOL_CURBYT(R11)	;INIT MT CURRENT BYTE.
;
;GET NEXT MT POINTER.
;
	MOVL	#MAXMTPOOLBYTE,R10	;#OF BYTES IN ENTRY.
	ADDL	R10,R11			;POINT TO NEXT ENTRY.
	CMPL	R11,MTPOOLENDPTR	;END OF TABLE??
	M_IF_NEQ	4$		;BRANCH IF NOT END OF TABLE.
	MOVL	#MTPOOLBEG,R11		;WRAP AROUND.
4$:
	MOVL	R11,MTPOOLPTR		;UPDATE MT POINTER.
	BITL	#X_ENDOFTAPE,XTLLONG	;END OF TAPE DETECTED??
	M_IF_NEQ	5$		;DON'T START ANOTHER WRITE IF EOT.
	BITL	#B_GOOD,OF_POOL_FLG(R11)	;A GOOD BUFFER??
	M_IF_EQL	5$		;BRANCH IF NOT GOOD BUFFER.
;
;GOOD MT BUFFER, SO WRITE IT.
;
	JSB	MTWRITE			;WRITE MT BUFFER.
	M_IF_CS	30$			;EXIT IF ERROR.
5$:
20$:
	BRB	40$			;RETURN.
30$:
	BISL	#X_ERROR,XTLLONG	;INDICATE AST ERROR.
40$:
	BICL	#X_AST,XTLLONG		;INDICATE OUT OF AST.
	RET				;BYE.
.PAGE
.SUBTITLE	VAX READ AST ROUTINE
;
;VAX READ AST ROUTINE.
;
;
	.ENTRY	VAXREADAST	^M<R10,R11>
	BISL	#X_AST,XTLLONG		;INDICATE IN AST.
	BITL	#X_VAXSUSPEND,XTLLONG	;SUPENDED DUE TO VAX??
	M_IF_EQL	10$		;BRANCH IF NOT.
	BICL	#X_VAXSUSPEND,XTLLONG	;CLEAR SUPSPEND FLAG.
	.IF	DF	DEBUG
	M_MESS	<TASK HIBERNATE, GO WAKE UP (VAX)...>
	.ENDC
	$WAKE_S				;WAKE UP TASK.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
10$:
	MOVL	VAXPOOLPTR,R11		;VAX POOL TABLE POINTER.
	.IF	DF	DEBUG
	M_MESS	<VAXPOOLPTR=!XL>,<R11>
	.ENDC
	BICL	#X_VAXINPROG,XTLLONG	;CLEAR VAX IN PROGRESS.
	CMPL	#RMS$_EOF,OLDRAB+RAB$L_STS	;EOF??
	M_IF_EQL	1$		;BRANCH IF EOF.
	M_ONRMSERR	30$,OLDRAB,<SYSONLY>	;EXIT IF ERROR.
3$:
	BISL	#B_GOOD,OF_POOL_FLG(R11)	;INDICATE VAX BUF GOOD.
	MOVZWL	OLDRAB+RAB$W_RSZ,OF_POOL_BUFLEN(R11)	;ACTUAL LENGTH OF BUFFER.
	BNEQ	31$			; If not zero, OK		;JGD4
	MOVL	#1,OF_POOL_BUFLEN(R11)	; Force length to 1 byte	;JGD4
	MOVB	#SPACE,@OF_POOL_BUF(R11); Insert a space		;JGD4
31$:					;				;JGD4
	CLRL	OF_POOL_CURBYT(R11)	;CURRENT BYTE IS ZERO.
	MOVL	#MAXVAXPOOLBYTE,R10	;NUMBER OF BYTES IN ENTRY.
	ADDL	R10,R11			;POINT TO NEXT ENTRY.
	CMPL	R11,VAXPOOLENDPTR		;END OF VAX POOL TABLE??
	M_IF_NEQ	4$		;BRANCH IF NOT.
	MOVL	#VAXPOOLBEG,R11		;WRAP AROUND.
4$:
	MOVL	R11,VAXPOOLPTR		;UPDATE VAX POOL TABLE POINTER.
;;	BITL	#B_GOOD,OF_POOL_FLG(R11)	;A GOOD BUFFER??
;;	M_IF_EQL	5$		;BRANCH IF NOT GOOD.
	BISL	#X_VAXREQ,XTLLONG		;VAX NEEDS TO WAIT.
	.IF	DF	DEBUG
	M_MESS	<NO FREE BUFFER,VAX HAS TO WAIT...>
	.ENDC
	BRW	20$			;RETURN.
5$:
	JSB	VAXREAD			;DO ANOTHER READ.
	M_IF_CS	30$			;EXIT IF ERROR.
	BRW	20$			;RETURN.
;
;EOF.
;
1$:
	BISL	#B_GOOD,OF_POOL_FLG(R11)	;INDICATE EOF.
	BISL	#B_EOF,OF_POOL_FLG(R11)	;
	CLRL	OF_POOL_BUFLEN(R11)	;NO BYTES.
	CLRL	OF_POOL_CURBYT(R11)	;CURRENT BYTE IS ZERO.
	BRW	20$			;DON'T INITIATE ANOTHER READ.
;
;
;
20$:
	BRB	40$			;RETURN.
30$:
	BISL	#X_ERROR,XTLLONG	;INDICATE ERROR.
40$:
	BICL	#X_AST,XTLLONG		;INDICATE OUT OF AST.
	RET				;
.PAGE
.SUBTITLE	TRANSFER MODE ACTION ROUTINE
;
;
;TRANSFER MODE ACTION ROUTINE.
;
;ACTION ROUTINE TO PROMPT FOR TRANSFER MODE WHEN FIRST TAPE.
;
;IF FIRST TAPE.
;
;	1.	PROMPT FOR TRANSFER MODE:
;		THE TRANSFER MODE IS CHOSEN BY A NUMERIC INPUT:
;			0	=	IBM TO VAX (DEFAULT).
;			1	=	VAX TO IBM.
;			^Z	=	EXIT AVATU.
;		THE INPUT IS CONVERTED TO A BINARY NUMBER AND STORED IN TFRMOD BYTE.
;
;
;
;IF SECOND OR SUBSEQUENT TAPE.
;
;	1.	RETURN.
;
;
AC_TFRMOD:				;TRANSFER MODE ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST TAPE, THEN BRANCH.
1$:
	CLRB	TFRMOD			;CLEAR TRANSFER MODE INDICATER.
	M_GTINP	<Enter tranfer mode (0=IBM to VAX, 1=VAX to IBM, ^Z=EXIT) [0]: >
	CMPL	#RMS$_EOF,R0		;EOF??			;JGD4
	M_IF_EQL	45$		;BRANCH IF ^Z		;JGD4
	M_ON0ERR	30$		;BRANCH ON ERROR.
	MOVL	L_INPDESC,TPARSE_PAR+TPA$L_STRINGCNT	;SET INPUT SIZE.
	MOVL	L_INPDESC+4,TPARSE_PAR+TPA$L_STRINGPTR	;SET INPUT ADDRESS.
	PUSHAL	T_AVATUKTB		;KEY TABLE ADDRESS.
	PUSHAL	T_TFRMOD		;STARTING STATE.
	PUSHAL	TPARSE_PAR		;TPARSE PARAMETER BLOCK.
	CALLS	#3,G^LIB$TPARSE		;PARSE LINE.
	M_ONTPAERR	1$,TPARSE_PAR,<SYSONLY>	;TELL USER IF ERROR AND TRY AGAIN.
	TSTL	L_INPDESC		;ANY INPUT??
	M_IF_EQL	100$		;IF NO INPUT, THEN USE DEFAULT.
	MOVB	TL_CHAR,TFRMOD		;MOVE NUMERIC DIGIT TO BUFFER.
	SUBB	#^A/0/,TFRMOD		;MAKE IT BINARY.
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
45$:	CLRL	R0		; make exit status ok
	BITL	#X_MTALOC,XTLLONG	;MT ALLOCATED AND ASSIGNED??
	M_IF_EQL	46$		;BRANCH IF NOT.
	$QIOW_S	-
		CHAN=MTCHANNEL,-
		FUNC=#IO$_REWIND!IO$M_NOWAIT,-
		IOSB=MTIOSB
	M_ON0ERR	,<SYSONLY>
	M_ONIOSERR	,MTIOSB,<SYSONLY>
46$:
	$EXIT_S				;EXIT.
.PAGE
.SUBTITLE	VOL1 LABEL ACTION ROUTINE
;
;
;VOL1 LABEL ACTION ROUTINE.
;
;THIS ROUTINE EXPECTS THE MAPTAPE TO BE POSITION AT A VOL1 LABEL.
;
;
;IF TRANSFER IS FROM IBM TO VAX THEN:
;
;	IF FIRST VOL1 LABEL (FIRST TAPE):
;
;		1.	PROMPT FOR MAGTAPE UNIT.
;		2.	ASSIGN CHANNEL TO MAGTAPE.
;		3.	ALLOCATE MAGTAPE UNIT.
;		4.	READ IN VOL1 LABEL.
;		5.	TRANSLATE EBCDIC LABEL BUFFER TO ITS ASSOCIATED
;			ASCII LABEL BUFFER.
;		5A.	CLEAR VOLUME SEQUENCE NUMBER.
;		5B.	CLEAR DATASET SEQUENCE NUMBER.
;		6.	SET CURASCIIPTR.
;		7.	CLEAR END OF TAPE FLAG.
;
;	IF SECOND OR SUBSEQUENT VOL1 LABEL (MULTIVOLUME).
;
;		1.	READ IN A VOL1 LABEL INTO EBCDIC BUFFER FROM MAGTAPE (VOL1 LABEL).
;		2.	TRANSLATE EBCDIC BUFFER TO ASSOCIATED ASCII 2 BUFFER.
;		3.	SET CURASCIIPTR.
;		4.	CLEAR END OF TAPE FLAG.
;
;
;IF TRANSFER IS FROM VAX TO IBM:
;
;	IF FIRST VOLUME:
;
;		3.	PROMPT FOR MAGTAPE UNIT.
;		4.	ASSIGN A CHANNEL TO MAGTAPE.
;		5.	ALLOCATE MAGTAPE.
;		50.	PROMPT FOR CREATE LABEL OR NOT.
;		51.	IF NOT CREATE LABEL THEN DO BELOW.
;		5A.	READ IN FIRST BLOCK FROM MAGTAPE TO EBCDIC BUFFER (VOL1).
;		5B.	TRANSLATE EBCDIC TO ASCII.
;		5BA.	DO BELOW EVEN IF CREATE LABEL.
;		5C.	CLEAR VOLUME SEQUENCE NUMBER.
;		5D.	CLEAR DATASET SEQUENCE NUMBER.
;		6.	SET CURASCIIPTR.
;		7.	CLEAR END OF TAPE FLAG.
;
;	IF NOT FIRST VOLUME:
;
;		1.	IF NOT CREATE LABEL THEN:
;			1.	READ IN VOL1 LABEL INTO EBCDIC BUFFER FROM
;				MAGTAPE.
;			2.	TRANSLATE EBCDIC TO ASCII IN ASCII 2 BUFFER.
;			3.	SET CURASCIIPTR.
;			4.	CLEAR END OF TAPE FLAG.
;		2.	IF CREATE LABEL:
;			1.	MOVE ASSOCIATED ASCII BUFFER TO ASCII 2 BUFFER.
;			2.	SET CURASCIIPTR.
;			3.	CLEAR END OF TAPE FLAG.
;
;
;
AC_VOL1:				;VOL1 LABEL ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	.IF	DF	DEBUG
	M_MESS	<AC_VOL1>
	.ENDC
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE ADDRESS.
	MOVL	OF_LBLTBL_EBC(R8),R9	;EBCDIC BUFFER.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST TAPE, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	MOVB	#^A/0/,MTUNIT		;MOVE IN DEFAULT UNIT NUMBER.
	M_GTINP	<Enter magtape unit number [0]: >	;PROMPT USER.
	M_ON0ERR	30$		;BRANCH ON ERROR. SET C-BIT.
	MOVL	L_INPDESC,TPARSE_PAR+TPA$L_STRINGCNT	;SET INPUT SIZE.
	MOVL	L_INPDESC+4,TPARSE_PAR+TPA$L_STRINGPTR	;SET INPUT ADDRESS.
	PUSHAL	T_AVATUKTB		;KEY TABLE.
	PUSHAL	T_MTUNIT		;STARTING STATE.
	PUSHAL	TPARSE_PAR		;TPARSE PARAMETER BLOCK.
	CALLS	#3,G^LIB$TPARSE		;PARSE INPUT LINE.
	M_ONTPAERR	100$,TPARSE_PAR,<SYSONLY>	;TRY AGAIN IF ERROR.
	TSTL	L_INPDESC		;ANY INPUT??
	M_IF_EQL	101$		;BRANCH IF NO INPUT, USE DEFAULT.
	MOVB	TL_CHAR,MTUNIT		;MOVE IN USER INPUT UNIT NUMBER.
101$:
;	$ALLOC_S	DEVNAM=MTNAMEDESC	;ALLOCATE DEVICE.	;jgd6
;	M_ON0ERR  100$,<Device /!AF/ not allocated>,<MTNAMEDESC,MTNAMEDESC+4>;jgd6
	$ASSIGN_S	-			;ASSIGN MAGTAPE CHANNEL.
			DEVNAM=MTNAMEDESC,-	;DEVICE NAME DSD.
			CHAN=MTCHANNEL		;CHANNEL WORD.
	M_ON0ERR	30$,<SYSONLY>		;EXIT IF ERROR.
	$GETCHN_S	-		;GET DEVICE INFO.
		CHAN=MTCHANNEL,-	;
		PRIBUF=MTPRIBUFDESC,-	;
		PRILEN=MTPRILENWRD	;
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	BITL	#DEV$M_AVL,MTPRIBUF+DIB$L_DEVCHAR	;DEVICE READY.
	M_IF_NEQ	104$		;BRANCH IF READY.
;
	M_MESS	<Device /!AF/ is not ready>,<MTNAMEDESC,MTNAMEDESC+4>
	BRW	30$			;EXIT.
104$:
	BITL	#DEV$M_FOR,MTPRIBUF+DIB$L_DEVCHAR	;DEVICE MOUNTED FOREIGN??
	M_IF_NEQ	105$		;BRANCH IF MOUNTED FOREIGN.
;
	M_MESS	<Device /!AF/ is not mounted foreign>,-
		<MTNAMEDESC,MTNAMEDESC+4>
	BRW	30$			;EXIT.
105$:
	BISL	#X_MTALOC,XTLLONG	;INDICATE MT ALLOCATED AND ASSIGNED.
	TSTB	VOL1MOD			;CREATE VOL1 LABEL??
	M_IF_NEQ	103$		;BRANCH IF CREATE LABEL.
	$QIOW_S	-			;READ IN VOL1 LABEL.
		CHAN=MTCHANNEL,-	;MAGTAPE CHANNEL.
		FUNC=#IO$_READVBLK,-	;FUNCTION CODE.
		IOSB=MTIOSB,-			;IOSB BLOCK.
		P1=(R9),-		;BUFFER.
		P2=#LH_VOL1LEN			;LENGTH.
	M_ON0ERR	30$,<SYSONLY>		;TELL USER IF ERROR.
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
	MOVZWL	MTIOSB+2,R0		;NUMBER OF BYTES READ IN.
	MOVAL	(R9),R1			;BUFFER ADDRESS.
	MOVAL	EBCASCTBL,R3		;TRANSLATION TABLE ADDRESS.
	MOVL	#LH_VOL1LEN,R4		;EXPECT A CERTAIN NUMBER OF BYTES.
	MOVAL	(R10),R5		;ASCII BUFFER DESTINATION.
	JSB	MOVETRANSLATE		;MOVE TRANSLATE.
	M_IF_NEQ	102$		;BRANCH IF STRINGS ARE NOT SAME LENGTH.
	TSTL	R6			;ANY ERRORS.
	M_IF_GTR	30$		;EXIT IF ERROR.
	BRW	103$			;CONTINUE.
102$:					;STRINGS NOT SAME LENGTH.
	M_MESS	<VOL1 label not standard length /!XW/>,<MTIOSB+2> ;TELL USER WRONG LENGTH.
	BRW	30$			;BAD.
103$:
	CLRL	VOLSEQ			;CLEAR VOLUME SEQUENCE NUMBER.
	CLRL	DSSEQ			;CLEAR DATASET SEQUENCE NUMBER.
	MOVAL	(R10),CURASCIIPTR	;SET POINTER TO ASCII LABEL BUFFER.
	BICL	#X_ENDOFTAPE,XTLLONG	;NOT END OF TAPE.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	M_GTINP	<Create VOL1 label (YES,NO) [NO]: >	;PROMPT USER.
	M_ON0ERR	30$		;EXIT IF ERROR.
	MOVL	L_INPDESC,TPARSE_PAR+TPA$L_STRINGCNT ;SET INPUT SIZE.
	MOVL	L_INPDESC+4,TPARSE_PAR+TPA$L_STRINGPTR ;SET INPUT ADDRESS.
	PUSHAL	T_AVATUKTB		;KEYTABLE.
	PUSHAL	T_NOYES			;STARTING STATE.
	PUSHAL	TPARSE_PAR		;TPARSE PARMETER BLOCK.
	CALLS	#3,G^LIB$TPARSE		;PARSE LINE.
	M_ONTPAERR	200$,TPARSE_PAR,<SYSONLY>	;TRY AGAIN IF ERROR.
	CLRB	VOL1MOD			;ASSUME NOT CREATE LABEL.
	TSTL	TL_NUMBER		;NO??
	BEQL	201$			;BRANCH IF INPUT IS NO.
	MOVB	#1,VOL1MOD		;INDICATE CREATE LABEL.
201$:
	BRW	100$		;GET MAGTAPE UNIT.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	$QIOW_S	-			;READ IN VOL1 LABEL.
		CHAN=MTCHANNEL,-	;MAGTAPE CHANNEL.
		FUNC=#IO$_READVBLK,-	;FUNCTION CODE.
		IOSB=MTIOSB,-		;IOSB BLOCK.
		P1=(R9),-			;BUFFER.
		P2=#LH_VOL1LEN			;LENGTH.
	M_ON0ERR	30$,<SYSONLY>		;TELL USER IF ERROR.
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
	MOVZWL	MTIOSB+2,R0		;NUMBER OF BYTES READ IN.
	MOVAL	(R9),R1			;BUFFER ADDRESS.
	MOVAL	EBCASCTBL,R3		;TRANSLATION TABLE ADDRESS.
	MOVL	#LH_VOL1LEN,R4		;EXPECT A CERTAIN NUMBER OF BYTES.
	MOVAL	(R11),R5		;ASCII 2 BUFFER DESTINATION.
	JSB	MOVETRANSLATE		;MOVE TRANSLATE.
	M_IF_NEQ	1102$		;BRANCH IF STRINGS ARE NOT SAME LENGTH.
	TSTL	R6			;ANY ERRORS.
	M_IF_GTR	30$		;EXIT IF ERROR.
	BRW	1103$			;CONTINUE.
1102$:					;STRINGS NOT SAME LENGTH.
	M_MESS	<VOL1 label not standard length /!XW/>,<MTIOSB+2> ;TELL USER WRONG LENGTH.
	BRW	30$			;BAD.
1103$:
	MOVAL	(R10),CURASCIIPTR	;SET POINTER TO ASCII LABEL BUFFER.
	BICL	#X_ENDOFTAPE,XTLLONG	;CLEAR EOT FLAG.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	TSTB	VOL1MOD			;CREATE LABEL??
	M_IF_NEQ	1201$		;BRANCH IF CREATE LABEL.
	BRW	1100$			;GO TO OTHER SECTION.
1201$:
	MOVC3	#LH_VOL1LEN,(R10),(R11)	;MOVE ASCII BUFFER TO ASCII 2 BUFFER.
	MOVAL	(R10),CURASCIIPTR	;SET CURRENT ASCII POINTER.
	BICL	#X_ENDOFTAPE,XTLLONG	;CLEAR EOT FLAG.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	VOL1 END ACTION ROUTINE
;
;
;VOL1 END ACTION ROUTINE.
;
;IF TRANSFER IS FROM IBM TO VAX:
;
;	IF FIRST VOLUME:
;
;
;	IF SECOND VOLUME:
;
;
;IF TRANSFER IS FROM VAX TO IBM:
;
;	IF FIRST VOLUME:
;
;		1.	IF CREATE LABEL:
;
;			1.	TRANSLATE ASCII BUFFER TO EBCDIC BUFFER.
;			2.	WRITE EBCDIC BUFFER.
;
;
;	IF SECOND VOLUME:
;
;		1.	IF CREATE LABEL:
;
;			1.	TRANSLATE ASCII 2 BUFFER TO EBCDIC BUFFER.
;			2.	WRITE EBCDIC BUFFER.
;
;
;
;
AC_VOL1END:				;VOL1 END ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	.IF	DF	DEBUG
	M_MESS	<AC_VOL1END>
	.ENDC
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE POINTER.
	MOVL	OF_LBLTBL_EBC(R8),R9	;EBCDIC BUFFER.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST TAPE, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	TSTB	VOL1MOD			;CREATE LABEL??
	M_IF_EQL	201$		;BRACNH IF NOT CREATE LABEL.
	MOVL	#LH_VOL1LEN,R0		;TRANSLATE ASCII BUFFER. LENGTH.
	MOVAL	(R10),R1		;ASCII BUFFER.
	MOVAL	ASCEBCTBL,R3		;ASCII TO EBCDIC TRANSLATION TABLE.
	MOVL	#LH_VOL1LEN,R4		;EBCDIC BUFFER LENGTH.
	MOVAL	(R9),R5			;EBCDIC BUFFER.
	JSB	MOVETRANSLATE		;TRANSLATE.
	TSTL	R6			;ANY ERRORS.
	M_IF_GTR	30$		;EXIT IF ERROR.
	$QIOW_S	-
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_WRITEVBLK,-
		IOSB=MTIOSB,-		;
		P1=(R9),-		;
		P2=#LH_VOL1LEN		;
	M_ON0ERR	30$,<SYSONLY>	;
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
201$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	TSTB	VOL1MOD			;CREATE LABEL??
	M_IF_EQL	1201$		;BRANCH IF NOT CREATE LABEL.
	MOVL	#LH_VOL1LEN,R0		;TRANSLATE ASCII 2 TO EBCDIC.
	MOVAL	(R11),R1		;ASCII 2 BUFFER.
	MOVAL	ASCEBCTBL,R3		;EBCDIC TO ASCII TRANSLATE TABLE.
	MOVL	#LH_VOL1LEN,R4		;LENGTH.
	MOVAL	(R9),R5			;EBCDIC BUFFER.
	JSB	MOVETRANSLATE		;TRANSLATE.
	TSTL	R6			;ANY ERRORS.
	M_IF_GTR	30$		;EXIT IF ERROR.
	$QIOW_S	-			;WRITE VOL1 LABEL.
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_WRITEVBLK,-	;
		IOSB=MTIOSB,-		;
		P1=(R9),-		;
		P2=#LH_VOL1LEN		;
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
1201$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	DSL1 LABEL ACTION ROUTINE
;
;
;DSL1 LABEL ACTION ROUTINE.
;
;
;1.	FIND OUT WHAT KIND OF DSL1 LABEL AND POINT TO ASSOCIATED
;	BUFFERS. USING R9,R10,R11.
;
;		R9	=	EBCDIC BUFFER ADDRESS.
;		R10	=	ASCII BUFFER ADDRESS.
;		R11	=	ASCII 2 BUFFER ADDRESS.
;
;
;IF TRANSFER IS FROM IBM TO VAX:
;
;	IF FIRST TAPE:
;
;		2.	READ IN LOGICAL BLOCK FROM MAGTAPE TO ASSOCIATED EBCDIC BUFFER.
;		3.	TRANSLATE EBCDIC TO ASCII.
;		4.	SET CURASCIIPTR.
;		NOTE: IF EOF IS DETECTED IN THE READ, AND IT IS HDR1, THEN EOV.
;
;	IF SECOND TAPE:
;
;		1.	READ IN LOGICAL BLOCK FROM MAGTAPE TO ASSOCIATED EBCDIC
;			BUFFER.
;		2.	TRANSLATE TO ITS ASSOCIATED ASCII 2 BUFFER.
;		3.	SET CURASCIIPTR.
;
;
;IF TRANSFER FROM VAX TO IBM.
;
;	IF FIRST TAPE:
;
;		IF HDR1:
;
;			0.	PROMPT,OPEN OLD FILE.
;			0A.	CLEAR OLD EOF FLAG.
;			1.	SET CURASCIIPTR.		
;			NOTE: IF EOF IS DETECTED , THEN AN EOF
;			WILL BE WRITTEN TO TAPE TO INDICATE EOV AND EXIT.
;
;		IF OTHER
;
;			1.	SET CURASCIIPTR.
;
;	IF SECOND TAPE:
;
;		1.	MOVE ASSOCIATED ASCII BUFFER TO ASCII 2 BUFFER.
;		2.	SET CURASCIIPTR.
;
;
AC_DSL1:				;DSL1 LABEL ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	.IF	DF	DEBUG
	M_MESS	<AC_DSL1>
	.ENDC
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE POINTER.
	MOVL	OF_LBLTBL_EBC(R8),R9	;EBCDIC BUFFER.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST VOLUME, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	$QIOW_S	-			;READ IN DSL1 LABEL.
		CHAN=MTCHANNEL,-	;MAGTAPE CHANNEL.
		FUNC=#IO$_READVBLK,-	;FUNCTION CODE.
		IOSB=MTIOSB,-			;IOSB BLOCK.
		P1=(R9),-		;BUFFER.
		P2=#LH_DSL1LEN			;LENGTH.
	M_ON0ERR	30$,<SYSONLY>		;TELL USER IF ERROR.
	CMPW	#SS$_ENDOFTAPE,MTIOSB		;END OF TAPE IS OKAY.
	M_IF_NEQ	101$		;BRANCH IF NOT EOT.
	BISL	#X_ENDOFTAPE,XTLLONG	;INDICATE EOT DETECTED.
	BRW	103$			;EOT IS OKAY.
101$:
	CMPW	#SS$_ENDOFFILE,MTIOSB	;EOF??
	M_IF_NEQ	104$		;BRANCH IF NOT EOF.
	CMPL	#LBL_HDR1,LBLTBL_PTR	;HDR1??
	M_IF_NEQ	104$		;BRANCH IF NOT HDR1.
	TSTL	DSSEQ			;ANY DATA SET SO FAR.
	M_IF_EQL	104$		;BRANCH IF NO DATA SET YET.
	M_MESS	<End of volume detected>
	BRW	30$			;THAT'S ALL.
104$:
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
103$:
	MOVZWL	MTIOSB+2,R0		;NUMBER OF BYTES READ IN.
	MOVAL	(R9),R1			;BUFFER ADDRESS.
	MOVAL	EBCASCTBL,R3		;TRANSLATION TABLE ADDRESS.
	MOVL	#LH_DSL1LEN,R4		;EXPECT A CERTAIN NUMBER OF BYTES.
	MOVAL	(R10),R5		;ASCII BUFFER DESTINATION.
	JSB	MOVETRANSLATE		;MOVE TRANSLATE.
	M_IF_CS	30$			;EXIT IF ERROR.
	M_IF_EQL	102$		;BRANCH IF STRINGS ARE SAME LENGTH.
	M_MESS	<DSL1 label not standard length /!XW/>,<MTIOSB+2> ;TELL USER WRONG LENGTH.
	BRW	30$			;BAD.
102$:
	MOVAL	(R10),CURASCIIPTR	;SET POINTER TO ASCII LABEL BUFFER.
	BRW	20$			;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	CMPL	#LBL_HDR1,LBLTBL_PTR		;HDR1??
	M_IF_NEQ	203$			;BRANCH IF NOT HDR1.
	M_GTINP	<Enter VAX input filename [SYS$DISK:VAX.DAT]: >	;PROMPT USER.
	CMPL	#RMS$_EOF,R0			;EOF??
	M_IF_NEQ	202$			;BRANCH IF NOT EOF.
	CMPL	#LBL_HDR1,LBLTBL_PTR	;HDR1??
	M_IF_NEQ	202$		;BRANCH IF NOT HDR1.
	TSTL	DSSEQ			;ANY DATASET WRITTEN??
	M_IF_EQL	202$		;BRANCH IF NO DATA SET.
;
;EOV.
;
	$QIOW_S -			;WRITE EOF.
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_WRITEOF,-	;
		IOSB=MTIOSB		;
	M_ON0ERR	30$,<SYSONLY>	;TELL USER IF ERROR.
	CMPW	#SS$_ENDOFTAPE,MTIOSB	;EOT IS OKAY.
	M_IF_EQL	30$		;
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;TELL USER IF ERROR.
	BRW	30$			;THAT'S ALL.
;
;
202$:
	M_ON0ERR	30$		;EXIT IF ERROR.
	MOVL	L_INPDESC,TPARSE_PAR+TPA$L_STRINGCNT	;SET INPUT STRING SIZE.
	MOVL	L_INPDESC+4,TPARSE_PAR+TPA$L_STRINGPTR	;SET INPUT STRING ADDRESS.
	PUSHAL	T_AVATUKTB		;KEYTABLE.
	PUSHAL	T_FILSPC		;STARTING STATE.
	PUSHAL	TPARSE_PAR		;TPARSE PARAMETER BLOCK.
	CALLS	#3,G^LIB$TPARSE		;PARSE LINE.
	M_ONTPAERR	200$,TPARSE_PAR,<SYSPNLY>	;TRY AGAIN IF ERROR.
	TSTL	L_INPDESC		;ANY INPUT??
	BEQL	201$			;USE DEFAULT IF NOT.
	MOVB	L_INPDESC,OLDFAB+FAB$B_FNS	;SET FILENAME STRING SIZE.
	MOVL	L_INPDESC+4,OLDFAB+FAB$L_FNA	;SET FILENAME STRING ADDRESS.
201$:
	$OPEN	FAB=OLDFAB,-		;OPEN INPUT FILE.
		ERR=J_RMAER		;ERROR COMPLETION ROUTINE.
	M_ON0ERR	200$		;TRY AGAIN IF ERROR.
	BISL	#X_OLDOPN,XTLLONG	;REMEMBER OLD FILE OPENED.
	BICL	#X_OLDEOF,XTLLONG	;CLEAR OLD EOF FLAG.
	MOVAL	(R10),CURASCIIPTR	;SET POINTER TO VOL1 ASCII LABEL.
	BRW	20$			;RETURN. C-BIT CLEARED.
;
;NOT HDR1.
;
203$:
	MOVAL	(R10),CURASCIIPTR	;SET POINTER TO ASCII LABEL.
	BRW	20$			;RETURN.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	$QIOW_S	-			;READ IN VOL1 LABEL.
		CHAN=MTCHANNEL,-	;MAGTAPE CHANNEL.
		FUNC=#IO$_READVBLK,-	;FUNCTION CODE.
		IOSB=MTIOSB,-			;IOSB BLOCK.
		P1=(R9),-		;BUFFER.
		P2=#LH_DSL1LEN			;LENGTH.
	M_ON0ERR	30$,<SYSONLY>		;TELL USER IF ERROR.
	CMPW	#SS$_ENDOFTAPE,MTIOSB		;EOT IS OKAY.
	M_IF_NEQ	1101$		;BRANCH IF NOT EOT.
	BISL	#X_ENDOFTAPE,XTLLONG	;INDICATE EOT DETECTED.
	BRW	1103$			;EOT IS OKAY.
1101$:
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
1103$:
	MOVZWL	MTIOSB+2,R0		;NUMBER OF BYTES READ IN.
	MOVAL	(R9),R1			;BUFFER ADDRESS.
	MOVAL	EBCASCTBL,R3		;TRANSLATION TABLE ADDRESS.
	MOVL	#LH_DSL1LEN,R4		;EXPECT A CERTAIN NUMBER OF BYTES.
	MOVAL	(R11),R5		;ASCII 2 BUFFER DESTINATION.
	JSB	MOVETRANSLATE		;MOVE TRANSLATE.
	M_IF_CS	30$			;EXIT IF ERROR.
	M_IF_EQL	1102$		;BRANCH IF STRINGS ARE SAME LENGTH.
	M_MESS	<DSL1 label not standard length /!XW/>,<MTIOSB+2> ;TELL USER WRONG LENGTH.
	BRW	30$			;BAD.
1102$:
	MOVAL	(R10),CURASCIIPTR	;SET POINTER TO ASCII LABEL BUFFER.
	BRW	20$			;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	MOVC3	#LH_DSL1LEN,(R10),(R11)	;MOVE DSL1 ASCII TO ASCII 2 BUFFER.
	MOVAL	(R10),CURASCIIPTR	;SET POINTER TO ASCII LABEL BUFFER.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	DSL1 END ACTION ROUTINE
;
;
;DSL1 END ACTION ROUTINE.
;
;IF TRANSFER IS FROM IBM TO VAX:
;
;	IF FIRST VOLUME:
;
;		1.	RETURN.
;
;	IF SECOND VOLUME:
;
;		IF HDR1:
;
;			1.RETURN.
;
;		IF OTHER:
;
;			1. ERROR.
;
;IF TRANSFER IS FROM VAX TO IBM:
;
;	IF FIRST VOLUME:
;
;		1.	WRITE DSL1 LABEL EBCDIC.
;
;	IF SECOND VOLUME:
;
;		IF HDR1:
;
;			1.	WRITE DSL1 LABEL (ASCII 2) EBCDIC.
;
;		IF OTHER:
;
;			1.	ERROR.
;
;
;
AC_DSL1END:				;DSL1 END ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE ADDRESS.
	MOVL	OF_LBLTBL_EBC(R8),R9	;EBCDIC BUFFER.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	.IF	DF	DEBUG
	M_MESS	<AC_DSL1END>
	.ENDC
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST VOLUME, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	MOVL	#LH_DSL1LEN,R0		;LENGTH OF ASCII BUFFER.
	MOVAL	(R10),R1		;ASCII BUFFER.
	MOVAL	ASCEBCTBL,R3		;EBC TO ASCII TRANSLATION TABLE.
	MOVL	#LH_DSL1LEN,R4		;LENGTH OF EBCDIC BUFFER.
	MOVAL	(R9),R5			;EBCDIC BUFFER.
	JSB	MOVETRANSLATE		;MOVE AND TRANSLATE.
	TSTL	R6			;ANY ERROR.
	M_IF_GTR	30$		;EXIT IF ERROR.
	$QIOW_S	-			;WRITE DSL1 LABEL.
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_WRITEVBLK,-	;
		IOSB=MTIOSB,-		;
		P1=(R9),-		;EBCDIC BUFFER.
		P2=#LH_DSL1LEN		;LENGTH.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	CMPW	#SS$_ENDOFTAPE,MTIOSB	;EOT??
	M_IF_NEQ	201$		;BRANCH IF NOT EOT.
	BISL	#X_ENDOFTAPE,XTLLONG	;INDICATE EOT DETECTED.
	BRW	202$			;EOT IS OKAY.
201$:
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
202$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	CMPL	#LBL_HDR1,LBLTBL_PTR	;HDR1??
	M_IF_EQL	1101$		;BRANCH IF HDR1.
PCCUR=.
	M_MESS	<Internal error at PC=!XL>,<#PCCUR>
	BRW	30$			;EXIT.
1101$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	CMPL	#LBL_HDR1,LBLTBL_PTR	;HDR1??
	M_IF_EQL	1201$		;BRANCH IF HDR1.
PCCUR=.
	M_MESS	<Internal error at PC=!XL>,<#PCCUR>
	BRW	30$			;EXIT.
1201$:
	MOVL	#LH_DSL1LEN,R0		;LENGTH OF ASCII 2 BUFFER.
	MOVAL	(R11),R1		;ASCII 2 BUFFER.
	MOVAL	ASCEBCTBL,R3		;EBC TO ASCII TRANSLATION TABLE.
	MOVL	#LH_DSL1LEN,R4		;LENGTH OF EBCDIC BUFFER.
	MOVAL	(R9),R5			;EBCDIC BUFFER.
	JSB	MOVETRANSLATE		;MOVE AND TRANSLATE.
	TSTL	R6			;ANY ERROR.
	M_IF_GTR	30$		;EXIT IF ERROR.
	$QIOW_S	-			;WRITE DSL1 LABEL.
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_WRITEVBLK,-	;
		IOSB=MTIOSB,-		;
		P1=(R9),-		;EBCDIC BUFFER.
		P2=#LH_DSL1LEN		;LENGTH.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	CMPW	#SS$_ENDOFTAPE,MTIOSB	;EOT??
	M_IF_NEQ	1202$		;BRANCH IF NOT EOT.
	BISL	#X_ENDOFTAPE,XTLLONG	;INDICATE END OF TAPE DETECTED.
	BRW	1203$			;EOT IS OKAY.
1202$:
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
1203$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	DSL2 LABEL ACTION ROUTINE
;
;
;DSL2 LABEL ACTION ROUTINE.
;
;
;1.	FIND OUT WHAT KIND OF DSL2 LABEL AND POINT TO ASSOCIATED
;	BUFFERS. USING R9,R10,R11.
;
;		R9	=	EBCDIC BUFFER ADDRESS.
;		R10	=	ASCII BUFFER ADDRESS.
;		R11	=	ASCII 2 BUFFER ADDRESS.
;
;
;IF TRANSFER IS FROM IBM TO VAX:
;
;	IF FIRST TAPE:
;
;		2.	READ IN LOGICAL BLOCK FROM MAGTAPE TO ASSOCIATED EBCDIC BUFFER.
;		3.	TRANSLATE EBCDIC TO ASCII.
;		4.	SET CURASCIIPTR.
;
;	IF SECOND TAPE:
;
;		1.	READ IN LOGICAL BLOCK FROM MAGTAPE TO ASSOCIATED EBCDIC
;			BUFFER.
;		2.	TRANSLATE TO ITS ASSOCIATED ASCII 2 BUFFER.
;		3.	SET CURASCIIPTR.
;
;
;IF TRANSFER FROM VAX TO IBM.
;
;	IF FIRST TAPE:
;
;		1.	SET CURASCIIPTR.		
;
;	IF SECOND TAPE:
;
;		1.	MOVE ASSOCIATED ASCII BUFFER TO ASCII 2 BUFFER.
;		2.	SET CURASCIIPTR.
;
AC_DSL2:				;DSL2 LABEL ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	.IF	DF	DEBUG
	M_MESS	<AC_DSL2>
	.ENDC
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE POINTER.
	MOVL	OF_LBLTBL_EBC(R8),R9	;EBCDIC BUFFER.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST VOLUME, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	$QIOW_S	-			;READ IN DSL2 LABEL.
		CHAN=MTCHANNEL,-	;MAGTAPE CHANNEL.
		FUNC=#IO$_READVBLK,-	;FUNCTION CODE.
		IOSB=MTIOSB,-			;IOSB BLOCK.
		P1=(R9),-		;BUFFER.
		P2=#LH_DSL2LEN			;LENGTH.
	M_ON0ERR	30$,<SYSONLY>		;TELL USER IF ERROR.
	CMPW	#SS$_ENDOFTAPE,MTIOSB	;EOT??
	M_IF_NEQ	101$		;BRANCH IF NOT EOT.
	BISL	#X_ENDOFTAPE,XTLLONG	;INDICATE EOT DETECTED.
	BRW	103$			;EOT IS OKAY.
101$:
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
103$:
	MOVZWL	MTIOSB+2,R0		;NUMBER OF BYTES READ IN.
	MOVAL	(R9),R1			;BUFFER ADDRESS.
	MOVAL	EBCASCTBL,R3		;TRANSLATION TABLE ADDRESS.
	MOVL	#LH_DSL2LEN,R4		;EXPECT A CERTAIN NUMBER OF BYTES.
	MOVAL	(R10),R5		;ASCII BUFFER DESTINATION.
	JSB	MOVETRANSLATE		;MOVE TRANSLATE.
	M_IF_CS	30$			;EXIT IF ERROR.
	M_IF_EQL	102$		;BRANCH IF STRINGS ARE SAME LENGTH.
	M_MESS	<DSL2 label not standard length /!XW/>,<MTIOSB+2> ;TELL USER WRONG LENGTH.
	BRW	30$			;BAD.
102$:
	MOVAL	(R10),CURASCIIPTR	;SET POINTER TO ASCII LABEL BUFFER.
	BRW	20$			;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	MOVAL	(R10),CURASCIIPTR	;SET POINTER TO VOL1 ASCII LABEL.
	BRW	20$			;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	$QIOW_S	-			;READ IN VOL1 LABEL.
		CHAN=MTCHANNEL,-	;MAGTAPE CHANNEL.
		FUNC=#IO$_READVBLK,-	;FUNCTION CODE.
		IOSB=MTIOSB,-			;IOSB BLOCK.
		P1=(R9),-		;BUFFER.
		P2=#LH_DSL2LEN			;LENGTH.
	M_ON0ERR	30$,<SYSONLY>		;TELL USER IF ERROR.
	CMPW	#SS$_ENDOFTAPE,MTIOSB		;EOT??
	M_IF_NEQ	1101$		;BRANCH IF NOT EOT.
	BISL	#X_ENDOFTAPE,XTLLONG	;INDICATE EOT DETECTED.
	BRW	1103$			;EOT IS OKAY.
1101$:
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
1103$:
	MOVZWL	MTIOSB+2,R0		;NUMBER OF BYTES READ IN.
	MOVAL	(R9),R1			;BUFFER ADDRESS.
	MOVAL	EBCASCTBL,R3		;TRANSLATION TABLE ADDRESS.
	MOVL	#LH_DSL2LEN,R4		;EXPECT A CERTAIN NUMBER OF BYTES.
	MOVAL	(R11),R5		;ASCII 2 BUFFER DESTINATION.
	JSB	MOVETRANSLATE		;MOVE TRANSLATE.
	M_IF_CS	30$			;EXIT IF ERROR.
	M_IF_EQL	1102$		;BRANCH IF STRINGS ARE SAME LENGTH.
	M_MESS	<DSL2 label not standard length /!XW/>,<MTIOSB+2> ;TELL USER WRONG LENGTH.
	BRW	30$			;BAD.
1102$:
	MOVAL	(R10),CURASCIIPTR	;SET POINTER TO ASCII LABEL BUFFER.
	BRW	20$			;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	MOVC3	#LH_DSL2LEN,(R10),(R11)	;MOVE DSL2 ASCII TO ASCII 2 BUFFER.
	MOVAL	(R10),CURASCIIPTR	;SET POINTER TO ASCII LABEL BUFFER.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	DSL2 END ACTION ROUTINE
;
;
;DSL2 END ACTION ROUTINE.
;
;IF TRANSFER FROM IBM TO VAX:
;
;	IF FIRST VOLUME:
;
;		IF EOF2:
;
;			1.	INCREMENT DATA SET SEQUENCE NUMBER.
;			2.	CLOSE NEW FILE.
;
;		IF HDR2:
;
;			0.	PROMPT FOR INITIAL AND EXTENT ALLOCATION.
;			1.	PROMPT,CREATE,CONNECT NEW FILE.
;			2.	DISPLAY INFO ABOUT TAPE.
;
;		IF EOV2:
;
;			1.	INCREMENT VOLUME SEQUENCE NUMBER.
;			2.	SET NEW VOLUME FLAG.
;			3.	REWIND.
;			4.	PROMPT FOR NEXT VOLUME.
;
;		IF OTHER:
;
;			1.	RETURN.
;
;	IF SECOND VOLUME:
;
;		IF HDR2:
;
;			0.	CLEAR NEW VOLUME FLAG.
;			1.	RETURN.
;
;		IF OTHER:
;
;			1.	ERROR.
;
;	NOTE: ALWAYS ECPECTS AND READS IN EOF MARKER AT END OF ROUTINE.
;
;
;IF TRANSFER FROM VAX TO IBM:
;
;	IF FIRST VOLUME:
;
;		IF EOF2:
;
;			1.	INCREMENT DATA SET SEQUENCE NUMBER.
;			2.	WRITE EBCDIC BUFFER OF ASCII BUFFER.
;			3.	CLOSE OLD FILE.
;
;		IF EOV2:
;
;			1.	REWIND TAPE.
;			2.	WRITE EBCDIC BUFFER OF ASCII BUFFER.
;			3.	SET NEW VOLUME FLAG.
;			4.	INCREMENT VOLUME SEQUENCE NUMBER.
;			5.	PROMPT AND WAIT FOR NEXT TAPE.
;
;		IF OTHER:
;
;			1.	WRITE EBCDIC BUFFER OF ASCII BUFFER.
;
;	IF SECOND VOLUME:
;
;		IF HDR2:
;
;
;			1.	WRITE EBCDIC BUFFER OF ASCII 2 BUFFER.
;			2.	CLEAR NEW VOLUME FLAG.
;
;		IF OTHER:
;
;			1.	ERROR.
;
;	NOTE:	ALWAYS WRITES AN EOF OF FILE MARKER AT END OF ROUTINE.
;
AC_DSL2END:				;DSL2 END ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE ADDRESS.
	MOVL	OF_LBLTBL_EBC(R8),R9	;EBC BUFFER.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	.IF	DF	DEBUG
	M_MESS	<AC_DSL2END>
	.ENDC
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST VOLUME, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	CMPL	#LBL_EOF2,LBLTBL_PTR	;EOF2??
	M_IF_NEQ	101$		;BRANCH IF NOT EOF2.
	INCL	DSSEQ			;INCREMENT DATA SET SEQUENCE NUMBER.
	$DISCONNECT -			;DISCONNECT NEW FILE.
		RAB=NEWRAB,-		;
		ERR=J_RMAER		;
	M_ON0ERR	30$		;EXIT IF ERROR.
	BICL	#X_NEWCON,XTLLONG	;NO LONGER CONNECTED.
	$CLOSE -			;CLOSE NEW FILE.
		FAB=NEWFAB,-		;
		ERR=J_RMAER		;ERROR COMPLETION ROUTINE.
	M_ON0ERR	30$,		;EXIT IF ERROR.
	BICL	#X_NEWOPN,XTLLONG	;NO LONGER OPENED.
	BRW	20$		;RETURN. C-BIT CLEARED.
101$:
	CMPL	#LBL_HDR2,LBLTBL_PTR	;HDR2??
	M_IF_NEQ	102$		;BRANCH IF NOT HDR2.
109$:
	M_MESS	< >
	M_MESS	<Magtape volume serial number: !AF>,-
		<#LH_MTVOL1SER,#VOL1_ASCII+OF_MTVOL1SER>
	M_MESS	<Dataset ID: !AF    Dataset serial number: !AF>,-
		<#LH_MTDSL1DSID,#HDR1_ASCII+OF_MTDSL1DSID,-
		 #LH_MTDSL1DSSER,#HDR1_ASCII+OF_MTDSL1DSSER>
	M_MESS	<Volume seq number: !AF    Dataset seq number: !AF>,-
		<#LH_MTDSL1VOLSEQ,#HDR1_ASCII+OF_MTDSL1VOLSEQ,-
		 #LH_MTDSL1DSSEQ,#HDR1_ASCII+OF_MTDSL1DSSEQ>
	M_MESS <Gen number: !AF  Ver number: !AF   Dataset security: !AF>,-
		<#LH_MTDSL1GENNUM,#HDR1_ASCII+OF_MTDSL1GENNUM,-
		 #LH_MTDSL1VERNUM,#HDR1_ASCII+OF_MTDSL1VERNUM,-
		 #LH_MTDSL1SECUR,#HDR1_ASCII+OF_MTDSL1SECUR>
	M_MESS	<Creation date: !AF    Expiration date: !AF>,-
		<#LH_MTDSL1CREDAT,#HDR1_ASCII+OF_MTDSL1CREDAT,-
		 #LH_MTDSL1EXPDAT,#HDR1_ASCII+OF_MTDSL1EXPDAT>
	M_MESS	<System code: !AF    Record format: !AF   Block size: !AF>,-
		<#LH_MTDSL1SYSCOD,#HDR1_ASCII+OF_MTDSL1SYSCOD,-
		 #LH_MTDSL2RFM,#HDR2_ASCII+OF_MTDSL2RFM,-
		 #LH_MTDSL2BLOLEN,#HDR2_ASCII+OF_MTDSL2BLOLEN>
	M_MESS	<Record length: !AF   Tape density: !AF  Dataset pos: !AF>,-
		<#LH_MTDSL2RECLEN,#HDR2_ASCII+OF_MTDSL2RECLEN,-
		 #LH_MTDSL2TAPDEN,#HDR2_ASCII+OF_MTDSL2TAPDEN,-
		 #LH_MTDSL2DSPOS,#HDR2_ASCII+OF_MTDSL2DSPOS>
   M_MESS <Job step: !AF   Tape rec technique: !AF Control char: !AF>,-
		<#LH_MTDSL2JOBSTP,#HDR2_ASCII+OF_MTDSL2JOBSTP,-
		 #LH_MTDSL2TAPTNQ,#HDR2_ASCII+OF_MTDSL2TAPTNQ,-
		 #LH_MTDSL2CONCHA,#HDR2_ASCII+OF_MTDSL2CONCHA>
	M_MESS	<Block attribute: !AF  Checkpoint ID: !AF>,-
		<#LH_MTDSL2BLOATT,#HDR2_ASCII+OF_MTDSL2BLOATT,-
		 #LH_MTDSL2CHKPNT,#HDR2_ASCII+OF_MTDSL2CHKPNT>
114$:
	MOVL	#DEF_NEWALLOC,NEWALLOC	;MOVE IN DEFAULT ALLOCATION.
	M_GTINP	<Enter estimate file size in 512 bytes blocks [100]: >
	CMPL	#RMS$_EOF,R0			;EOF??		;JGD4
	M_IF_EQL	45$			;BRANCH IF ^Z	;JGD4
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	TSTL	L_INPDESC		;ANY INPUT??
	M_IF_EQL	111$		;BRANCH IF NO INPUT.
	MOVL	L_INPDESC,TPARSE_PAR+TPA$L_STRINGCNT	;SET INPUT SIZE.
	MOVL	L_INPDESC+4,TPARSE_PAR+TPA$L_STRINGPTR	;SET INPUT ADDRESS.
	PUSHAL	T_AVATUKTB		;KEY TABLE.
	PUSHAL	T_DECIMAL		;STARING STATE.
	PUSHAL	TPARSE_PAR		;TPARSE PARAMETER BLOCK.
	CALLS	#3,G^LIB$TPARSE		;PARSE LINE.
	M_ONTPAERR	114$,TPARSE_PAR,<SYSONLY>	;TRY AGAIN IF ERROR.
	MOVL	TL_NUMBER,NEWALLOC	;STORE NUMBER.
111$:
	MOVL	NEWALLOC,NEWFAB+FAB$L_ALQ	;SET ALLOCATION.
112$:
	MOVL	#DEF_NEWEXTENT,NEWEXTENT	;MOVE IN DEFAULT EXTENT.
	M_GTINP	<Enter extent allocation in 512 bytes blocks [100]: >
	CMPL	#RMS$_EOF,R0			;EOF??		;JGD4
	M_IF_EQL	45$			;BRANCH IF ^Z	;JGD4
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	TSTL	L_INPDESC		;ANY INPUT??
	M_IF_EQL	113$		;BRANCH IF NO INPUT.
	MOVL	L_INPDESC,TPARSE_PAR+TPA$L_STRINGCNT	;SET INPUT SIZE.
	MOVL	L_INPDESC+4,TPARSE_PAR+TPA$L_STRINGPTR	;SET INPUT ADDRESS.
	PUSHAL	T_AVATUKTB		;KEY TABLE.
	PUSHAL	T_DECIMAL		;STARTING STATE.
	PUSHAL	TPARSE_PAR		;TPARSE PARAMETER BLOCK.
	CALLS	#3,G^LIB$TPARSE		;PARSE LINE.
	M_ONTPAERR	112$,TPARSE_PAR,<SYSONLY>	;TRY AGAIN IF ERROR.
	MOVL	TL_NUMBER,NEWEXTENT	;STORE NUMBER.
113$:
	MOVW	NEWEXTENT,NEWFAB+FAB$W_DEQ	;SET EXTENT ALLOCATION.
	M_GTINP	<Enter VAX output filename [SYS$DISK:IBM.DAT]: >	;PROMPT USER.
	CMPL	#RMS$_EOF,R0			;EOF??			;JGD4
	M_IF_EQL	45$			;BRANCH IF ^Z		;JGD4
	M_ON0ERR	30$		;EXIT IF ERROR.
	MOVL	L_INPDESC,TPARSE_PAR+TPA$L_STRINGCNT	;SET INPUT STRING SIZE.
	MOVL	L_INPDESC+4,TPARSE_PAR+TPA$L_STRINGPTR	;SET INPUT STRING ADDRESS.
	PUSHAL	T_AVATUKTB		;KEYTABLE.
	PUSHAL	T_FILSPC		;STARTING STATE.
	PUSHAL	TPARSE_PAR		;TPARSE PARAMETER BLOCK.
	CALLS	#3,G^LIB$TPARSE		;PARSE LINE.
	M_ONTPAERR	109$,TPARSE_PAR,<SYSONLY>	;TRY AGAIN IF ERROR.
	TSTL	L_INPDESC		;ANY INPUT??
	BEQL	110$			;USE DEFAULT IF NOT.
	MOVB	L_INPDESC,NEWFAB+FAB$B_FNS	;SET FILENAME STRING SIZE.
	MOVL	L_INPDESC+4,NEWFAB+FAB$L_FNA	;SET FILENAME STRING ADDRESS.
110$:
	$CREATE	FAB=NEWFAB,-		;CREATE OUTPUT FILE.
		ERR=J_RMAER		;ERROR COMPLETION ROUTINE.
	M_ON0ERR	109$		;TRY AGAIN IF ERROR.
	BISL	#X_NEWOPN,XTLLONG	;REMEMBER NEW FILE OPENED.
	$CONNECT	RAB=NEWRAB,-	;CONNECT NEW FILE.
			ERR=J_RMAER	;ERROR COMPLETION ROUTINE.
	M_ON0ERR	30$		;EXIT IF ERROR.
	BISL	#X_NEWCON,XTLLONG	;REMEMBER NEW FILE CONNECTED.
	BRW	20$			;RETURN.
102$:
	CMPL	#LBL_EOV2,LBLTBL_PTR	;EOV2??
	M_IF_NEQ	103$		;BRANCH IF NOT.
	INCL	VOLSEQ			;INCREMENT VOLUME SEQUENCE NUMBER.
	BISL	#X_NEWVOL,XTLLONG	;SET NEW VOLUME FLAG.
	BISL	#X_PROMPTNEWVOL,XTLLONG	;PROMPT FOR NEW VOLUME.
	BRW	20$			;RETURN.
103$:
	BRW	20$			;RETURN.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	CMPL	#LBL_EOF2,LBLTBL_PTR	;EOF2??
	M_IF_NEQ	201$		;BRANCH AROUND IF NOT EOF2.
	INCL	DSSEQ			;INCREMENT SEQUENCE NUMBER.
	$DISCONNECT -			;DISCONNECT OLD FILE.
		RAB=OLDRAB,-		;
		ERR=J_RMAER		;ERROR COMPLETION ROUTINE.
	M_ON0ERR	30$		;EXIT IF ERROR.
	BICL	#X_OLDCON,XTLLONG	;NO LONGER CONNECTED.
	$CLOSE -			;CLOSE OLD FILE.
		FAB=OLDFAB,-		;
		ERR=J_RMAER		;ERROR COMPLETION ROUTINE.
	M_ON0ERR	30$		;EXIT IF ERROR.
	BICL	#X_OLDOPN,XTLLONG	;NO LONGER OPENED.
201$:
	CMPL	#LBL_EOV2,LBLTBL_PTR	;EOV2??
	M_IF_NEQ	204$		;BRANCH IF NOT EOV2.
	BISL	#X_NEWVOL,XTLLONG	;SET NEW VOLUME FLAG.
	BISL	#X_PROMPTNEWVOL,XTLLONG	;SET PROMPT NEW VOLUME.
	INCL	VOLSEQ			;INCREMENT VOLUME SEQUENCE NUMBER.
204$:
	MOVL	#LH_DSL1LEN,R0		;LENGTH OF ASCII BUFFER.
	MOVAL	(R10),R1		;ASCII BUFFER.
	MOVAL	ASCEBCTBL,R3		;EBC TO ASCII TRANSLATION TABLE.
	MOVL	#LH_DSL1LEN,R4		;LENGTH OF EBCDIC BUFFER.
	MOVAL	(R9),R5			;EBCDIC BUFFER.
	JSB	MOVETRANSLATE		;MOVE AND TRANSLATE.
	TSTL	R6			;ANY ERROR.
	M_IF_GTR	30$		;EXIT IF ERROR.
	$QIOW_S	-			;WRITE DSL1 LABEL.
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_WRITEVBLK,-	;
		IOSB=MTIOSB,-		;
		P1=(R9),-		;EBCDIC BUFFER.
		P2=#LH_DSL2LEN		;LENGTH.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	CMPW	#SS$_ENDOFTAPE,MTIOSB	;EOT.
	M_IF_NEQ	202$		;BRNANCH IF NOT EOT.
	BISL	#X_ENDOFTAPE,XTLLONG	;INDICATE EOT DETECTED.
	BRW	203$			;EOT IS OKAY.
202$:
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
203$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	CMPL	#LBL_HDR2,LBLTBL_PTR	;HDR2??
	M_IF_EQL	1101$		;BRANCH IF HDR2.
PCCUR=.
	M_MESS	<Internal error at PC=!XL>,<#PCCUR>
	BRW	30$			;EXIT.
1101$:
	M_MESS  < >
	M_MESS	<Magtape volume serial number: !AF>,-
		<#LH_MTVOL1SER,#VOL1_ASCII2+OF_MTVOL1SER>
	M_MESS	<Dataset ID: !AF       Dataset serial number: !AF>,-
		<#LH_MTDSL1DSID,#HDR1_ASCII2+OF_MTDSL1DSID,-
		 #LH_MTDSL1DSSER,#HDR1_ASCII2+OF_MTDSL1DSSER>
	M_MESS	<Volume Seq number: !AF  Dataset Seq number: !AF>,-
		<#LH_MTDSL1VOLSEQ,#HDR1_ASCII2+OF_MTDSL1VOLSEQ,-
		 #LH_MTDSL1DSSEQ,#HDR1_ASCII2+OF_MTDSL1DSSEQ>
	M_MESS <Gen number: !AF    Ver number: !AF   Dataset security: !AF>,-
		<#LH_MTDSL1GENNUM,#HDR1_ASCII2+OF_MTDSL1GENNUM,-
		 #LH_MTDSL1VERNUM,#HDR1_ASCII2+OF_MTDSL1VERNUM,-
		 #LH_MTDSL1SECUR,#HDR1_ASCII2+OF_MTDSL1SECUR>
	M_MESS	<Creation date: !AF    Expiration date: !AF>,-
		<#LH_MTDSL1CREDAT,#HDR1_ASCII2+OF_MTDSL1CREDAT,-
		 #LH_MTDSL1EXPDAT,#HDR1_ASCII2+OF_MTDSL1EXPDAT>
	M_MESS	<System code: !AF    Record format: !AF   Block size: !AF>,-
		<#LH_MTDSL1SYSCOD,#HDR1_ASCII2+OF_MTDSL1SYSCOD,-
		 #LH_MTDSL2RFM,#HDR2_ASCII2+OF_MTDSL2RFM,-
		 #LH_MTDSL2BLOLEN,#HDR2_ASCII2+OF_MTDSL2BLOLEN>
	M_MESS	<Record length: !AF   Tape density: !AF   Dataset pos: !AF>,-
		<#LH_MTDSL2RECLEN,#HDR2_ASCII2+OF_MTDSL2RECLEN,-
		 #LH_MTDSL2TAPDEN,#HDR2_ASCII2+OF_MTDSL2TAPDEN,-
		 #LH_MTDSL2DSPOS,#HDR2_ASCII2+OF_MTDSL2DSPOS>
   M_MESS <Job step: !AF   Tape rec technique: !AF   Control char: !AF>,-
		<#LH_MTDSL2JOBSTP,#HDR2_ASCII2+OF_MTDSL2JOBSTP,-
		 #LH_MTDSL2TAPTNQ,#HDR2_ASCII2+OF_MTDSL2TAPTNQ,-
		 #LH_MTDSL2CONCHA,#HDR2_ASCII2+OF_MTDSL2CONCHA>
	M_MESS	<Block attribute: !AF    Checkpoint ID: !AF>,-
		<#LH_MTDSL2BLOATT,#HDR2_ASCII2+OF_MTDSL2BLOATT,-
		 #LH_MTDSL2CHKPNT,#HDR2_ASCII2+OF_MTDSL2CHKPNT>
	BICL	#X_NEWVOL,XTLLONG	;CLEAR NEW VOLUME FLAG.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	CMPL	#LBL_HDR2,LBLTBL_PTR	;HDR2??
	M_IF_EQL	1201$		;BRANCH IF HDR2.
PCCUR=.
	M_MESS	<Internal error at PC=!XL>,<#PCCUR>
	BRW	30$			;EXIT.
1201$:
	MOVL	#LH_DSL1LEN,R0		;LENGTH OF ASCII 2 BUFFER.
	MOVAL	(R11),R1		;ASCII 2 BUFFER.
	MOVAL	ASCEBCTBL,R3		;EBC TO ASCII TRANSLATION TABLE.
	MOVL	#LH_DSL1LEN,R4		;LENGTH OF EBCDIC BUFFER.
	MOVAL	(R9),R5			;EBCDIC BUFFER.
	JSB	MOVETRANSLATE		;MOVE AND TRANSLATE.
	TSTL	R6			;ANY ERROR.
	M_IF_GTR	30$		;EXIT IF ERROR.
	$QIOW_S	-			;WRITE DSL1 LABEL.
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_WRITEVBLK,-	;
		IOSB=MTIOSB,-		;
		P1=(R9),-		;EBCDIC BUFFER.
		P2=#LH_DSL2LEN		;LENGTH.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	CMPW	#SS$_ENDOFTAPE,MTIOSB	;EOT??
	M_IF_NEQ	1202$		;BRANCH IF NOT EOT.
	BISL	#X_ENDOFTAPE,XTLLONG	;INDICATE EOT DETECTED.
	BRW	1203$			;EOT IS OKAY.
1202$:
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
1203$:
	BICL	#X_NEWVOL,XTLLONG	;CLEAR NEW VOLUME FLAG.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	CASEB	TFRMOD,#0,#1		;EXPECT AN EOF.
300$:
	.WORD	310$-300$		;IBM TO VAX.
	.WORD	320$-300$		;VAX TO IBM.
	M_MESS	<Trnsfer out of range /!1UB/>,<TFRMOD>
	BRW	30$			;EXIT.
310$:				;IBM TO VAX.  EXPECTS AN EOF.
	$QIOW_S -		;READ IN EOF.
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_READVBLK,-	;
		IOSB=MTIOSB,-		;
		P1=EOFBUF,-		;DUMMY EOF BUFFER.
		P2=#EOFLEN			;DUMMY LENGTH.
	M_ON0ERR	30$,<SYSONLY>		;EXIT IF ERROR.
	CMPW	#SS$_ENDOFFILE,MTIOSB	;EOF??
	M_IF_EQL	311$		;BRANCH IF EOF.
	M_ONIOSERR	,MTIOSB,<SYSONLY>	;TELL ERROR IF ANY.
	M_MESS	<End of file expected,but not found>
	BRW	30$			;EXIT.
311$:
	BRW	322$			;OKAY.
320$:				;VAX TO IBM, MUST WRITE EOF.
	$QIOW_S -			;WRITE EOF.
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_WRITEOF,-	;
		IOSB=MTIOSB		;
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	CMPW	#SS$_ENDOFTAPE,MTIOSB	;END OF TAPE.
	M_IF_NEQ	321$		;BRANCH IF NOT.
	BISL	#X_ENDOFTAPE,XTLLONG	;END OF TAPE DETECTED.
	BRW	322$			;OKAY.
321$:
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
322$:
	BITL	#X_PROMPTNEWVOL,XTLLONG	;NEW VOLUME PROMPT??
	M_IF_EQL	323$		;BRANCH IF NOT.
	BICL	#X_PROMPTNEWVOL,XTLLONG		;CLEAR PROMPT NEW VOLUME FLAG.
	$QIOW_S	-			;REWIND.
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_REWINDOFF!IO$M_NOWAIT,-	;
		IOSB=MTIOSB		;
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	M_ONIOSERR	,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
324$:
	M_GTINP	<Mount next volume and hit carriage-return: >
	CMPL	#RMS$_EOF,R0		;EOF??
	M_IF_EQL	30$		;EXIT IF EOF.
	$GETCHN_S	-		;SEE IF DEVICE READY.
		CHAN=MTCHANNEL,-	;
		PRIBUF=MTPRIBUFDESC,-	;
		PRILEN=MTPRILENWRD	;
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	BITL	#DEV$M_AVL,MTPRIBUF+DIB$L_DEVCHAR	;READY??
	M_IF_NEQ	325$		;BRACNH IF READY.
;
	M_MESS	<Device /!AF/ is not ready>,<MTNAMEDESC,MTNAMEDESC+4>
	BRW	324$			;TRY AGAIN.
;
;SEE IF MT CAN QIO.
;
325$:
	$QIOW_S	-			;READ IN NEXT BLOCK INTO DUMMY BUFFER.
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_READVBLK,-	;
		IOSB=MTIOSB,-		;
		P1=NEXVOLBUF,-		;
		P2=#LH_VOL1LEN		;
	M_ON0ERR	30$,<SYSONLY>	;TELL USER IF ERROR.
	M_ONIOSERR	324$,MTIOSB,<SYSONLY>	;TELL USER IF ERROR.
	$QIOW_S -			;SPACE IT BACK TO START.
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_READVBLK!IO$M_REVERSE,-	;
		IOSB=MTIOSB,-		;
		P1=NEXVOLBUF,-		;
		P2=#LH_VOL1LEN		;
	M_ON0ERR	30$,<SYSONLY>		;TELL USER IF ERROR.
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;TELL USER IF ERROR.
323$:
	BRW	21$			;OKAY.
21$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
45$:	CLRL	R0		; Make status OK
	BITL	#X_MTALOC,XTLLONG	;MT ALLOCATED AND ASSIGNED??
	M_IF_EQL	46$		;BRANCH IF NOT.
	$QIOW_S	-
		CHAN=MTCHANNEL,-
		FUNC=#IO$_REWIND!IO$M_NOWAIT,-
		IOSB=MTIOSB
	M_ON0ERR	,<SYSONLY>
	M_ONIOSERR	,MTIOSB,<SYSONLY>
46$:
	$EXIT_S			; and exit
.PAGE
.SUBTITLE	DATA SET ACTION ROUTINE
;
;
;DATA SET ACTION ROUTINE.
;
;TRANSFER FROM IBM TO VAX:
;
;	IF FIRST VOLUME:
;
;		1.	INITIATE READ ON MT.
;		2.	IF GOT A GOOD MT BUFFER, GO PROCESS IT.
;		3.	DO UNTIL EOF.
;		4.	WAIT TILL ALL VAX WRITES COMPLETES.
;
;	IF SECOND VOLUME:
;
;		1.	ERROR.
;
;TRANSFER FROM VAX TO IBM:
;
;	IF FIRST VOLUME:
;
;		1.	INITIATE READ ON VAX.
;		2.	PROCESS IF GOT GOOD VAX BUFFER.
;		3.	DO UNTIL EN OF TAPE ON MAGTAPE OR EOF ON OLD FILE.
;		3A.	WAIT TILL ALL MT WRITES COMPLETES.
;		4.	WRITE EOF ON MT.
;
AC_DATA:				;DATA SET ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	.IF	DF	DEBUG
	M_MESS	<AC_DATA>
	.ENDC
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST VOLUME, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	JSB	MTREAD		;START READ ON MT.
	M_IF_CS	30$		;EXIT IF ERROR.
110$:
	BITL	#X_ERROR,XTLLONG	;ANY ASY ERROR.
	M_IF_NEQ	30$		;EXIT IF ASY ERROR.
	$SETAST_S	ENBFLG=#0	;DISABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	MOVL	MTPOOLWKPTR,R11	;GET CURRENT MT BUF POINTER.
	.IF	DF	DEBUG
	M_MESS	<MTPOOLWKPTR=!XL>,<R11>
	.ENDC
	BITL	OF_POOL_FLG(R11),#B_GOOD	;GOOD BUFFER??
	M_IF_NEQ	101$	;BRANCH IF GOOD BUFFER.
	BISL	#X_MTSUSPEND,XTLLONG	;NO GOOD, SO GO TO SLEEP.
	.IF	DF	DEBUG
	M_MESS	<GOING TO HIBERNATE, BECAUSE NO GOOD BUFFER TO PROCESS>
	.ENDC
	$SETAST_S	ENBFLG=#1	;ENABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	$HIBER_S			;GO TO SLEEP.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	BRW	110$			;SOME ONE WOKE ME UP.
;
;GOOD MT BUFFER, SO GO PROCESS IT.
;
101$:
	$SETAST_S	ENBFLG=#1	;ENABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	JSB	PRC_MTBUF		;PROCESS MT BUFFER.
	M_IF_CS	30$			;EXIT IF ERROR.
	BITL	#X_ERROR,XTLLONG	;ANY ASY ERROR?
	M_IF_NEQ	30$		;EXIT IF ASY ERROR.
	BICL	#B_GOOD,OF_POOL_FLG(R11)	;MAKE IT A BAD BUFFER.
	BITL	#B_EOF,OF_POOL_FLG(R11)	;EOF BUFFER??
	M_IF_NEQ	104$		;FINISH IF EOF BUFFER.
	BITL	#X_MTREQ,XTLLONG	;MAGTAPE WAITING FOR A BUFFER??
	M_IF_EQL	102$		;BRANCH IF NOT.
	BICL	#X_MTREQ,XTLLONG	;CLEAR FLAG FOR NEXT REQUEST.
	.IF	DF	DEBUG
	M_MESS	<MAGTAPE IS WAITING, SO START ANOTHER READ>
	.ENDC
	JSB	MTREAD			;INITIATE READ AGAIN.
	M_IF_CS	30$			;EXIT IF ERROR.
102$:
	MOVL	#MAXMTPOOLBYTE,R10	;#OF BYTES PER ENTRY.
	ADDL	R10,R11			;POINT TO NEXT ENTRY.
	CMPL	R11,MTPOOLENDPTR		;END OF TABLE??
	M_IF_NEQ	103$		;BRANCH IF NOT.
	MOVL	#MTPOOLBEG,R11		;WRAP AROUND.
103$:
	MOVL	R11,MTPOOLWKPTR		;UPDATE WORK POINTER.
	BRW	110$			;DO IT AGAIN.
;
;EOF BUFFER, SO FINISHED.
;
104$:
	BICL	#B_EOF,OF_POOL_FLG(R11)	;CLEAR EOF FLAG.
	BRW	20$			;RETURN.
;
;
;
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	JSB	VAXREAD		;START READ ON VAX.
	M_IF_CS	30$		;EXIT IF ERROR.
210$:
	BITL	#X_ERROR,XTLLONG	;ANY ASY ERROR.
	M_IF_NEQ	30$		;EXIT IF ASY ERROR.
	$SETAST_S	ENBFLG=#0	;DISABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	MOVL	VAXPOOLWKPTR,R11	;GET CURRENT VAX BUF POINTER.
	.IF	DF	DEBUG
	M_MESS	<VAXPOOLWKPTR=!XL>,<R11>
	.ENDC
	BITL	OF_POOL_FLG(R11),#B_GOOD	;GOOD BUFFER??
	M_IF_NEQ	201$	;BRANCH IF GOOD BUFFER.
	BISL	#X_VAXSUSPEND,XTLLONG	;NO GOOD, SO GO TO SLEEP.
	.IF	DF	DEBUG
	M_MESS	<NO GOOD VAX BUFFERS, SO GO HIBERNATE>
	.ENDC
	$SETAST_S	ENBFLG=#1	;ENABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	$HIBER_S			;GO TO SLEEP.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	BRW	210$			;SOME ONE WOKE ME UP.
;
;GOOD VAX BUFFER, SO GO PROCESS IT.
;
201$:
	$SETAST_S	ENBFLG=#1	;ENABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	JSB	PRC_VAXBUF		;PROCESS VAX BUFFER.
	M_IF_CS	30$			;EXIT IF ERROR.
	BITL	#X_ERROR,XTLLONG	;ANY ASY ERROR?
	M_IF_NEQ	30$		;EXIT IF ASY ERROR.
	BITL	#X_ENDOFTAPE,XTLLONG	;END OF TAPE DETECTED ON MAGTAPE??
	M_IF_NEQ	20$		;BRANCH IF END OF TAPE DETECTED.
	BICL	#B_GOOD,OF_POOL_FLG(R11)	;MAKE IT A BAD BUFFER.
	BITL	#B_EOF,OF_POOL_FLG(R11)	;EOF BUFFER??
	M_IF_NEQ	204$		;FINISH IF EOF BUFFER.
	BITL	#X_VAXREQ,XTLLONG	;VAX WAITING FOR A BUFFER??
	M_IF_EQL	202$		;BRANCH IF NOT.
	BICL	#X_VAXREQ,XTLLONG	;CLEAR FLAG FOR NEXT REQUEST.
	.IF	DF	DEBUG
	M_MESS	<VAX WAITING FOR FREE BUFFER, SO START ANOTHER VAX READ>
	.ENDC
	JSB	VAXREAD			;INITIATE READ AGAIN.
	M_IF_CS	30$			;EXIT IF ERROR.
202$:
	MOVL	#MAXVAXPOOLBYTE,R10	;#OF BYTES PER ENTRY.
	ADDL	R10,R11			;POINT TO NEXT ENTRY.
	CMPL	R11,VAXPOOLENDPTR		;END OF TABLE??
	M_IF_NEQ	203$		;BRANCH IF NOT.
	MOVL	#VAXPOOLBEG,R11		;WRAP AROUND.
203$:
	MOVL	R11,VAXPOOLWKPTR		;UPDATE WORK POINTER.
	BRW	210$			;DO IT AGAIN.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;EOF. SO FINISHED.
;
204$:
	BISL	#X_OLDEOF,XTLLONG	;INDICATE OLD FILE EOF.
	BICL	#B_EOF,OF_POOL_FLG(R11)	;CLEAR EOF FLAG.
	BRW	20$			;RETURN.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
PCCUR=.
	M_MESS	<Internal error at PC=!XL>,<#PCCUR>
	BRW	30$			;EXIT.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
PCCUR=.
	M_MESS	<Internal error at PC=!XL>,<#PCCUR>
	BRW	30$			;EXIT.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
;
;HAS TO WAIT FOR ALL WRITE TO COMPLETE.
;
	CASEB	TFRMOD,#0,#1		;MT OR VAX WRITES??
300$:
	.WORD	310$-300$		;VAX WRITES.
	.WORD	320$-300$		;MT WRITES.
;
	M_MESS	<Transfer mode /!UB/ out of range>,<TFRMOD>
	BRW	30$			;EXIT.
;
;
;VAX WRITES.
;
310$:
	$SETAST_S	ENBFLG=#0	;DISABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	BITL	#X_VAXINPROG,XTLLONG	;VAX IN PROGRESS??
	M_IF_EQL	340$		;OKAY IF NOT IN PROGRESS.
	BISL	#X_VAXSUSPEND,XTLLONG	;WELL, HAS TO WAIT, SO INDICATE HIBERNATE.
	.IF	DF	DEBUG
	M_MESS	<MT FINISHED, WAITING FOR VAX TO FINISH>
	.ENDC
	$SETAST_S	ENBFLG=#1	;ENABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	$HIBER_S			;GO TO SLEEP.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	BRW	310$			;SOMEONE WOKE ME UP, SEE IF VAX FINISHED.
;
;
;MT WRITES, SO WAIT FOR MT TO FINISH.
;
320$:
	$SETAST_S	ENBFLG=#0	;DISABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	BITL	#X_MTINPROG,XTLLONG	;MT IN PROGRESS??
	M_IF_EQL	321$		;BRANCH IF MT NOT IN PROGRESS.
	BISL	#X_MTSUSPEND,XTLLONG	;INDICATE GOING TO SLEEP DUE TO MT.
	.IF	DF	DEBUG
	M_MESS	<VAX FINISHED, WAITING FOR MT TO COMPLETE>
	.ENDC
	$SETAST_S	ENBFLG=#1	;ENABLE AST.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	$HIBER_S			;GO TO SLEEP.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	BRW	320$			;WOKE UP, SO SEE IF MT FINISHED.
;
;MT FINISHED, SO WRITE EOF ON MT.
;
321$:
	$QIOW_S	-			;WRITE EOF
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_WRITEOF,-	;
		IOSB=MTIOSB		;
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	CMPW	#SS$_ENDOFTAPE,MTIOSB	;EOT IS OKAY.
	M_IF_EQL	340$		;
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;EXIT IF ERROR.
340$:
	$SETAST_S	ENBFLG=#1	;ENABLE AST JUST IN CASE.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	$SETAST_S	ENBFLG=#1	;ENABLE AST JUST IN CASE.
	M_ON0ERR	,<SYSONLY>	;TELL USER IF ERROR.
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	DATA SET END ACTION ROUTINE
;
;
;DATA SET END ACTION ROUTINE.
;
;
;IF TRANSFER FROM IBM TO VAX:
;
;	IF FIRST VOLUME:
;
;		1.	READ A BLOCK FORWARD AND REVERSE SO THAT TAPE IS
;			AT THE SAME PLACE.
;		2.	IF EOF1, LINK TO LBL_EOF1.
;		3.	IF EOV1, LINK TO LBL_EOV1.
;		4.	IF OTHER, ERROR.
;
;	IF SECOND VOLUME:
;
;		1.	ERROR.
;
;IF TRANSFER FROM VAX TO IBM.
;
;	IF FIRST VOLUME:
;
;		2.	IF OLD FILE COMPLETELY PROCESSED (OLDEOF SET),
;			THEN LINK TO LBL_EOF1.
;		3.	ELSE LINK TO LBL_EOV1.
;
;
AC_DATAEND:				;DATA SET END ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	.IF	DF	DEBUG
	M_MESS	<AC_DATAEND>
	.ENDC
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST VOLUME, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	$QIOW_S	-			;READ IN NEXT BLOCK INTO DUMMY BUFFER.
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_READVBLK,-	;
		IOSB=MTIOSB,-		;
		P1=DATAENDBUF,-		;
		P2=#LH_DSL1LEN		;
	M_ON0ERR	30$,<SYSONLY>	;TELL USER IF ERROR.
	CMPW	#SS$_ENDOFTAPE,MTIOSB	;EOT IS OKAY.
	M_IF_NEQ	101$		;BRANCH IF NOT.
	BISL	#X_ENDOFTAPE,XTLLONG	;INDICATE ENDOF TAPE.
	BRW	102$			;EOT IS OKAY.
101$:
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;TELL USER IF ERROR.
102$:
	$QIOW_S -			;SPACE IT BACK TO START.
		CHAN=MTCHANNEL,-	;
		FUNC=#IO$_READVBLK!IO$M_REVERSE,-	;
		IOSB=MTIOSB,-		;
		P1=DATAENDBUF,-		;
		P2=#LH_DSL1LEN		;
	M_ON0ERR	30$,SYSONLY		;TELL USER IF ERROR.
	CMPW	#SS$_ENDOFTAPE,MTIOSB		;EOT IS OKAY.
	M_IF_NEQ	103$			;BRANCH IF NOT EOT.
	BISL	#X_ENDOFTAPE,XTLLONG		;INDICATE EOT.
	BRW	104$				;EOT IS OKAY.
103$:
	M_ONIOSERR	30$,MTIOSB,<SYSONLY>	;TELL USER IF ERROR.
104$:
	MOVL	#LH_DSL1LEN,R0		;TRNANSLATE EBC TO ASCII.
	MOVAL	DATAENDBUF,R1		;BUFFER.
	MOVAL	EBCASCTBL,R3		;EBC TO ASCII TRANSLATION TABLE.
	MOVL	R0,R4			;OUTPUT OVER INPUT.
	MOVL	R1,R5			;SIZE.
	JSB	MOVETRANSLATE		;MOVE AND TRANSLATE.
	TSTL	R6			;ANY ERRORS??
	M_IF_GTR	30$		;EXIT IF ERROR.
	CMPC3	#LH_MTDSL1LBLID,LBL_EOF1+OF_LBLTBL_ID,DATAENDBUF ;COMPARE.
	M_IF_EQL	110$		;BRANCH IF EOF1.
	CMPC3	#LH_MTDSL1LBLID,LBL_EOV1+OF_LBLTBL_ID,DATAENDBUF ;COMPARE.
	M_IF_EQL	120$		;BRANCH IF EOV1.
	M_MESS	<Label /!AF/ is unexpected>,<#LH_MTDSL1LBLID,#DATAENDBUF>
	BRW	30$			;EXIT.
110$:
;
;EOF1.
;
	MOVL	#LBL_EOF1,LBL_DATAEND+OF_LBLTBL_NEXT	;LINK IN NEXT LABEL STATE.
	BRW	20$			;RETURN.
;
;
;
120$:
;
;EOV1.
;
	MOVL	#LBL_EOV1,LBL_DATAEND+OF_LBLTBL_NEXT	;LINK IN NEXT LABEL STATE.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	BITL	#X_OLDEOF,XTLLONG	;OLD FILE COMPLETELY PROCESSED??
	M_IF_EQL	210$		;BRANCH IF NOT.
;
;
;EOF1.
;
	MOVL	#LBL_EOF1,LBL_DATAEND+OF_LBLTBL_NEXT	;LINK TO EOF1.
	BRW	20$			;RETURN.
;
;
;
210$:
;
;EOV1.
;
	MOVL	#LBL_EOV1,LBL_DATAEND+OF_LBLTBL_NEXT	;LINK TO EOV1.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
PCCUR=.
	M_MESS	<internal error at PC=!XL>,<#PCCUR>
	BRW	30$		;EXIT.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
PCCUR=.
	M_MESS	<Internal error at PC=!XL>,<#PCCUR>
	BRW	30$			;EXIT.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	ZERO FILL ACTION ROUTINE
;
;
;ZERO FILL ACTION ROUTINE.
;
;THIS ROUTINE ZERO FILL THE FIELD DESCRIBED BY THE CURRENT ACTION ROUTINE.
;
;IF TRANSFER FROM IBM TO VAX:
;
;	1.	RETURN.
;
;IF TRANSFER FROM VAX TO IBM:
;
;	1.	FILL FIELD WITH ZERO'S EITHER ASCII OR ASCII 2 BUFFER.
;
;
AC_ZERO:				;ZERO FILL ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	MOVL	LBLTBL_PTR,R8		;POINT TO LABEL TABLE.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	.IF	DF	DEBUG
	M_MESS	<AC_ZERO>
	.ENDC
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST TAPE, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADRESS.
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO FIELD.
	MOVL	OF_ACTTBL_LEN(R7),R6	;LENGTH.
	TSTL	R6			;LENGTH MUST BE POSITIVE.
	M_IF_GTR	201$		;BRANCH IF LENGTH IS POSITIVE.
	M_MESS	<Zero-fill length /!XL/ not positive>,<R6>
	BRW	30$			;EXIT.
201$:
	MOVB	#^A/0/,(R10)+		;ZERO FILL.
	SOBGTR	R6,201$			;LOOP TILL DONE.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADRESS.
	ADDL	OF_ACTTBL_OFF(R7),R11	;POINT TO FIELD. ASCII 2 BUFFER.
	MOVL	OF_ACTTBL_LEN(R7),R6	;LENGTH.
	TSTL	R6			;LENGTH MUST BE POSITIVE.
	M_IF_GTR	1201$		;BRANCH IF LENGTH IS POSITIVE.
	M_MESS	<Zero-fill length /!XL/ not positive>,<R6>
	BRW	30$			;EXIT.
1201$:
	MOVB	#^A/0/,(R11)+		;ZERO FILL.
	SOBGTR	R6,1201$		;LOOP TILL DONE.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	BLANK FILL ACTION ROUTINE
;
;
;BLANK FILL ACTION ROUTINE.
;
;IF TRANSFER FROM IBM TO VAX:
;
;	1.	RETURN.
;
;IF TRANSFER IBM TO VAX:
;
;	1.	BLANK FILL FIELD EITHER ASCII OR ASCII 2 BUFFER.
;
;
AC_BLANK:				;BLANK FILL ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE ADDRESS.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	.IF	DF	DEBUG
	M_MESS	<AC_BLANK>
	.ENDC
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST TAPE, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADRESS.
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO FIELD.
	MOVL	OF_ACTTBL_LEN(R7),R6	;LENGTH.
	TSTL	R6			;LENGTH MUST BE POSITIVE.
	M_IF_GTR	201$		;BRANCH IF LENGTH IS POSITIVE.
	M_MESS	<Blank-fill length /!XL/ not positive>,<R6>
	BRW	30$			;EXIT.
201$:
	MOVB	#^A/ /,(R10)+		;BLANK FILL.
	SOBGTR	R6,201$			;LOOP TILL DONE.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADRESS.
	ADDL	OF_ACTTBL_OFF(R7),R11	;POINT TO FIELD. ASCII 2 BUFFER.
	MOVL	OF_ACTTBL_LEN(R7),R6	;LENGTH.
	TSTL	R6			;LENGTH MUST BE POSITIVE.
	M_IF_GTR	1201$		;BRANCH IF LENGTH IS POSITIVE.
	M_MESS	<Blank-fill length /!XL/ not positive>,<R6>
	BRW	30$			;EXIT.
1201$:
	MOVB	#^A/ /,(R11)+		;BLANK FILL.
	SOBGTR	R6,201$			;LOOP TILL DONE.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	VOL1 LABEL ID ACTION ROUTINE
;
;
;VOL1 LABEL ID ACTION ROUTINE.
;
;IF TRANSFER FROM IBM TO VAX:
;
;	IF FIRST VOLUME:
;
;		1.	VERIFY VOL1 ID.(ASCII BUFFER).
;
;	IF SECOND VOLUME:
;
;		1.	VERIFY VOL1 ID.(ASCII 2 BUFFER).
;
;IF TRANSFER FROM VAX TO IBM:
;
;	IF FIRST VOLUME:
;
;		1.	WRITE VOL1 ID INTO ASCII BUFFER.
;
;	IF SECOND VOLUME:
;
;		1.	RETURN.
;
AC_MTVOL1LBLID:				;VOL1 LABEL ID ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE ADDRESS.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	.IF	DF	DEBUG
	M_MESS	<AC_MTVOL1LBLID>
	.ENDC
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST TAPE, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO FIELD.
	CMPC3	OF_ACTTBL_LEN(R7),(R10),OF_LBLTBL_ID(R8)	;COMPARE.
	M_IF_EQL	101$		;BRANCH IF EQUAL.
	M_MESS	<Bad VOL1 label ID /!AF/>,<OF_ACTTBL_LEN(R7),R10>;TELL USER.
	BRW	30$			;EXIT.
101$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO FIELD.
	MOVC3	OF_ACTTBL_LEN(R7),OF_LBLTBL_ID(R8),(R10)	;MOVE INTO BUFFER.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	ADDL	OF_ACTTBL_OFF(R7),R11	;POINT TO FIELD.
	CMPC3	OF_ACTTBL_LEN(R7),(R11),OF_LBLTBL_ID(R8)	;COMPARE.
	M_IF_EQL	1101$		;BRANCH IF EQUAL.
	M_MESS	<Bad VOL1 label ID /!AF/>,<OF_ACTTBL_LEN(R7),R11>;TELL USER.
	BRW	30$			;EXIT.
1101$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	VOL1 SERIAL NUMBER ACTION ROUTINE
;
;
;VOL1 SERIAL NUMBER ACTION ROUTINE.
;
;IF TRANSFER FROM IBM TO VAX:
;
;	1.	RETURN.
;
;IF TRANSFER FROM VAX TO IBM:
;
;	FIRST VOLUME:
;
;		IF CREATE LABEL:
;
;			1.PROMPT FOR SERIAL NUMBER AND WRITE IT TO ASCII BUFFER.
;
;	SECOND VOLUME:
;
;		IF CREATE NUMBER:
;
;			1.PROMPT FOR SERIAL NUMBER AND WRITE IT TO ASCII 2 BUFFER.
;
;
AC_MTVOL1SER:				;VOL1 SERIAL NUMBER ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	.IF	DF	DEBUG
	M_MESS	<AC_MTVOL1SER>
	.ENDC
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE POINTER.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE POINTER.
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST TAPE, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	TSTB	VOL1MOD			;CREATE LABEL??
	M_IF_EQL	20$		;RETURN IF NOT CREATE LABEL.
201$:
	MOVL	#DEF_VOLSER,VOLSER	;MOVE IN DEFAULT SERIAL NUMBER.
	M_GTINP	<Enter volume serial number [999999]: >
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	TSTL	L_INPDESC		;ANY INPUT??
	M_IF_EQL	202$		;BRANCH IF NO INPUT.
	MOVL	L_INPDESC,TPARSE_PAR+TPA$L_STRINGCNT	;SET INPUT SIZE.
	MOVL	L_INPDESC+4,TPARSE_PAR+TPA$L_STRINGPTR	;SET INPUT ADDRESS.
	PUSHAL	T_AVATUKTB		;KEY TABLE.
	PUSHAL	T_DECIMAL		;STARTING STATE.
	PUSHAL	TPARSE_PAR		;TPARSE PARAMETER BLOCK.
	CALLS	#3,G^LIB$TPARSE		;PARSE LINE.
	M_ONTPAERR	201$,TPARSE_PAR,<SYSONLY>	;TRY AGAIN IF ERROR.
	MOVL	TL_NUMBER,VOLSER	;STORE VOLUME SERIAL NUMBER.
202$:
	MOVL	OF_ACTTBL_LEN(R7),CVTDESC	;LENGTH OF STRING IN BUFFER.
	MOVL	OF_ACTTBL_OFF(R7),CVTDESC+4	;OFFSET.
	ADDL	R10,CVTDESC+4		;ADD IN BUFFER START ADDRESS.
	PUSHL	CVTDESC			;NUMBER OF DIGITS IN STRING.
	PUSHAL	CVTDESC			;OUTPUT STRING DESC.
	PUSHAL	VOLSER			;VOLUME SERIAL NUMBER.
	CALLS	#3,G^OTS$CVT_L_TI		;CONVERT BINARY TO TEXT.
	M_ON0ERR	30$,<Unable to convert /!UL/>,<VOLSER>
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	TSTB	VOL1MOD			;CREATE LABEL??
	M_IF_EQL	20$		;RETURN IF NOT CREATE LABEL.
1201$:
	MOVL	#DEF_VOLSER,VOLSER	;MOVE IN DEFAULT SERIAL NUMBER.
	M_GTINP	<Enter volume serial number [999999]: >
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	TSTL	L_INPDESC		;ANY INPUT??
	M_IF_EQL	1202$		;BRANCH IF NO INPUT.
	MOVL	L_INPDESC,TPARSE_PAR+TPA$L_STRINGCNT	;SET INPUT SIZE.
	MOVL	L_INPDESC+4,TPARSE_PAR+TPA$L_STRINGPTR	;SET INPUT ADDRESS.
	PUSHAL	T_AVATUKTB		;KEY TABLE.
	PUSHAL	T_DECIMAL		;STARTING STATE.
	PUSHAL	TPARSE_PAR		;TPARSE PARAMETER BLOCK.
	CALLS	#3,G^LIB$TPARSE		;PARSE LINE.
	M_ONTPAERR	1201$,TPARSE_PAR,<SYSONLY>	;TRY AGAIN IF ERROR.
	MOVL	TL_NUMBER,VOLSER	;STORE VOLUME SERIAL NUMBER.
1202$:
	MOVL	OF_ACTTBL_LEN(R7),CVTDESC	;LENGTH OF STRING IN BUFFER.
	MOVL	OF_ACTTBL_OFF(R7),CVTDESC+4	;OFFSET.
	ADDL	R11,CVTDESC+4		;ADD IN BUFFER START ADDRESS.
	PUSHL	CVTDESC			;NUMBER OF DIGITS IN STRING.
	PUSHAL	CVTDESC			;OUTPUT STRING DESC.
	PUSHAL	VOLSER			;VOLUME SERIAL NUMBER.
	CALLS	#3,G^OTS$CVT_L_TI		;CONVERT BINARY TO TEXT.
	M_ON0ERR	30$,<Unable to convert /!UL/>,<VOLSER>
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	DSL1 LABEL ID ACTION ROUTINE
;
;
;DSL1 LABEL ID ACTION ROUTINE.
;
;IF TRANSFER FROM IBM TO VAX:
;
;	IF FIRST VOLUME:
;
;		1.	VERFIY LABEL ID IN ASCII BUFFER.
;
;	IF SECOND VOLUME:
;
;		1.	VERIFY LABEL ID IN ASCII 2 BUFFER.
;
;IF TRANSFER FROM VAX TO IBM:
;
;	IF FIRST VOLUME:
;
;		1.	WRITE LABEL ID IN ASCII BUFFER.
;
;	IF SECOND VOLUME:
;
;		1.	RETURN.
;
AC_MTDSL1LBLID:				;DSL1 LABEL ID ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE ADDRESS.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	.IF	DF	DEBUG
	M_MESS	<AC_MTDSL1LBLID>
	.ENDC
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST VOLUME, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO FIELD.
	CMPC3	OF_ACTTBL_LEN(R7),(R10),OF_LBLTBL_ID(R8)	;COMPARE.
	M_IF_EQL	101$		;BRANCH IF MATCHED.
	M_MESS	<Bad DSL1 label ID /!AF/>,<OF_ACTTBL_LEN(R7),R10>
	BRW	30$			;EXIT.
101$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO FIELD.
	MOVC3	OF_ACTTBL_LEN(R7),OF_LBLTBL_ID(R8),(R10)	;MOVE LABEL ID.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	ADDL	OF_ACTTBL_OFF(R7),R11	;POINT TO FIELD.
	CMPC3	OF_ACTTBL_LEN(R7),(R11),OF_LBLTBL_ID(R8)	;COMPARE.
	M_IF_EQL	1101$		;BRANCH IF MATCHED.
	M_MESS	<Bad DSL1 label ID /!AF/>,<OF_ACTTBL_LEN(R7),R11>
	BRW	30$			;EXIT.
1101$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	DSL DATA SET ID ACTION ROUTINE
;
;
;DSL DATA SET ID ACTION ROUTINE.
;
;IF TRANSFER FROM IBM TO VAX:
;
;	1.	RETURN.
;
;IF TRANSFER FORM VAX TO IBM:
;
;	IF FIRST VOLUME:
;
;		IF HDR1:
;
;			1.	PROMPT FOR DATASET ID AND WRITE IT.
;
;		IF OTHER:
;
;			1.	WRITE DS ID.
;
;	IF SECOND VOLUME:
;
;		1.	RETURN.
;
;
AC_MTDSL1DSID:				;DSL DATA SET ID ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	.IF	DF	DEBUG
	M_MESS	<AC_MTDSL1DSID>
	.ENDC
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE POINTER.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST VOLUME, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	CMPL	#LBL_HDR1,LBLTBL_PTR	;HDR1??
	M_IF_NEQ	202$		;BRANCH IF NOT NDR1.
201$:
	MOVC5	DEF_DSIDDESC,@DEF_DSIDDESC+4,#^A/ /,DSIDDESC,@DSIDDESC+4
					;MOVE IN DEFAULT DATASET ID.
	M_GTINP	<Enter dataset ID [MPDVAX.DAT]: >	;PROMPT.
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	TSTL	L_INPDESC		;ANY INPUT??
	M_IF_EQL	202$		;BRANCH IF NO INPUT.
	MOVL	L_INPDESC,TPARSE_PAR+TPA$L_STRINGCNT	;SET INPUT SIZE.
	MOVL	L_INPDESC+4,TPARSE_PAR+TPA$L_STRINGPTR	;SET INPUT ADDRESS.
	PUSHAL	T_AVATUKTB		;KEYTABLE.
	PUSHAL	T_DSID			;STARTING STATE.
	PUSHAL	TPARSE_PAR		;TPARSE PARAMETER BLOCK.
	CALLS	#3,G^LIB$TPARSE		;PARSE LINE.
	M_ONTPAERR	201$,TPARSE_PAR,<SYSONLY>	;TRY AGAIN IF ERROR.
	MOVC5	L_INPDESC,@L_INPDESC+4,#^A/ /,DSIDDESC,@DSIDDESC+4 ;STORE DS ID.
202$:
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO FIELD IN ASCII BUFFER.
	MOVC5	DSIDDESC,@DSIDDESC+4,#^A/ /,OF_ACTTBL_LEN(R7),(R10)
					;MOVE DSID TO ASCII BUFFER.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	DSL1 DATA SET SEQUENCE NUMBER ACTION ROUTINE
;
;
;DSL1 DATA SET SEQUENCE NUMBER ACTION ROUTINE.
;
;IF TRANSFER FROM IBM TO VAX:
;
;	1.	RETURN.
;
;IF TRANSFER FROM VAX TO IBM:
;
;	IF FIRST VOLUME:
;
;		1.	WRITE DSSEQ+1 TO ASCII BUFFER.
;
;	IF SECOND VOLUME:
;
;		1.	RETURN.
;
;
AC_MTDSL1DSSEQ:				;DSL1 DATA SET SEQUENCE NUMBER ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	.IF	DF	DEBUG
	M_MESS	<AC_MTDSL1DSSEQ>
	.ENDC
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE POINTER.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE POINTER.
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST VOLUME, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	MOVL	DSSEQ,DSSEQACT		;DATASET SEQUENCE NUMBER.
	INCL	DSSEQACT			;ADD ONE.
	MOVL	OF_ACTTBL_LEN(R7),CVTDESC	;FIELD SIZE IN ASCII BUFFER.
	MOVL	OF_ACTTBL_OFF(R7),CVTDESC+4	;FIELD OFFSET IN ASCII BUFFER.
	ADDL	R10,CVTDESC+4		;ADD IN ASCII BUFFER ADDRESS.
	PUSHL	CVTDESC			;NUMBER OF DIGITS IN FIELD.
	PUSHAL	CVTDESC			;CONVERT DESC.
	PUSHAL	DSSEQACT		;ACTUAL DS SEQ.
	CALLS	#3,G^OTS$CVT_L_TI		;CONVERT BINARY TO TEXT.
	M_ON0ERR	30$,<Unable to convert /!UL/>,<DSSEQACT>
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	DSL1 EXPIRATION DATE ACTION ROUTINE
;
;
;DSL1 EXPIRATION DATE ACTION ROUTINE.
;
;IF TRANSFER FROM IBM TO VAX:
;
;	1.	RETURN.
;
;IF TRANSFER FROM VAX TO IBM:
;
;	IF FIRST VOLUME:
;
;		1.	WRITE EXPIRATION DATWE TO ASCII BUFFER.
;
;
;	IF SECOND VOLUME:
;
;		1.	RETURN.
;
;
AC_MTDSL1EXPDAT:				;DSL1 EXPIRATION DATE ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	.IF	DF	DEBUG
	M_MESS	<AC_MTDSL1EXPDAT>
	.ENDC
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE POINTER.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST VOLUME, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO FIELD IN ASCII BUFFER.
	MOVC5	EXPDATDESC,@EXPDATDESC+4,#^A/ /,OF_ACTTBL_LEN(R7),(R10)
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	DSL1 DATA SET BLOCK COUNT ACTION ROUTINE
;
;
;DSL1 DATA SET BLOCK COUNT ACTION ROUTINE.
;
;
;IF TRANSFER IS FROM IBM TO VAX:
;
;	FIRST VOLUME:
;
;		IF HDR1:
;
;			1.	VERIFY BLOCNT IS 0.
;			2.	CLEAR ACCUM FOR BLOCK COUNT.
;
;		IF OTHER:
;
;			1.	COMPARE BLOCNT TO ACCUM BLOCK COUNT.
;
;	SECOND VOLUME:
;
;		IF HDR1:
;
;			1.	RETURN.
;
;		IF OTHER:
;
;			1.	ERROR.
;
;
;IF TRANSFER IS FROM VAX TO IBM:
;
;	FIRST VOLUME:
;
;		IF HDR1:
;
;			1.	WRITE 0 TO BLOCNT.
;			2.	CLEAR ACCUM FOR BLOCK COUNT.
;
;		IF OTHER:
;
;			1.	WRITE ACCUM BLOCK COUNT.
;
;	SECOND VOLUME:
;
;		IF HDR1:
;
;			1.	RETURN.
;
;		IF OTHER:
;
;			1.	ERROR.
;
;
AC_MTDSL1BLOCNT:				;DATA SET BLOCK COUNT ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE POINTER.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	.IF	DF	DEBUG
	M_MESS	<AC_MTDSL1BLOCNT>
	.ENDC
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST VOLUME, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	CMPL	#LBL_HDR1,LBLTBL_PTR	;HDR1 LABEL??
	M_IF_NEQ	101$		;BRANCH IF NOT.
;
;HDR1.
;
	MOVL	OF_ACTTBL_LEN(R7),CVTDESC	;SET UP ASCII TO BINARY CONVERSIO
						;OF BLOCNT.
	MOVL	OF_ACTTBL_OFF(R7),CVTDESC+4	;ASCII TEXT OFFSET.
	ADDL	R10,CVTDESC+4			;ADD IN STARTING ADDRESS.
	PUSHAL	BLOCNT			;RESULT BINARY STORE.
	PUSHAL	CVTDESC			;TEXT STRING DESCIPTOR.
	CALLS	#2,G^OTS$CVT_TI_L		;CONVERT TEXT TO INTEGER.
	M_ON0ERR	30$,<Unable to convert /!AF/>,<CVTDESC,CVTDESC+4> ;EXIT IF ERROR.
	TSTL	BLOCNT			;MUST BE ZERO.
	M_IF_EQL	102$		;BRANCH IF ZERO.
	M_MESS	<Non-zero HDR1 block count /!XL/>,<BLOCNT>
	BRW	30$			;EXIT.
102$:
	CLRL	BLOCNTACCUM		;CLEAR ACCUMINATOR FOR BLOCK COUNT.
	BRW	20$		;RETURN. C-BIT CLEARED.
101$:
;
;NOT HDR1.
;
	MOVL	OF_ACTTBL_LEN(R7),CVTDESC	;SET UP ASCII TO BINARY CONVERSIO
						;OF BLOCNT.
	MOVL	OF_ACTTBL_OFF(R7),CVTDESC+4	;ASCII TEXT OFFSET.
	ADDL	R10,CVTDESC+4			;ADD IN STARTING ADDRESS.
	PUSHAL	BLOCNT			;RESULT BINARY STORE.
	PUSHAL	CVTDESC			;TEXT STRING DESCIPTOR.
	CALLS	#2,G^OTS$CVT_TI_L		;CONVERT TEXT TO INTEGER.
	M_ON0ERR	30$,<Unable to convert /!AF/>,<CVTDESC,CVTDESC+4> ;EXIT IF ERROR.
	CMPL	BLOCNT,BLOCNTACCUM	;MUST MATCH WITH INTERNAL BLOCK COUNT ACCUM.
	M_IF_EQL	103$		;BRANCH IF MATCHED.
	M_MESS	<Blockcount /!XL/ not matched with /!XL/>,<BLOCNT,BLOCNTACCUM>
	BRW	30$			;EXIT.
103$:
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	CMPL	#LBL_HDR1,LBLTBL_PTR	;HDR1 LABEL??
	M_IF_NEQ	201$		;BRANCH IF NOT HDR1.
;
;HDR1.
;
	CLRL	BLOCNT			;START WITH ZERO FOR HDR1.
	MOVL	OF_ACTTBL_LEN(R7),CVTDESC	;SET UP ASCII TO BINARY CONVERSIO
						;OF BLOCNT.
	MOVL	OF_ACTTBL_OFF(R7),CVTDESC+4	;ASCII TEXT OFFSET.
	ADDL	R10,CVTDESC+4			;ADD IN STARTING ADDRESS.
	PUSHL	CVTDESC			;# OF DIGITS IN OUTPUT.
	PUSHAL	CVTDESC			;TEXT STRING DESCIPTOR.
	PUSHAL	BLOCNT			;BINARY STORE.
	CALLS	#3,G^OTS$CVT_L_TI		;CONVERT BINARY TO TEXT STRING.
	M_ON0ERR	30$,<Unable to convert /!XL/>,<BLOCNT> ;EXIT IF ERROR.
	CLRL	BLOCNTACCUM		;CLEAR ACCUMINATOR FOR BLOCK COUNT.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;NOT HDR1.
;
201$:
	MOVL	OF_ACTTBL_LEN(R7),CVTDESC	;SET UP ASCII TO BINARY CONVERSIO
						;OF BLOCNT.
	MOVL	OF_ACTTBL_OFF(R7),CVTDESC+4	;ASCII TEXT OFFSET.
	ADDL	R10,CVTDESC+4			;ADD IN STARTING ADDRESS.
	PUSHL	CVTDESC			;# OF DIGITS IN OUTPUT.
	PUSHAL	CVTDESC			;TEXT STRING DESCIPTOR.
	PUSHAL	BLOCNTACCUM		;BINARY STORE.
	CALLS	#3,G^OTS$CVT_L_TI		;CONVERT BINARY TO TEXT STRING.
	M_ON0ERR	30$,<Unable to convert /!XL/>,<BLOCNTACCUM> ;EXIT IF ERROR.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	CMPL	#LBL_HDR1,LBLTBL_PTR	;HDR1??
	M_IF_EQL	1101$		;BRANCH IF HDR1.
PCCUR=.
	M_MESS	<Internal error at PC=!XL>,<#PCCUR>
	BRW	30$			;EXIT.
1101$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	CMPL	#LBL_HDR1,LBLTBL_PTR	;HDR1??
	M_IF_EQL	1201$		;BRANCH IF HDR1.
PCCUR=.
	M_MESS	<Internal error at PC=!XL>,<#PCCUR>
	BRW	30$			;EXIT.
1201$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	DSL2 LABEL ID ACTION ROUTINE
;
;
;DSL2 LABEL ID ACTION ROUTINE.
;
;IF TRANSFER FROM IBM TO VAX:
;
;	IF FIRST VOLUME:
;
;		1.	VERIFY LABEL ID IN ASCII BUFFER.
;
;	IF SECOND VOLUME:
;
;		1.	VERIFY LABEL ID IN ASCII 2 BUFFER.
;
;IF TRANSFER FROM VAX TO IBM:
;
;	IF FIRST VOLUME:
;
;		1.	WRITE LABEL ID IN ASCII BUFFER.
;
;	IF SECOND VOLUME:
;
;		1.	RETURN.
;
AC_MTDSL2LBLID:				;DSL2 LABEL ID ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE ADDRESS.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	.IF	DF	DEBUG
	M_MESS	<AC_MTDSL2LBLID>
	.ENDC
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST VOLUME, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO FIELD.
	CMPC3	OF_ACTTBL_LEN(R7),(R10),OF_LBLTBL_ID(R8)	;COMPARE.
	M_IF_EQL	101$		;BRANCH IF MATCHED.
	M_MESS	<Bad DSL2 label ID /!AF/>,<OF_ACTTBL_LEN(R7),R10>
	BRW	30$			;EXIT.
101$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO FIELD.
	MOVC3	OF_ACTTBL_LEN(R7),OF_LBLTBL_ID(R8),(R10)	;MOVE INTO ASCII BUFFER.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	ADDL	OF_ACTTBL_OFF(R7),R11	;POINT TO FIELD.
	CMPC3	OF_ACTTBL_LEN(R7),(R11),OF_LBLTBL_ID(R8)	;COMPARE.
	M_IF_EQL	1101$		;BRANCH IF MATCHED.
	M_MESS	<Bad DSL2 label ID /!AF/>,<OF_ACTTBL_LEN(R7),R11>
	BRW	30$			;EXIT.
1101$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	DSL2 RECORD FORMAT ACTION ROUTINE
;
;
;DSL2 RECORD FORMAT ACTION ROUTINE.
;
;
;IF TRANSFER IS FROM IBM TO VAX:
;
;	FIRST VOLUME:
;
;		IF HDR2:
;
;			1.	CHECK RECORD FORMAT CODE (V,F,U) AND SET RFM INDICATOR.
;
;		IF OTHER:
;
;			1.	RETURN.
;
;	SECOND VOLUME:
;
;		IF HDR2:
;
;			1.	COMPARE OLD RECORD FORMAT TO CURRENT RECORD FORMAT.
;
;		IF OTHER:
;
;			1.	ERROR.
;
;IF TRANSFER IS FROM VAX TO IBM:
;
;	FIRST VOLUME:
;
;		1.	WRITE 'V'.
;
;	SECOND VOLUME:
;
;		IF HDR2:
;
;			1.	RETURN.
;
;		IF OTHER:
;
;			1.	ERROR.
;
;
AC_MTDSL2RFM:				;DSL2 RECORD FORMAT ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE ADDRESS.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	.IF	DF	DEBUG
	M_MESS	<AC_MTDSL2RFM>
	.ENDC
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST VOLUME, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	CMPL	#LBL_HDR2,LBLTBL_PTR	;HDR2??
	M_IF_NEQ	20$		;RETURN IF NOT HDR2.
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO FIELD.
	CMPB	(R10),#^A/V/		;VARIABLE LENGTH??
	M_IF_EQL	101$		;BRANCH IF VARIABLE.
	CMPB	(R10),#^A/F/		;FIX LENGTH??
	M_IF_EQL	102$		;BRANCH IF FIX LENGTH.
;
	MOVL	#1,CVTDESC		;GET READY TO OUTPUT ERROR MESSAGE.
	MOVAL	(R10),CVTDESC+4		;ADDRESS OF FORMAT TYPE.
	M_MESS	<Record format /!AF/ not implemented yet>,<CVTDESC,CVTDESC+4>
	BRW	30$			;EXIT.
101$:
	MOVB	#0,RFM			;INDICATE VARIABLE LENGTH.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
102$:
	MOVB	#1,RFM			;INDICATE FIX LENGTH.
	BRW	20$			;RETURN C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO FIELD.
	MOVB	#^A/V/,(R10)		;ALWAYS WRITE VARIABLE LENGTH.
	MOVB	#0,RFM			;INDICATE VARIABLE LENGTH.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	CMPL	#LBL_HDR2,LBLTBL_PTR	;HDR2??
	M_IF_EQL	1101$		;BRANCH IF HDR2.
PCCUR=.
	M_MESS	<Internal error at PC=!XL>,<#PCCUR>
	BRW	30$			;EXIT.
1101$:
	ADDL	OF_ACTTBL_OFF(R7),R10	;POIN TO FIELD IN ASCII BUFFER.
	ADDL	OF_ACTTBL_OFF(R7),R11	;POINT TO FIELD IN ASCII 2 BUFFER.
	CMPC3	OF_ACTTBL_LEN(R7),(R10),(R11)	;COMPARE.
	M_IF_EQL	1102$		;BRANCH IF MATCHED.
	M_MESS	<Record format changed from /!AF/ TO /!AF/>,-
		<OF_ACTTBL_LEN(R7),R10,OF_ACTTBL_LEN(R7),R11>
	BRW	30$			;EXIT.
1102$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	CMPL	#LBL_HDR2,LBLTBL_PTR	;HDR2??
	M_IF_EQL	1201$		;BRANCH IF HDR2.
PCCUR=.
	M_MESS	<Internal error at PC=!XL>,<#PCCUR>
	BRW	30$			;EXIT.
1201$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	DSL2 BLOCK LENGTH ACTION ROUTINE
;
;
;DSL2 BLOCK LENGTH ACTION ROUTINE.
;
;
;IF TRANSFER IS FROM IBM TO VAX:
;
;	FIRST VOLUME:
;
;		IF HDR2:
;
;			1.	CONVERT BLOCK LENGTH STRING TO BINARY.
;			2.	INIT MTPOOL.
;
;		IF OTHER:
;
;			1.	RETURN.
;
;	SECOND VOLUME:
;
;		IF HDR2:
;
;			1.	COMPARE BLOCK LENGTH TO OLD BLOCK LEN.
;
;		IF OTHER:
;
;			1.	ERROR.
;
;IF TRANSFER FROM VAX TO IBM.
;
;	FIRST VOLUME:
;
;		IF HDR2:
;
;			1.	PROMPT FOR BLOCK LEN.
;			1A.	WRITE IT.
;			2.	INIT MTPOOL.
;
;		IF OTHER:
;
;			1.	WRITE BLOCK LEN.
;
;	SECOND VOLUME:
;
;		IF HDR2:
;
;			1.	RETURN.
;
;		IF OTHER:
;
;			1.	ERROR.
;
;
AC_MTDSL2BLOLEN:			;DSL2 BLOCK LENGTH ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE POINTER.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	.IF	DF	DEBUG
	M_MESS	<AC_MTDSL2BLOLEN>
	.ENDC
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST VOLUME, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	CMPL	#LBL_HDR2,LBLTBL_PTR	;HDR2??
	M_IF_NEQ	20$		;RETURN IF NOT.
;
;HDR2.
;
	MOVL	OF_ACTTBL_LEN(R7),CVTDESC	;CONVERT BLOCK LEN STRING TO
						;BINARY. SET STRING LENGTH.
	MOVL	OF_ACTTBL_LEN(R7),CVTDESC+4	;SET STRING OFFSET.
	ADDL	R10,CVTDESC+4		;ADD IN BUFFER START.
	PUSHAL	BLOLEN			;RESULT BINARY STORE.
	PUSHAL	CVTDESC			;TEST STRING DESCRIPTOR.
	CALLS	#2,G^OTS$CVT_TI_L		;CONVERT.
	M_ON0ERR	30$,<Unable to convert /!AF/>,<CVTDESC,CVTDESC+4>;EXIT IF ERROR.
	JSB	INITMTPOOL		;INIT MTPOOL.
	M_IF_CS	30$			;EXIT IF ERROR.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	CMPL	#LBL_HDR2,LBLTBL_PTR	;HDR2??
	M_IF_NEQ	202$		;BRANCH IF NOT HDR2.
203$:
	MOVL	#DEF_BLOLEN,BLOLEN	;MOVE IN DEFAULT BLOCK SIZE.
	M_GTINP	<Enter magtape block size in bytes [400]: >
	M_ON0ERR	30$,<SYSONLY>	;EXIT IF ERROR.
	TSTL	L_INPDESC		;ANY INPUT??
	M_IF_EQL	202$		;IF NO INPUT, USE DEFAULT.
	MOVL	L_INPDESC,TPARSE_PAR+TPA$L_STRINGCNT	;SET INPUT SIZE.
	MOVL	L_INPDESC+4,TPARSE_PAR+TPA$L_STRINGPTR	;SET INPUT ADDRESS.
	PUSHAL	T_AVATUKTB		;KEY TABLE.
	PUSHAL	T_DECIMAL		;STARTING STATE.
	PUSHAL	TPARSE_PAR		;TPARSE PARAMETER BLOCK.
	CALLS	#3,G^LIB$TPARSE		;PARSE LINE.
	M_ONTPAERR	203$,TPARSE_PAR,<SYSONLY>	;TRY AGAIN IF ERROR.
	MOVL	TL_NUMBER,BLOLEN	;STORE NUMBER.
202$:
	MOVL	OF_ACTTBL_LEN(R7),CVTDESC	;SET UP BINARY TO ASCII CONVERSION.
	MOVL	OF_ACTTBL_OFF(R7),CVTDESC+4	;OUTPUT STRING OFFSET.
	ADDL	R10,CVTDESC+4		;ADD IN BUFFER START.
	PUSHL	CVTDESC			;NUMBER OF DIGITS IN OUTPUT.
	PUSHAL	CVTDESC			;OUTPUT STRING DESCRIPTOR.
	PUSHAL	BLOLEN			;BLOCK LENGTH.
	CALLS	#3,G^OTS$CVT_L_TI		;CONVERT BINARY TO ASCII.
	M_ON0ERR 30$,<Unable to convert /!XL/>,<BLOLEN>	;EXIT IF ERROR.
	CMPL	#LBL_HDR2,LBLTBL_PTR	;LABEL TABLE ADDRESS.
	M_IF_NEQ	201$		;BRANCH IF NOT HDR2.
	JSB	INITMTPOOL		;INIT MT POOL POINTERS AND TABLES.
	M_IF_CS	30$			;EXIT IF ERROR.
201$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	CMPL	#LBL_HDR2,LBLTBL_PTR	;HDR2??
	M_IF_EQL	1101$		;BRANCH IF HDR2.
PCCUR=.
	M_MESS	<Internal error at PC=!XL>,<#PCCUR>	;TELL USER.
	BRW	30$			;EXIT.
1101$:
;
;HDR2.
;
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO BLOCK LEN IN ASCII BUF.
	ADDL	OF_ACTTBL_OFF(R7),R11	;POINT TO BLOCK LEN IN ASCII 2 BUF.
	CMPC3	OF_ACTTBL_LEN(R7),(R10),(R11)	;MUST BE SAME BLOCK LENGTH.
	M_IF_EQL	1102$		;BRANCH IF EQUAL.
	M_MESS	<Block length changed from /!AF/ to /!AF/>,-
		<OF_ACTTBL_LEN(R7),R10,OF_ACTTBL_LEN(R7),R11>	;TELL USER ERROR.
	BRW	30$			;EXIT.
1102$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	CMPL	#LBL_HDR2,LBLTBL_PTR	;HDR2??
	M_IF_EQL	1201$		;BRANCH IF HDR2.
PCCUR=.
	M_MESS	<Internal error at PC=!XL>,<#PCCUR>
	BRW	30$			;EXIT.
1201$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	DSL2 RECORD LENGTH ACTION ROUTINE
;
;
;DSL2 RECORD LENGTH ACTION ROUTINE.
;
;IF TRANSFER FROM IBM TO VAX:
;
;	IF FIRST VOLUME:
;
;		IF HDR2:
;
;			1.	CONVERT RECORD LENGTH IN ASCII BUFFER TO BINARY.
;			2.	SET NEW FILE RECORD SIZE.
;			2A.	SET NEW FILE MULTI BLOCK COUNT.
;			3.	INIT VAX POOL.
;
;		IF OTHER:
;
;			1.	RETURN.
;
;	IF SECOND VOLUME:
;
;		IF HDR2:
;
;			1.	COMPARE RECORD LENGTH TO OLD RECORD LENGTH.
;
;		IF OTHER:
;
;			1.	ERROR.
;
;IF TRANSFER FROM VAX TO IBM:
;
;	IF FIRST VOLUME:
;
;		IF HDR2:
;
;			1.	GET OLD FILE RECORD SIZE.
;			1A.	WRITE FILE RECORD SZIE.
;			1B.	SET OLD FILE MULTIBLOCT COUNT.
;			1C.	CONNECT OLD FILE.
;			2.	INIT VAX POOL.
;
;		IF OTHER:
;
;			0.	GET OLD FILE RECORD SIZE.
;			1.	WRITE FILE RECORD SIZE.
;
AC_MTDSL2RECLEN:				;DSL2 RECORD LENGTH ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE ADDRESS.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	.IF	DF	DEBUG
	M_MESS	<AC_MTDSL2RECLEN>
	.ENDC
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST VOLUME, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	CMPL	#LBL_HDR2,LBLTBL_PTR	;HDR2??
	M_IF_NEQ	20$		;RETURN IF NOT HDR2.
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	MOVL	OF_ACTTBL_LEN(R7),CVTDESC	;CONVERT RECORD LENGTH TO BINARY. SET STRING SIZE.
	MOVL	OF_ACTTBL_OFF(R7),CVTDESC+4	;SET STRING OFFSET.
	ADDL	R10,CVTDESC+4		;POINT TO STRING.
	PUSHAL	RECLEN			;BINARY STORE FOR RECORD LENGTH.
	PUSHAL	CVTDESC			;STRING DESCRIPTOR.
	CALLS	#2,G^OTS$CVT_TI_L		;CONVERT STRING TO BINARY.
	M_ON0ERR 30$,<Unable to convert /!AF/>,<CVTDESC,CVTDESC+4>
	JSB	INITVAXPOOL		;INIT VAX POOL.
	M_IF_CS	30$			;EXIT IF ERROR.
	MOVW	RECLEN,NEWFAB+FAB$W_MRS	;INIT NEW FILE MAXIMUM RECORD SIZE.
	MOVL	RECLEN,R3		;CALCULATE BLOCK COUNT.
	ADDL	#512.,R3			;
	DIVL	#512,R3			;
	MULL	#3,R3
	MOVB	R3,NEWRAB+RAB$B_MBC	;SET NEW FILE MBC.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	MOVZWL	OLDFAB+FAB$W_MRS,RECLEN	;TRY FAB.
	TSTL	RECLEN				;GOT IT??
	BNEQ	202$			;BRANCH IF NOT ZZERO.
	MOVZWL	OLDXAB+XAB$W_LRL,RECLEN		;GET RECORD SIZE.
202$:
	MOVL	ACTTBL_PTR,R7			;ACTION TABLE ADDRESS.
	MOVL	OF_ACTTBL_LEN(R7),CVTDESC	;SET UP FOR BINARY TO ASCII.
						;SET STRING SIZE.
	MOVL	OF_ACTTBL_OFF(R7),CVTDESC+4	;SET STRING ADDRESS.
	ADDL	R10,CVTDESC+4			;
	PUSHL	CVTDESC				;NUMBER OF DIGITS IN OUTPUT.
	PUSHAL	CVTDESC				;STRING DESCRIPTOR.
	PUSHAL	RECLEN				;BINARY NUMBER.
	CALLS	#3,G^OTS$CVT_L_TI			;CONVERT BINARY TO STRING.
	M_ON0ERR 30$,<Unable to convert /!XL/>,<RECLEN>
	CMPL	#LBL_HDR2,LBLTBL_PTR		;HDR2.
	M_IF_NEQ	201$			;BRANCH IF NOT HDR2.
	MOVL	RECLEN,R3		;CALCULATE BLOCK COUNT.
	ADDL	#512,R3			;
	DIVL	#512,R3			;
	MULL	#3,R3
	MOVB	R3,OLDRAB+RAB$B_MBC	;SET OLD FILE MBC.
;
;CONNECT OLD FILE.
;
	$CONNECT	RAB=OLDRAB,-	;CONNECT OLD FILE.
			ERR=J_RMAER	;ERROR COMPLETION ROUTINE.
	M_ON0ERR	30$		;EXIT IF ERROR.
	BISL	#X_OLDCON,XTLLONG	;REMEMBER OLD FILE CONNECTED.
	JSB	INITVAXPOOL			;INIT VAX POOL.
	M_IF_CS	30$				;EXIT IF ERROR.
201$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	CMPL	#LBL_HDR2,LBLTBL_PTR		;HDR2??
	M_IF_EQL	1101$			;BRANCH IF HDR2.
PCCUR=.
	M_MESS	<Internal error at PC=!XL>,<#PCCUR>
	BRW	30$			;EXIT.
1101$:
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO RECORD LEN IN ASCII.
	ADDL	OF_ACTTBL_OFF(R7),R11	;POINT TO RECORD LEN IN ASCII 2.
	CMPC3	OF_ACTTBL_LEN(R7),(R10),(R11)	;COMPARE.
	M_IF_EQL	1102$		;BRANCH IF EQUAL.
	M_MESS	<Record length changed from /!AF/ to /!AF/>,-
		<OF_ACTTBL_LEN(R7),R10,OF_ACTTBL_LEN(R7),R11>
	BRW	30$			;EXIT.
1102$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	CMPL	#LBL_HDR2,LBLTBL_PTR	;HDR2??
	M_IF_EQL	1201$		;BRANCH IF HDR2.
PCCUR=.
	M_MESS	<Internal error at PC=!XL><#PCCUR>
	BRW	30$			;EXIT.
1201$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
.PAGE
.SUBTITLE	DSL2 BLOCK ATTRIBUTE ACTION ROUTINE
;
;
;DSL2 BLOCK ATTRIBUTE ACTION ROUTINE.
;
;IF TRANSFER FROM IBM TO VAX:
;
;	IF FIRST VOLUME:
;
;		IF HDR2:
;
;			1.	CHECK BLOCK ATTRIBUTE (B,R,S,BLANK) AND SET
;				BLOCK ATTRIBUTE INDICATOR.
;			2.	INDICATE BLOCK ATTRIBUTE.
;
;		IF OTHER:
;
;			1.	RETURN.
;
;	IF SECOND VOLUME:
;
;		IF HDR2:
;
;			1.	COMPARE OLD BLOCK ATTRIBUTE.
;
;		IF OTHER:
;
;			1.	ERROR.
;
;IF TRANSFER FROM VAX TO IBM.
;
;	IF FIRST VOLUME:
;
;		1.	ALWAYS WRITE 'R'.
;		2.	INDICATE BLOCK ATTRIBUTE.
;
;	IF SECOND VOLUME:
;
;		IF HDR2:
;
;			1.	RETURN.
;
;		IF OTHER:
;
;			1.	ERROR.
;
;
AC_MTDSL2BLOATT:				;DSL2 BLOCK ATTRIBUTE ACTION ROUTINE.
	JSB	J_SAVREG		;SAVE REGS 0-11.
	MOVL	LBLTBL_PTR,R8		;LABEL TABLE ADDRESS.
	MOVL	OF_LBLTBL_ASC(R8),R10	;ASCII BUFFER.
	MOVL	OF_LBLTBL_ASC2(R8),R11	;ASCII 2 BUFFER.
	MOVL	ACTTBL_PTR,R7		;ACTION TABLE ADDRESS.
	.IF	DF	DEBUG
	M_MESS	<AC_MTDSL2BLOATT>
	.ENDC
	BITL	#X_NEWVOL,XTLLONG	;NEW VOLUME??
	M_IF_NEQ	3$		;IF NOT FIRST VOLUME, THEN BRANCH.
1$:
;
;FIRST VOLUME.
;
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
2$:
	.WORD	100$-2$			;OFFSET TO IBM TO VAX SECTION.
	.WORD	200$-2$			;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS INPUT OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	1$		;DO IT AGAIN.
;
;
;NEW VOLUME.
;
3$:
	CASEB	TFRMOD,#0,#1		;BRANCH TO RIGHT SECTION.
4$:
	.WORD	1100$-4$		;OFFSET TO IBM TO VAX SECTION.
	.WORD	1200$-4$		;OFFSET TO VAX TO IBM SECTION.
;
;
;FALL THROUGH MEANS TFR MODE OUT OF RANGE.
;
	M_MESX	#MES_TFROUTRGE,<TFRMOD>	;TELL USER.
	BRW	30$		;SET C-BIT FOR FAILURE.
;
;
;
;FIRST VOLUME. IBM TO VAX.
;
100$:
	CMPL	#LBL_HDR2,LBLTBL_PTR	;HDR2??
	M_IF_NEQ	20$		;RETURN IF NOT HDR2.
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO FIELD.
	CMPB	(R10),#^A/B/		;BLOCK AND NOT SPANNED??
	M_IF_EQL	101$		;BRANCH IF BLOCK AND NOT SPANNED.
	CMPB	(R10),#^A/R/		;BLOCK AND SPANNED.
	M_IF_EQL	101$		;BRANCH IF BLOCK AND SPANNED.
	MOVL	#1,CVTDESC		;GET REAY TO OUTPUT ERROR MESSGE.
	MOVAL	(R10),CVTDESC+4		;STRING ADDRESS.
	M_MESS	<Block attribute /!AF/ not implemented yet>,-
		<CVTDESC,CVTDESC+4>
	BRW	30$			;EXIT.
101$:
	MOVB	#0,BLOATT		;INDICATE BLOCK ATTRIBUTE.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;FIRST VOLUME. VAX TO IBM.
;
200$:
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO FIELD.
	MOVB	#^A/R/,(R10)		;SLWAYS 'R'.
	MOVB	#0,BLOATT		;INDICATE BLOCK ATTRIBUTE.
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. IBM TO VAX.
;
1100$:
	CMPL	#LBL_HDR2,LBLTBL_PTR	;HDR2??
	M_IF_EQL	1101$		;BRANCH IF HDR2.
PCCUR=.
	M_MESS	<Internal error at PC=!XL>,<#PCCUR>
	BRW	30$			;EXIT.
1101$:
	ADDL	OF_ACTTBL_OFF(R7),R10	;POINT TO FIELD IN ASCII BUFFER.
	ADDL	OF_ACTTBL_OFF(R7),R11	;POINT TO FIELD IN ASCII 2 BUFFER.
	CMPC3	OF_ACTTBL_LEN(R7),(R10),(R11)	;COMAPRE.
	M_IF_EQL	1102$		;BRANCH IF MATCHED.
	M_MESS	<Block attribute changed from /!AF/ TO /!AF/>,-
		<OF_ACTTBL_LEN(R7),R10,OF_ACTTBL_LEN(R7),R11>
	BRW	30$			;EXIT.
1102$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
;NEW VOLUME. VAX TO IBM.
;
1200$:
	CMPL	#LBL_HDR2,LBLTBL_PTR	;HDR2??
	M_IF_EQL	1201$		;BRANCH IF HDR2.
PCCUR=.
	M_MESS	<Internal error at PC=!XL>,<#PCCUR>
	BRW	30$		;EXIT.
1201$:
	BRW	20$		;RETURN. C-BIT CLEARED.
;
;
;
20$:
	BICPSW	#1		;CLEAR C-BIT.
	BRB	40$		;RETURN.
30$:
	BISPSW	#1		;SET C-BIT.
40$:
	JSB	J_RESREG	;RESTORE REGS 0-11.
	RSB			;BYE.
	.END	START