Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - utilities/tapeio.old
There are no other files named tapeio.old in the archive.
;<J.JQJOHNSON>TAPEIO.FAI.498,  4-Feb-82 13:15:02, Edit by J.JQJOHNSON
; FF in middle of a line should yield "1" CC if FBA or VBA
;ACCT:<UTILITIES.SUBSYS>TAPEIO.FAI.497,  2-Feb-82 15:18:34, Edit by J.JQJOHNSON
; .REWIN should return +2 on success
;ACCT:<UTILITIES.SUBSYS>TAPEIO.FAI.496, 15-Jan-82 12:58:47, Edit by R.RMK
;ACCT:<UTILITIES.SUBSYS>TAPEIO.FAI.495, 15-Jan-82 11:58:20, Edit by R.RMK
; Fix losing check for LRECL multiple of four.
;ACCT:<UTILITIES.SUBSYS>TAPEIO.FAI.493, 14-Jan-82 16:22:35, Edit J.JQJOHNSON
; Permit reading of null data files on labelled tape
; Forbid writing FB tapes unless LRECL is multiple of 4
; Fix $DCHK
;<B.BOMBADIL>TAPEIO.FAI.492,  6-Jan-82 17:38:21, Edit by B.BOMBADIL
;<B.BOMBADIL>TAPEIO.FAI.491,  6-Jan-82 16:44:44, Edit by B.BOMBADIL
; Don't check DATA-TYPE/LABEL consistency during the parse.
; ERROR restores all clobbered AC's and haltfs uncontinuably
; Minor code cleanups
;<B.BOMBADIL>TAPEIO.FAI.489,  1-Jan-82 18:36:16, Edit by B.BOMBADIL
; TAPJFN doesn't automatically rewind the tape drive
;<B.BOMBADIL>TAPEIO.FAI.488,  1-Jan-82 18:06:01, Edit by B.BOMBADIL
;<B.BOMBADIL>TAPEIO.FAI.481,  1-Jan-82 17:04:09, Edit by B.BOMBADIL
;<B.BOMBADIL>TAPEIO.FAI.480,  1-Jan-82 16:21:25, Edit by B.BOMBADIL
; Organize HELP keyword table into three tables (general, commands, switches)
;<B.BOMBADIL>TAPEIO.FAI.479,  1-Jan-82 16:05:31, Edit by B.BOMBADIL
;<B.BOMBADIL>TAPEIO.FAI.477,  1-Jan-82 15:55:01, Edit by B.BOMBADIL
; Add a REVERT command to get back initial switch settings.  Document it.
; Fix broken DISPLAY command
;<B.BOMBADIL>TAPEIO.FAI.474, 31-Dec-81 20:08:19, Edit by B.BOMBADIL
; Move output buffer page from page 20 to page 100 (was overlapping code!)
;<B.BOMBADIL>TAPEIO.FAI.464, 31-Dec-81 18:57:17, Edit by B.BOMBADIL
; Set new switch values after command line is confirmed
;<B.BOMBADIL>TAPEIO.FAI.460, 31-Dec-81 16:20:25, Edit by B.BOMBADIL
;<B.BOMBADIL>TAPEIO.FAI.454, 31-Dec-81 15:26:42, Edit by B.BOMBADIL
; Make possible either MACRO or FAIL assembly
;<B.BOMBADIL>TAPEIO.FAI.453, 31-Dec-81 15:09:47, Edit by B.BOMBADIL
; Try to assign MTA-DUMPER: if possible.  If not possible, force user
; to use TAPE command to assign the drive.
;<B.BOMBADIL>TAPEIO.FAI.450, 31-Dec-81 13:55:35, Edit by B.BOMBADIL
; fix up HELP documentation
; more code cleanups
;<B.BOMBADIL>TAPEIO.FAI.447, 31-Dec-81 12:41:32, Edit by B.BOMBADIL
;<B.BOMBADIL>TAPEIO.FAI.445, 30-Dec-81 20:37:54, Edit by B.BOMBADIL
; Rework parsing so a user can recover without retyping the entire line
;<B.BOMBADIL>TAPEIO.FAI.436, 30-Dec-81 18:54:16, Edit by B.BOMBADIL
; Flush most of the FDBxx nonsense in favor of the FLDDB. macro
;<B.BOMBADIL>TAPEIO.FAI.435, 30-Dec-81 17:22:19, Edit by B.BOMBADIL
;<B.BOMBADIL>TAPEIO.FAI.428, 30-Dec-81 16:22:46, Edit by B.BOMBADIL
; Add TAPE and UNLOAD commands
; Begin code cleanup
;<A.JPBION.TAPEIO>TAPEIO.FAI.426, 23-Oct-81 15:33:24, Edit by A.JPBION
; Fix bug in REWIND command; assign the tape drive first!
;<A.JPBION.TAPEIO>TAPEIO.FAI.424, 22-Oct-81 17:51:35, Edit by A.JPBION
; Add the REWIND command. Not really needed, but it SURE helps the user!
;<A.JPBION.TAPEIO>TAPEIO.FAI.422, 15-Oct-81 16:56:13, Edit by A.JPBION
; Add EXIT as an invisible command.
;<A.JPBION.TAPEIO>TAPEIO.FAI.419, 15-Oct-81 16:23:22, Edit by A.JPBION
; Add the DISPLAY command to do the equivalent to HELP VALUES...
; This code is going to be cleaned up! (ie: by code I mean TAPEIO)
; Improvements include doing such things as adding a command to go back
; to the default switches...
;MRC:<UTILITIES>TAPEIO.FAI.416,  7-Sep-81 22:35:41, Edit by ADMIN.LOUGHEED
; Incorporate RMK's fixes to handling of option errors
;MRC:<UTILITIES>TAPEIO.FAI.415, 10-May-81 10:55:39, Edit by ADMIN.JQJ
; -VPRINT, VCARD, and DEFAULT documentation
; -parameterize lengths of various keyword tables so adding won't break them
; -TO DO:  * On write, if BLKPFX=0, don't write a block prefix, but do 
;  pad the block with "^" to the record length.
;  * Rework parsing so that /switch1:value<ESC>^U does not set switch1.
;  * Handle short last block in FB -- pad to multiple of record length
;<J.JQJOHNSON>TAPEIO.FAI.20, 15-Apr-81 18:38:00, Edit by B.BOMBADIL
; change FMFTAB+0 from 6,,6 to 7,,7 to get back VPRINT keyword 
;<J.JQJOHNSON>TAPEIO.FAI.19, 10-Apr-81 15:23:05, Edit by J.JQJOHNSON
; -change "beware" message to reflect changed CIT policies
; -change VPRINT and VCARD to LRECL 235 (for Mark Lawrence)
;<J.JQJOHNSON>TAPEIO.FAI.18,  4-Apr-81 14:25:50, Edit by J.JQJOHNSON
; clear output buffer on READ by big BLT (at WDSET) to fix null-in-b35 problem
;<ADMIN.JQJ>TAPEIO.FAI.16, 23-Mar-81 14:45:14, Edit by ADMIN.JQJ
;fix THDRRD and take out check for LRECL mult of 4.
;<ADMIN.JQJ>TAPEIO.FAI.15, 11-Mar-81 11:25:53, Edit by ADMIN.JQJ
; -correction to previous edit.  Used wrong AC in RTSOR
; -On reading, permit filename of "*" to mean "use file name from label, or 
;  TAPEIO-FILE-n if NL".
;<ADMIN.JQJ>TAPEIO.FAI.12,  5-Mar-81 12:03:56, Edit by ADMIN.JQJ
; -bump version number
; -if D format, flush padding record containing "^" in record descriptor
; -clean up code around RTLSOR and following
; -free 3 ACs for future use by moving TJFN, OJFNP, IJFNP to memory
;<ADMIN.JQJ>TAPEIO.FAI.11,  3-Mar-81 14:34:09, Edit by ADMIN.JQJ
; -start fixing problems with BDW -- default to 4, which is probably wrong
;<ADMIN.JQJ>TAPEIO.FAI.10,  3-Mar-81 12:46:26, Edit by ADMIN.JQJ
; -default to CTRL-L:NO on reading tapes
; -on ASCII D tapes, write block prefix as at least 4 instead of 0
; -clean up VOL label code, read volid for HDR1
; -HDR label reading:  on ASCII tapes, believe CC="A" & don't require HDR2
; -HDR label writing:  write VOLID and FILE SEQUENCE NUMBER
; -JULDAT and DONOUT cleaner
; -fix UNIT command to work after reparse
;<IN.JQJ>TAPEIO.FAI.7, 22-Feb-81 18:13:41, Edit by ADMIN.JQJ
; make error handling reasonable even if don't have CM%FIX
;<ADMIN.JQJ>TAPEIO.FAI.6, 21-Feb-81 11:43:14, Edit by ADMIN.JQJ
; fix switches to end with colon
;<ADMIN.JQJ>TAPEIO.FAI.5, 21-Feb-81 11:03:25, Edit by ADMIN.JQJ
; redo listing of HELP texts to print text but not binary (via macro)
; add /FORMAT:ANSI for DEC-style format (DB, 2044, 2048, with ^L)
; add DEFAULT command
; still to do:  /UNIT should clear knowledge of position, and should rewind
;<ADMIN.JQJ>TAPEIO.FAI.4, 12-Feb-81 13:19:20, Edit by ADMIN.JQJ
; clean up format of listing.  Eliminate noise words on switches
; clean up HELP and QUIT parsing
; don't write generation number in DSN field of header
; translate EBCDIC <not> to tilde rather than ^.
;<ADMIN.JQJ>TAPEIO.FAI.3, 11-Feb-81 20:55:53, Edit by ADMIN.JQJ
; fix "COLUMN OVERFLOW" with ANSI D tapes.
;Edit by T.TOPAZ
; Change arguments to switches, edit help, minor touch-ups.
;<W.WOODRUFF>TAPEIO.FAI.1, 15-Aug-80 13:33:10, Edit by W.WOODRUFF
; Install HELP command
	TITLE	TAPEIO -- READ & WRITE TAPES
;
;	a program to read & write IBM format tapes
;	written by Brian Cox <a.brian> @ GSB, 1979.
;

	SUBTTL	PARAMETERS

	SEARCH MONSYM, MACSYM	;SYMBOL LIBRARIES
	PURGE .CASE, .CASE	;WE USE THIS SYMBOL (WAS DEFINED IN MACSYM)
	.REQUIRE SYS:MACREL.REL	;USEFUL SUBROUTINES
	ASUPPRESS		;DON'T OUTPUT UNUSED SYMBOLS
	IFDEF SALL,<SALL>	;PRETTY LISTINGS
	IFNDEF SALL,<XALL NOLIT> ;PRETTY LISTINGS
	.DIRECT .XTABM		;FLUSH WHITE SPACE IN MACRO EXPANSIONS

;
;	REGISTER USAGE
;
FLAGS=		0	;FLAG BITS (SEE FLAGS BELOW)
AC1=		1	;JSYS PARAMETER AC'S
AC2=		2
AC3=		3
AC4=		4
			;5 IS FREE (RESERVED FOR FLAGS WHEN PARSING REWORKED)
INRCT=		6	;INPUT RECORD COUNT
INCOL=		INRCT	;INPUT COLUMN COUNT
INBCT=		7	;INPUT BLOCK COUNT
INBPT=		10	;INPUT BYTE POINTER
			;11 IS FREE
OUTRCT=		12	;OUTPUT RECORD COUNT (SEE SBKCOL)
OUTCOL=		OUTRCT	;OUTPUT COLUMN COUNT
OUTBCT=		OUTCOL+1 ;13 OUTPUT BLOCK COUNT
OUTBPT=		OUTBCT+1 ;14 OUTPUT BYTE POINTER
OUTEOF=		OUTBPT+1 ;15 OUTPUT EOF COUNT
			;16 IS FREE (RESERVED FOR MACSYM)
P=		17	;STACK POINTER
;
;	FLAGS (RIGHT)
;
%BLKSZ==	1	;BLKSIZE SPECIFIED
%LRECL==	2	;LRECL     "
%DEN==		4	;DENSITY   "
%RECFM==	10	;RECFM     "
%PARTY==	20	;PARITY    "
%DATA==		40	;DATA      "
%CASE==		100	;CASE      "
%COUNT==	200	;COUNT     "
%SKIP==		400	;SKIP      "
%EOR==		1000	;EOR	   "
%XTAB==		2000	;EXPANDING TAB IN INPUT
%EOL==		10000	;CR/LF IN INPUT
%CHOP==		20000	;RECORD(S) TRUNCATED ON WRITE/ > LRECL ON READ
%STRIP==	40000	;STRIP SPECIFIED
%BLK==		100000	;LAST CHAR WRITTEN WAS BLANK
%BIGBK==	200000	;BLOCK(S) > BLKSIZE
%EOT==		400000	;ALLOW EOT
%FMT==		%BLKSZ+%LRECL+%RECFM
;
;	FLAGS (LEFT)
;
%NULL==		1	;NULLS SPECIFIED
%TAB==		2	;TAB      "
%FF==		4	;FORM FEEDS  "
%BLNKS==	10	;BLANKS SPECIFIED
%LINOS==	20	;LINE #S SPECIFIED
%CC==		40	;RECFM== xA (CARRIAGE CONTROL IN 1ST BYTE)
%EOF==		100	;READ EOF
%BPFX==		200	;BLOCK
%VLR==		400	;RECFM== Dx or Vx (VARIABLE LENGTH)
%LTM==		1000	;LEADING TAPE MARK SPECIFIED
%LABEL==	2000	;LABEL SPECIFIED
%WRITE==	200000	;COMMAND BIT (1==WRITE COMMAND)
%READ==		400000	;COMMAND BIT (1==READ COMMAND)
;
;	RECFMs
;
$A==		10	;ANSI CARRIAGE CONTROL
$B==		4	;BLOCKED RECORDS
$D==		0	;ASCII UNBLOCKED VARIABLE
$DA==		$D+$A	;  "      "          "    WITH CC
$DB==		$D+$B	;  "   BLOCKED       "
$DBA==		$D+$B+$A;  "      "          "     "    "
$F==		1	;BOTH  UNBLOCKED FIXED
$FA==		$F+$A	;  "       "       "       "    "
$FB==		$F+$B	;  "   BLOCKED     "
$FBA==		$F+$B+$A;  "      "        "       "    "
$U==		2	;BOTH  UNDEFINED
$UA==		$U+$A	;BOTH      "               "    "
$V==		3	;IBM   UNBLOCKED VARIABLE
$VA==		$V+$A	; "        "         "     "    "
$VB==		$V+$B	; "    BLOCKED       "
$VBA==		$V+$B+$A; "       "          "     "    "
;
;	MISC PARAMETERS
;
MINREC==	^D18	;SMALLEST RECORD LENGTH (ANSI MIN: 18)
MAXREC==	^D30720	;LARGEST RECORD LENGTH (DEC MAX, IBM MAX IS 32760)
MINBLK==	MINREC	;SMALLEST BLKSIZE
MAXBLK==	MAXREC	;LARGEST BLKSIZE
OUTBPG==	100	;OUTPUT BUFFER PAGE
OUTBF1=		1000*OUTBPG
OUTBF2=		OUTBF1+<MAXBLK+3>/4
INBPG=		OUTBPG+2*<<MAXBLK+3777>/4000>	;INPUT BUFFER PAGE
INBUF1=		1000*INBPG
INBUF2=		INBUF1+<MAXBLK+3>/4
BUFL==		INBPG-OUTBPG ;BUFFER LENGTH (BOTH BUFFERS)
	SUBTTL MACROS

DEFINE	NOISE (STR) <
	MOVEI	AC2,[FLDDB. .CMNOI,,<-1,,[ASCIZ\STR\]>]
	CALL	DOCMND
>

DEFINE	WARN (STR) <
	JRST [ HRROI AC1,[ASCIZ/STR/]
	       JRST $WARN ]
>

DEFINE FMTERR (STR) <
	JRST [ HRROI AC1,[ASCIZ/STR/]
	       JRST $INCOM ]
>

;T - KEYWORD TABLE ENTRY

DEFINE T (KEYWRD,ADDRSS,FLAGS) <
	IFNB <ADDRSS>,<DEFINE ..ADDR ' <ADDRSS>>
	IFB <ADDRSS>,<DEFINE ..ADDR ' <$'KEYWRD>>
	IFNB <FLAGS>,<DEFINE ..FLAG <CM%FW!FLAGS>>
	IFB <FLAGS>,<DEFINE ..FLAG <CM%FW>>
	[..FLAG
	 ASCIZ/KEYWRD/],,..ADDR
	PURGE ..ADDR
>

;TABLE - START A KEYWORD TABLE

DEFINE TABLE <
	..PPP==.		;;PPP IS THE TOP OF THE TABLE
	XWD 0,0			;;LEAVE BLANK FOR NOW.
>

;TEND - FINISH UP KEYWORD TABLE

DEFINE TEND <
	..QQQ==.-..PPP-1	;;DEFINE THE VALUE OF ..QQQ
	.ORG ..PPP		
	..QQQ,,..QQQ		;;THE BEGINNING OF THE TABLE.
	.ORG
>
	SUBTTL	SWITCH VALUE TABLES

;THE SWUSE, SWDEF, AND SWSET TABLES ARE IN PARALLEL.


;INFORMATION BEARING MACRO FOR DEFAULT SWITCH SETTINGS

DEFINE SWINF <
	XX DEN,.SJD16		;DENSITY - 1600 BPI
	XX LRECL,^D80		;LOGICAL RECORD LENGTH - 80
	XX RECFM,$FB		;RECORD FORMAT - FB
	XX BLKSZ,^D8000		;BLOCKSIZE - 8000
	XX CASE,0		;CASE CONVERSION - NOCHANGE
	XX DATA,0		;DATA TYPE - ASCII
	XX PARITY,.SJPRO	;PARITY - ODD
	XX COUNT,<377777,,777777> ;COUNT - ALL
	XX SKIP,0		;RECORDS TO SKIP - NONE
	XX EOR,1		;END OF RECORD - LRECL FOR READ, CRLF FOR WRITE
	XX NULL,1		;FLUSH NULLS - YES
	XX TAB,1		;EXPAND TABS - NO FOR READ, YES FOR WRITE
	XX FF,1			;FLUSH FORMFEEDS - NO FOR READ, YES FOR WRITE
	XX BLANKS,1		;STRIP TRAILING OR PAD WITH BLANKS - YES
	XX LINOS,1		;FLUSH LINE NOS. - NO FOR READ, YES FOR WRITE
	XX BLKPFX,0		;BLOCK PREFIX -  0
	XX LTM,0		;LEADING TAPE MARK - NO
	XX LABEL,1		;LABEL - SL
>;END SWINF MACRO

;SET UP INITIAL TABLE OF CURRENT SWITCH VALUES

DEFINE XX (NAME,VALUE) <
	NAME:	VALUE
>

SWUSE::	SWINF
SWLEN==.-SWUSE	

;SET UP TABLE OF DEFAULT SWITCH VALUES

DEFINE XX ' (NAME,VALUE) <
	VALUE
>

SWDEF:	SWINF			;SAVE DEFAULT SWITCH VALUES HERE


;TABLE OF SWITCH SETTINGS THAT HAVEN'T YET BEEN CONFIRMED

DEFINE XX ' (NAME,VALUE) <
	.'NAME: -1		;;INITIAL VALUE OF -1
>

SWSET:	SWINF			;SWITCH VALUES THAT WERE SET
	SUBTTL	IMPURE STORAGE

JFNLSZ== ^D20
IJFNL:	BLOCK JFNLSZ+1	;INPUT JFN LIST
OJFNL:	BLOCK JFNLSZ+1	;OUTPUT JFN LIST
CMIBUF:	BLOCK 200	;COMMAND INPUT BUFFER
CMABUF:	BLOCK 20	;COMMAND ATOM BUFFER
JFNBLK:	BLOCK 16	;COMMAND JFN BLOCK
TJFN:	0		;TAPE JFN (WAS AC5)
IJFNP:	0		;INPUT JFN POINTER (WAS AC11)
OJFNP:	0		;OUTPUT JFN POINTER (WAS AC16)
OCMPTR:	0		;PREVIOUS VALUE OF POINTER IN CSB+.CMPTR
VOLID:	BLOCK 2		;VOLUME NAME
TAPSTR:	BLOCK 2		;TAPE DRIVE STRING, e.g. "MTA0:"
TAPDES:	BLOCK 1		;TAPE DRIVE DEVICE DESIGNATOR
; THE FOLLOWING TWO PAIRS OF CELLS SHOULD STAY IN THE SAME ORDER
IORCNT:	0		;# OF RECORDS READ/WRITTEN
IOBCNT:	0		;# OF BLOCKS READ/WRITTEN
IORSAV:	0		;IORCNT SAVE AREA (FOR REMOVING BLANK LINES)
IOBSAV:	0		;IOBCNT SAVE AREA (IORCNT-IOBSAV MUST BE CONTIGUOUS)
RTEEOR:	0		;EFFECTIVE EOR (FOR REMOVING SEQ #S)
CC:	" "		;CARRIAGE CONTROL (DEFAULT: " ")
INEOF:	0		;INPUT EOF COUNT
TFN:	1		;TAPE FILE #
TSKPCT:	0		;TAPE SKIP COUNT
INPG:	0		;INPUT PAGE #
OUTPG:	0		;OUTPUT PAGE #
EORFLG:	0		;EOR EVER SPECIFIED FLAG(0=N,#0=Y) [THE DEFAULT
TABFLG:	0		;TAB  "      "        "     "	    DEPENDS ON
LINFLG:	0		;LINOS "     "        "     " 	    WHETHER READ
FFFLG:	0		;FF    "     "        "     " 	    OR WRITE]
BDWFLG:	0
LBLFLG:	0		;LABEL "     "        "     "
RDWPT:	0		;RECORD DESCRIPTOR POINTER
RDWCT:	0		;   "        "     COUNT
BDWCT:	0		;  "         "     COUNT
WXTRAP:	0		;PTR TO CHARS IN VAR LEN WRITE THAT DIDN'T FIT IN BLOCK
WXTRAC:	0		;#   OF CHARS (AS ABOVE)
;	DON'T CHANGE ORDER OF OUTCOL-OUTEOF,SBKCOL-SBKEOF,LNBCOL-LNBEOF
SBKCOL:	0		;START OF BLANKS COLUMN
SBKBCT:	0		;   "  "    "    PAGE COUNTER
SBKBPT:	0		;   "  "    "    BYTE POINTER 
SBKEOF:	0		;   "  "    "    EOF COUNTER
LNBCOL:	0		;LAST NON-BLANK LINE COLUMN
LNBBCT:	0		;  "      "       "  PAGE COUNTER
LNBBPT:	0		;  "      "      "  BYTE  POINTER
LNBEOF:	0		;  "      "       "  EOF COUNT

STKL=	^D30			;STACK LENGTH
STACK:	BLOCK STKL		;STACK
DSL1:	BLOCK 20		;DATA SET LABEL 1 BUFFER
DSL2:	BLOCK 20		;DATA SET LABEL 2 BUFFER
DSL1T:	ASCII	!HDR1                ! ;DATA SET LABEL 1 TEMPLATE, 1. - 20.
	ASCII	! 0000100010001      ! ;21.-40.
	ASCII	!  yyddd 00000x000000! ;41.-60.
	ASCII	!OS360               ! ;61.-80.
DSL2T:	ASCII	!HDR2x000000000030TAP! ;DATA SET LABEL 2 TEMPLATE, 1. - 20.
	ASCII	!EIO  /GO            ! ;21. - 40.
	ASCII	!                    ! ;41. - 60.
	ASCII	!                    ! ;61. - 80.
INLST:	INLST1			;INPUT IO LIST PTR
	POINT	8,INBUF1	;BYTE POINTER TO BUFFER
	INLST2			;PTR TO OTHER IO LIST
INLST1:	IOWD	MAXBLK/4,INBUF1	;DUMPI COMMAND LIST
	0
	POINT	8,INBUF2
	INLST1
INLST2:	IOWD	MAXBLK/4,INBUF2
	0
OUTLST:	OUTLS1			;OUTPUT IO LIST PTR
	POINT	8,OUTBF1
	OUTLS2
OUTLS1:	IOWD	0,OUTBF1
	0
	POINT	8,OUTBF2
	OUTLS1
OUTLS2:	IOWD	0,OUTBF2
	0
LBREAD:	IOWD	^D20,INBUF1	;LABEL READ IO LIST
	0
LBWRIT:	IOWD	^D20,0		;LABEL WRITE IO LIST
	0

;COMMAND STATE BLOCK

CSB:	XWD 0,$REPAR
	.PRIIN,,.PRIOU
	POINT	7,[ASCIZ/TAPEIO>/]
	POINT	7,CMIBUF
	POINT	7,CMIBUF
	^D400
	0
	POINT	7,CMABUF
	^D50
	JFNBLK
	SUBTTL TABLES

;POWERS OF 10

PWR10:	1
	^D10
	^D100
	^D1000
	^D10000
	^D100000


;TOP LEVEL TAPEIO COMMANDS

COMTAB:	TABLE
	T DEFAULT
	T DISPLAY
	T EXIT,$QUIT,CM%INV	;"EXIT" is a synonym of QUIT
	T HELP
	T QUIT
	T READ
	T REVERT
	T REWIND
	T TAPE-DRIVE,$TAPE
	T UNLOAD
	T WRITE
	TEND


;/DENSITY:

DENTAB:	TABLE
	T 1600,.SJD16
	T 800,.SJDN8
	TEND

;READ RECFMS

RCFMTB:	TABLE
	T D,$D
	T DA,$DA
	T DB,$DB
	T DBA,$DBA
	T F,$F
	T FA,$FA
	T FB,$FB
	T FBA,$FBA
	T U,$U
	T UA,$UA
	T V,$V
	T VA,$VA
	T VB,$VB
	T VBA,$VBA
	TEND
;/PARITY:

PARTAB:	TABLE
	T EVEN,.SJPRE
	T ODD,.SJPRO
	TEND

;/DATA-TYPE:

DATAB:	TABLE
	T ASCII,0
	T EBCDIC,1
	TEND

;/CASE:

CASTAB:	TABLE
	T LOWER,-1
	T NOCHANGE,0
	T UPPER,1
	TEND

;MOBY OPTION TABLE

OPTTAB:	TABLE
	T BLANKS:,$BLNKS
	T BLKSIZE:,$BLKSZ
	T BLOCK-FIX-LENGTH:,$BKPFX
	T CASE:,$CASE
	T COUNT:,$COUNT
	T CTRL-L:,$FF
	T DATA-TYPE:,$DATA
	T DENSITY:,$DEN
	T EOR:,$EOR
	T FORMAT:,$FMT
	T LABEL:,$LABEL
	T LEADING-TAPE-MARK:,$LTM
	T LINE-NUMS:,$LINOS
	T LRECL:,$LRECL
	T NULLS:,$NULL
	T PARITY:,$PARTY
	T RECFM:,$RECFM
	T SKIP:,$SKIP
	T TABS:,$TAB
	TEND

;SYMBOLIC TAPE FILE #S FOR WRITE

TFN1:	TABLE
	T END,-1
	T LAST,-2
	T NEXT,0
	TEND
;SYMBOLIC TAPE FILE #S FOR READ

TFN2:	TABLE
	T LAST,-2
	T NEXT,0
	TEND

;BLANKS, ETC.

YNTAB:	TABLE
	T NO,0
	T YES,1
	TEND

;QUIT OPTIONS

QUITAB:	TABLE
	T NOCHANGE,-1
	T REWIND,0
	T UNLOAD,1
	TEND

;SYMBOLIC COUNT

CNTAB:	TABLE
	T ALL,0
	TEND

;SYMBOLIC SKIP

SKPTAB:	TABLE
	T NONE,0
	TEND

;END OF RECORD

EORTAB:	TABLE
	T CRLF,0
	T LRECL-CHARACTERS,1
	TEND

;FORMATS

FMTAB:	TABLE
	T ANSI,7
	T FCARD,1
	T FPRINT,2
	T TCARD,5
	T TPRINT,6
	T VCARD,3
	T VPRINT,4
	TEND

;LABEL KEYWORDS

LBLTAB:	TABLE
	T AL,-1
	T NL,0
	T SL,1
	TEND
	SUBTTL	MISCELLANEOUS ROUTINES

ERROR:	PUSH	P,AC1
	PUSH 	P,AC2
	PUSH	P,AC3
	CALL	PCRIF
	TMSG	<?JSYS error at location >
	MOVEI	AC1,.PRIOU
	HRRZ	AC2,-3(P)
	SUBI	AC2,2
	MOVEI	AC3,10
	NOUT
	 JFCL
	TMSG	< - >
	MOVEI	AC1,.PRIOU
	HRLOI	AC2,.FHSLF
	MOVEI	AC3,0
	ERSTR
	 JFCL
	  JFCL
	TMSG	<
>
	POP	P,AC3
	POP	P,AC2
	POP	P,AC1
	HALTF
	JRST	.-1
;
;	UNMAP  --  UNMAP FILE
;
UNMAP:	HRROI	AC1,-1
	MOVE	AC2,[XWD .FHSLF,INBPG]
	MOVE	AC3,[PM%CNT+BUFL]
	PMAP
	RET
;
;	MISC PRINT
;
PRTTFN:	MOVE	AC2,TFN		;PRINT TAPE FILE #
PRTNUM:	MOVEI	AC1,.PRIOU	;PRINT NUMBER (AC2= #)
	MOVEI	AC3,^D10
	NOUT
	 ERCAL	ERROR
	RET

PRTFIL:	MOVEI	AC1,.PRIOU	;PRINT FILE NAME
	MOVEI	AC3,0		;CALLED WITH AC2= JFN
	JFNS
	RET

;PCRIF - PRETTY PRINTING AID

PCRIF:	MOVEI AC1,.PRIOU	;READING FROM THE TTY
	RFPOS			;GET CURSOR POSITION
	TRNE AC2,-1		;SKIP IF AGAINST LEFT MARGIN
	CALL PRTEOL		;PRINT A CRLF
	RET			;RETURN TO CALLER

PRTARW:	HRROI	AC1,[ASCIZ/ => /]
	PSOUT
	RET

PRTCFM:	MOVE	AC2,IORCNT	;PRINT # OF RECORDS
	CALL	PRTNUM
	HRROI	AC1,[ASCIZ/ records, /]
	CAIN	AC2,1
	HRROI	AC1,[ASCIZ/ record, /]
	PSOUT
	MOVE	AC2,IOBCNT	;PRINT # OF BLOCKS
	CALL	PRTNUM
	HRROI	AC1,[ASCIZ/ blocks processed/]
	CAIN	AC2,1
	HRROI	AC1,[ASCIZ/ block processed/]
	PSOUT
	TMSG	<
>
	RET
;
;	PROCESS TRAILING BLANKS
;
TRLBLK:	TRZN	FLAGS,%BLK
	RET			;NONE
	SKIPN	BLANKS
	JRST	SQUEEZ		;REPLACE WITH TAB(S)
;
;	REMOVE BLANKS
;
RESET:	CAMLE	OUTBCT,SBKBCT	;RESET POINTERS TO START OF BLANKS
	CALL	REMAP		;START IS ON PAGE ALREADY MAPPED
	MOVE	AC1,[XWD SBKCOL,OUTCOL]
	BLT	AC1,OUTEOF
	RET
REMAP:	SOS	OUTPG		;REMAP LAST PAGE
	MOVE	AC1,OUTPG
	MOVE	AC2,[XWD .FHSLF,OUTBPG+BUFL-1]
	HRLZI	AC3,(PM%RD+PM%PLD)
	PMAP
	MOVE	AC1,[XWD OUTBF1,OUTBF1+1000]
	BLT	AC1,OUTBF1+1777	;REPOSTION CURRENT PAGE
	MOVE	AC1,[XWD 1000*<OUTBPG+BUFL-1>,OUTBF1]
	BLT	AC1,OUTBF1+777	;TRANSFER LAST TO START OF OUTBUF
	HRROI	AC1,-1		;UNMAP PAGE LAST
	MOVEI	AC3,0
	PMAP
	MOVE	AC1,SBKBCT	;ADJUST PAGE COUNTER
	ADDI	AC1,5000*<BUFL-1>
	MOVEM	AC1,SBKBCT
 	MOVE	AC1,SBKBPT	;ADJUST BYTE POINTER
	SUBI	AC1,1000*<BUFL-1>
	MOVEM	AC1,SBKBPT
	RET
;
;	REPLACE BLANKS WITH TAB(S)
;
SQUEEZ:	SKIPN	TAB		;REPLACE BLANKS WITH TAB(S)
	RET
	MOVE	AC1,SBKCOL
	AOJ	AC1,
	CAML	AC1,OUTCOL
	RET			;ONLY 1 BLANK
	CAMN	OUTBPT,[POINT 7,OUTBF1]
	MOVE	OUTBPT,[10700,,OUTBF1-1] ;ILDB WON'T = POINT 7,OUTBUF
	CAMLE	OUTBCT,SBKBCT
	ADDI	OUTBPT,1000	;CURRENT PAGE WILL BE REPOSITIONED
	PUSH	P,OUTBPT	;SAVE POINTER TO END OF BLANKS
	MOVEI	AC1,0
	PUSH	P,AC1		;INIT TAB COUNT
	CALL	RESET		;RESTORE PTR TO START OF BLANKS
SQZCNT:	ILDB	AC1,OUTBPT	;COMPUTE # OF TABS
	AOJ	OUTEOF,
	AOJ	OUTCOL,
	SOJ	OUTBCT,
	TRNN	OUTCOL,7	;REPLACE THESE BLANKS
	AOS	(P)		;YES, INCR TAB COUNT
	CAME	OUTBPT,-1(P)	;END OF BLANKS?
	JRST	SQZCNT		;NO
	SKIPN	(P)		;ANY TABS?
	JRST	SQZPOP		;NO
	MOVEM	OUTCOL,-1(P)	;SAVE TO INSERT BLANK(S) NOT REMOVED
	CALL	RESET		;ADD TAB(S)
	MOVEI	AC1,11
	CALL	SQZWRT
	SOSLE	(P)
	JRST	.-2
	MOVEI	OUTCOL,0	;SIMPLE MULTIPLE OF 8
	MOVEI	AC1," "		;REWRITE BLANK(S) NOT REMOVED
	MOVE	AC2,-1(P)
	JRST	.+3
	CALL	SQZWRT
	SOJ	AC2,
	TRNE	AC2,7
	JRST	.-3
SQZPOP:	POP	P,AC1		;RESTORE STACK
	POP	P,AC1
	RET
SQZWRT:	IDPB	AC1,OUTBPT
	AOJ	OUTEOF,
	AOJ	OUTCOL,
	SOJ	OUTBCT,
	RET
;
;	ADD DESCRIPTOR WORD
;
;	INPUT:	AC1=BUFFER PTR, AC2=BYTE COUNT
;	RETURNS: AC2=BYTE COUNT
;
ADDDW:	MOVE	AC3,RECFM	;ADD BLOCK/RECORD DESCRIPTOR TO BUFFER
	TRNE	AC3,3
	JRST	BINDW
	MOVEI	AC3,4		;4 DIGITS
	PUSH	P,AC2		;ADDDW SHOULD PRESERVE AC2!
	CALL	DONOUT		;RECFM=D: DESCRIPTOR IN ASCII
	POP	P,AC2
	RET
BINDW:	MOVE	AC3,AC2		;RECFM=V: DESCRIPTOR IN BINARY
	LSH	AC3,-10
	IDPB	AC3,AC1
	IDPB	AC2,AC1
	MOVEI	AC3,0
	IDPB	AC3,AC1		;PAD WITH TRAILING ZERO BYTES
	IDPB	AC3,AC1
	RET
	SUBTTL	TAPE DRIVE ASSIGNMENT ROUTINES

;ASSIGN - TRY TO QUIETLY GET A TAPE DRIVE
;WE LOOK FOR THE LOGICAL NAME MTA-DUMPER:
;RETURN	+1 ALWAYS.  TAPDES IS ZERO IF WE DIDN'T FIND OR ASSIGN A DRIVE

ASSIGN:	SETZM	TAPDES
	SETZM	TAPSTR
	MOVX	AC1,GJ%SHT
	HRROI	AC2,[ASCIZ/MTA-DUMPER:/]
	GTJFN
	 ERJMP	R
	MOVEM	AC1,TJFN
	DVCHR
	LDB	AC2,[POINT 9,AC2,17]
	CAIE	AC2,.DVMTA
	 JRST	[ MOVE AC1,TJFN
		  RLJFN
		   JFCL
		  SETZM TJFN
		  RET ]
	MOVEM	AC1,TAPDES
	MOVE	AC1,TJFN
	RLJFN			;RELEASE THE JFN NOW
	 JFCL
ASSGN0:	HRROI	AC1,TAPSTR
	MOVE	AC2,TAPDES
	DEVST			;WRITE OUT DEVICE STRING
	 ERCAL	ERROR
	MOVEI 	AC2,":"
	IDPB	AC2,AC1		;END WITH A COLON
	MOVEI	AC2,.CHNUL
	IDPB	AC2,AC1		;AND A NULL
	SETZM	TJFN		;NO JFN ON FLAG
	SETZM	LBLFLG		;DON'T KNOW ABOUT LABEL
	MOVE	AC1,TAPDES	;AC1/ DRIVE DESIGNATOR
	ASND			;TRY TO ASSIGN THE TAPE DRIVE
	 ERJMP ASSGNX		;FAILED, GO COMPLAIN
	CALL	.REWIN		;REWIND TAPE, SET INITIAL FILE NU;MBER
	 JFCL			;IGNORE AN ERROR HERE
	RET			;RETURN TO CALLER

ASSGNX:	CALL	PCRIF
	TMSG	<?Unable to assign tape drive >
	HRROI	AC1,TAPSTR
	PSOUT
	TMSG	<
>
	SETZM	TAPDES
	SETZM	TAPSTR
	RET
;TAPE-DRIVE COMMAND

$TAPE:	SETZM	TAPDES		;FLAG THAT NO DEVICE IS ASSIGNED
	NOISE 	(TO USE IS)
	MOVEI	AC2,[FLDDB. .CMDEV,CM%SDH!CM%HPP,,<Tape unit, e.g. MTA0:>,<MTA0:>]
	CALL	DOCMND
	MOVEM	AC2,TAPDES	;STORE DEVICE DESIGNATOR
	CALL	CONFRM		;WAIT FOR CONFIRMATION
	MOVE	AC1,TAPDES
	DVCHR			;GET DEVICE INFORMATION
	LDB	AC1,[POINT 9,AC2,17] ;GET DEVICE CODE
	CAIE	AC1,.DVMTA	;TAPE DRIVE?
	 JRST	[ CALL PCRIF
		  TMSG <?You must specify a tape drive.>
		  SETZM TAPDES
		  SETZM TAPSTR
		  RET ]
	CALLRET ASSGN0		;JOIN DEVICE ASSIGNMENT CODE
;TAPJFN - GET A JFN ON THE TAPE DRIVE
;RELEASES ANY PREVIOUS JFN ON THE DRIVE
;RETURNS JFN IN TJFN

TAPJFN:	SKIPE	AC1,TJFN	;SKIP IF NO JFN
	RLJFN			;ELSE RELEASE IT
	 JFCL			;IGNORE BAD JFNS
	MOVX	AC1,GJ%SHT
	HRROI	AC2,TAPSTR
	GTJFN			;GET JFN FOR TAPE
	 ERCAL	ERROR
	MOVEM	AC1,TJFN	;SAVE
	RET
	SUBTTL DONIN, DONOUT
;
;	DONIN  --  CONVERT ASCII (EBCDIC) # TO BINARY
;
;	INPUT:	AC1= BYTE PTR, AC2= # OF CHARACTERS
;	OUTPUT:	AC1= UPDATED BYTE PTR, AC3= #
;
DONIN:	MOVEI	AC3,0
	ILDB	AC4,AC1		;GET NEXT CHAR
	SKIPE	DATA
	HRRZ	AC4,TRNTAB(AC4)	;TRANSLATE TO ASCII
	SUBI	AC4,"0"
	CAIG	AC4,^D9
	CAIGE	AC4,0
	MOVEI	AC4,0		;TREAT ERRONEOUS CHARS AS 0
	IMUL	AC4,PWR10-1(AC2) ;CONVERT TO BINARY
	ADD	AC3,AC4
	SOJG	AC2,DONIN+1
	RET
;
;	DONOUT  --  CONVERT BINARY TO ASCII (BASE 10), WITH LEADING 0-FILL
;
;CALL:	AC1/	BYTE POINTER TO DESTINATION
;	AC2/	NUMBER TO CONVERT
;	AC3/	FIELD WIDTH
;RET:	AC1/	UPDATED AS FOR NOUT JSYS
DONOUT:	MOVE	AC4,AC1
	HRROI	AC1,CMABUF	;USE NOUT TO CONVERT
	HRLZ	AC3,AC3
	TLO	AC3,(NO%LFL+NO%ZRO) ;LEADING FILLER, PAD WITH ZEROS
	HRRI	AC3,^D10	;BASE 10.
	NOUT
	 ERCAL	ERROR
	MOVE	AC1,AC4		;MOVE (SANS NULL)
	MOVE	AC2,[POINT 7,CMABUF]
	MOVEI	AC3,0
;
;	MOVBYT  --  MOVE BYTES TILL NULL OR AC3=0
;
;	INPUT:	AC1=DESTINATION, AC2=SOURCE, AC3=MAX MOVED
;	OUTPUT:	AC1= UPDATED BYTE PTR
;
MOVBYT:	ILDB	AC4,AC2
	JUMPE	AC4,R
	IDPB	AC4,AC1
	SOJN	AC3,MOVBYT
	RET


;COPY A STRING FROM STRING POINTED TO BY AC2 TO STRING POINTED TO BY
;AC1, WITH EBCDIC TO ASCII TRANSLATION IF "DATA" GT 0
;CALL:	AC1/ DEST STRING PTR
;	AC2/ SOURCE STRING PTR
;	AC3/ NUMBER OF CHARACTERS TO COPY
;RET:	+1 ALWAYS
CPYSTR:	ILDB	AC4,AC2
	SKIPE	DATA		;EBCDIC?
	 HRRZ	AC4,TRNTAB(AC4)	;YES.  CONVERT TO ASCII
	IDPB	AC4,AC1
	SOJG	AC3,CPYSTR
	IDPB	AC3,AC1
	RET


;CALL:	AC2/ INTERNAL D&T
;RET:	AC1/ JULIAN DATE (YYDDD) AS INTEGER
JULDAT:	MOVSI	AC4,(IC%JUD)	;GET JULIAN DATE
	ODCNV
	HLRZ	AC1,AC2
	SUBI	AC1,^D1900	;YY
	IMULI	AC1,^D1000	;YYxxx
	ADDI	AC1,(AC2)	;YYDDD
	RET
	SUBTTL	TAPE CONTROL ROUTINES

TCLEAR:	MOVE	AC1,TJFN	;CLEAR MT FLAGS
	MOVEI	AC2,.MOCLE
	MTOPR
	 ERCAL	ERROR
	RET

TOPEN:	MOVE	AC1,TJFN	;OPEN TAPE
	MOVE	AC2,[17B9+OF%RD]
	TLNN	FLAGS,%READ
	MOVE	AC2,[17B9+OF%WR]
	OPENF
	 ERCAL	ERROR
SETPRM:	CALL	TCLEAR		;SET TAPE PARAMETERS
	MOVEI	AC2,.MOSDN	;SET DENSITY
	MOVE	AC3,DEN
	MTOPR
	 ERCAL	ERROR
	MOVEI	AC2,.MOSDM	;SET DATA MODE= INDUSTRY
	MOVEI	AC3,.SJDM8
	MTOPR
	 ERCAL	ERROR
	MOVEI	AC2,.MOSPR	;SET PARITY
	MOVE	AC3,PARITY
	MTOPR
	 ERCAL	ERROR
	RET

TCLOSE:	MOVE	AC1,TJFN	;CLOSE TAPE & SAVE JFN
	TLO	AC1,(CO%NRJ)
	CLOSF
	 ERCAL	ERROR
	RET

TSKPTM:	MOVE	AC1,TJFN	;SKIP NEXT TAPE MARK
	MOVEI	AC2,.MOFWF
	MTOPR
	 ERCAL	ERROR
	RET

TLTM:	SKIPE	LTM		;SKIP LEADING TAPE MARK
	TLNN	FLAGS,%READ	;ONLY WORKS ON READ
	 RET
	MOVE	AC1,TFN
	CAIE	AC1,1		;AND ONLY AT BOT
	RET
	CALL	TOPEN
	CALL	TSKPTM
	CALL	TCLOSE
	RET
;
;	TLBLCK  --  DETERMINE/VERIFY TAPE LABEL
;
;	INPUT:	NONE
;	OUTPUT:	NONE
;	RETURNS: +1=ERROR, +2=OK
;
TLBLCK:	MOVE	AC1,TFN
	CAIE	AC1,1
	 RETSKP			;###serious logic error?
	SETOM	LBLFLG
	SKIPN	LABEL
	 RETSKP			;USER SPECIFIED NL--TREAT AS BLP
	CALL	SKPOPN
	MOVEI	AC2,LBREAD	;READ VOLUME LABEL
	DUMPI
	 JRST	TLBLER
	MOVEI	AC2,0		;DATA-TYPE= ASCII
	SETO	AC3,		;LABEL= AL
	MOVE	AC1,INBUF1
	TRZ	AC1,000017
	CAMN	AC1,[BYTE (8) 126,117,114,61]
	 JRST	TLBLOK
	MOVEI	AC2,1		;DATA-TYPE= EBCDIC
	MOVEI	AC3,1		;LABEL= SL
	CAME	AC1,[BYTE (8) 345,326,323,361]
	 JRST	TLBLER
TLBLOK:	TLNE	FLAGS,%LABEL	;LABEL NOT SPECIFIED?
	 CAMN	AC3,LABEL	;OR MATCHING?
	  AOS	(P)		; YES.  GOOD RETURN
	MOVEM	AC2,DATA	;SET DATA-TYPE
	MOVEM	AC3,LABEL	;SET LABEL
	MOVE	AC1,[POINT 7,VOLID]
	MOVE	AC2,[POINT 8,INBUF1+1] ;POINT AT VOLUME ID
	MOVEI	AC3,6
	CALL	CPYSTR		;COPY STRING FROM LABEL
	CALL	TCLOSE
	RET			;RETURN +1 OR +2

TLBLER:	CALL	TCLEAR		;BAD LABEL SPECIFIED
	SETZM	LABEL		;TREAT AS LABELLED
	MOVE	AC1,TJFN
	MOVEI	AC2,.MOREW
	SKIPN	LABEL
	MTOPR			;REWIND TAPE IF NL
	 ERCAL	ERROR
	CALL	TCLOSE
	TLNE	FLAGS,%LABEL	;LABEL EVER SPECIFIED?
	 RET			;YES.  ERROR
	RETSKP			;NO
;
;	THDRRD  --  READ HEADER LABELS
;
;	INPUT:	NONE
;	OUTPUT:	NONE
;	RETURNS: +1=ERROR, +2=OK
;
THDRRD:	SKIPN	LABEL
	RETSKP			;NL
	CALL	TOPEN
	MOVEI	AC2,LBREAD
	DUMPI			;READ HDR1 LABEL
	RET			;ERROR
	MOVE	AC3,INBUF1
	TRZ	AC3,17
	MOVE	AC2,[BYTE (8) "H","D","R","1"]
	SKIPLE	LABEL		;SL?
	 MOVE	AC2,[BYTE (8) 310,304,331,361] ;NO
	CAME	AC2,AC3
	 RET			;BAD LABEL
	MOVE	AC1,[POINT 7,CMABUF]
	MOVE	AC2,[POINT 8,INBUF1+1] ;POINT TO FILE IDENTIFIER
	MOVEI	AC3,^D17
	CALL	CPYSTR		;READ FILE NAME
	DPB	AC3,AC1		;MAKE SURE IT ENDS WITH NULL
	MOVE	AC1,TJFN
	MOVEI	AC2,LBREAD
	DUMPI			;READ HDR2 LABEL
	 JRST	THDRR0		;NO HDR2
	MOVE	AC3,INBUF1
	TRZ	AC3,17
	MOVE	AC2,[BYTE (8) "H","D","R","2"]
	SKIPLE	LABEL		;SL?
	 MOVE	AC2,[BYTE (8) 310,304,331,362] ;NO
	CAME	AC2,AC3
	 JRST	THDRR0		;NO HDR2
	MOVE	AC1,[POINT 8,INBUF1+1]
	ILDB	AC3,AC1		;GET RECORD FORMAT FROM LABEL
	SKIPLE	LABEL		;SL?
	HRRZ	AC3,TRNTAB(AC3)	;CONVERT TO ASCII
	CAIN	AC3,"D"
	MOVEI	AC2,$D
	CAIN	AC3,"F"
	MOVEI	AC2,$F
	CAIN	AC3,"U"
	MOVEI	AC2,$U
	CAIN	AC3,"V"
	MOVEI	AC2,$V
	MOVEM	AC2,RECFM
	MOVEI	AC2,5
	CALL	DONIN		;BLKSIZE
	MOVEM	AC3,BLKSZ
	MOVEI	AC2,5
	CALL	DONIN		;LRECL
	MOVEM	AC3,LRECL
	MOVE	AC2,RECFM	;COMPLETE RECFM
	CAME	AC3,BLKSZ
	TRO	AC2,$B		;BLOCKED
	ILDB	AC3,[POINT 8,INBUF1+9,7]	;CARRIAGE CONTROL?
	HRRZ	AC3,TRNTAB(AC3)
	CAIN	AC3,"A"
	TRO	AC2,$A		;YES
	MOVEM	AC2,RECFM
	TRNE	AC2,$A
	TLO	FLAGS,%CC
	SKIPG	LABEL		;SL?
	 JRST	THDRAL		;ANSI LABEL
	SETZM	BLKPFX		;ZERO BLOCK PREFIX
	CALL	TSKPTM
	CALL	TCLOSE
	RETSKP

THDRAL:	MOVE	AC1,[POINT 8,INBUF1+^D12,15]
	MOVEI	AC2,2
	CALL	DONIN		;BLOCK PREFIX
	MOVEM	AC3,BLKPFX
	CALL	TSKPTM
	CALL	TCLOSE
	RETSKP

THDRR0:	RETSKP		;WE DON'T YET KNOW WHAT DEFAULTS IF NO HDR2
				;SO USE WHATEVER USER SPECIFIED
;
;	TEOFRD  --  READ EOF LABELS
;
TEOFRD:	SKIPN	LABEL
	RET
	CALL	TOPEN
	CALL	TSKPTM
	CALL	TCLOSE
	RET
;
;	THDRWT  --  WRITE HEADER LABELS
;
;	INPUT:	NONE
;	OUTPUT:	NONE
;	RETURNS: +1=OK
;
THDRWT:	SKIPN	LABEL
	RET			;TAPE NOT LABELLED
	CALL	TOPEN
	MOVE	AC1,[XWD DSL1T,DSL1]
	BLT	AC1,DSL1+^D15	;CREATE HDR1 LABEL
	HRROI	AC1,CMABUF
	HRRZ	AC2,@IJFNP	;DATA SET NAME
	MOVE	AC3,[JS%NAM!JS%TYP!JS%PAF] ;OUTPUT name.ext ONLY
	JFNS
	MOVE	AC1,[POINT 7,DSL1,27]
	MOVE	AC2,[POINT 7,CMABUF]
	MOVEI	AC3,^D17		;MOVE TO DSL1 
	CALL	MOVBYT
	MOVE	AC1,[POINT 7,DSL1+4,6] ;DATA SET ID
	MOVE	AC2,[POINT 7,VOLID]
	MOVEI	AC3,6
	CALL	MOVBYT
	MOVE	AC1,[POINT 7,DSL1+6,6] ;FILE SEQUENCE
	MOVE	AC2,TFN
	MOVEI	AC3,4		;FIELD WIDTH
	CALL	DONOUT
	SETO	AC2,		;JULIAN CREATION DATE IS NOW
	CALL	JULDAT		;CONVERT TO JULIAN DATE
	MOVE	AC2,AC1
	MOVE	AC1,[POINT 7,DSL1+^D8,13] ;CREATION-DATE FIELD
	MOVEI	AC3,5		;FIELD WIDTH
	CALL	DONOUT
	MOVE	AC1,[POINT 7,DSL1+^D10,20]
	MOVEI	AC2,"0"		;SECURITY CODE
	SKIPG	LABEL
	MOVEI	AC2," "
	IDPB	AC2,AC1		;"0" FOR SL, " " FOR AL MEANS NO SECURITY
	MOVE	AC2,[POINT 7,[ASCIZ/000000/]]
	MOVEI	AC3,0
	CALL	MOVBYT		;BLOCK COUNT
	MOVE	AC1,[POINT 7,DSL1]
	MOVE	AC2,[POINT 8,OUTBF1]
	CALL	TLBLWT		;WRITE HDR1 LABEL
	MOVE	AC1,[XWD DSL2T,DSL2]
	BLT	AC1,DSL2+^D15	;CREATE HDR2 LABEL
	MOVE	AC1,RECFM
	ANDI	AC1,$B-1	;RECFM
	MOVE	AC2,@FMTRFM(AC1)
	LSH	AC2,-^D29
	MOVE	AC1,[POINT 7,DSL2,27]
	IDPB	AC2,AC1
	MOVE	AC2,BLKSZ	;BLOCK SIZE
	MOVEI	AC3,5
	CALL	DONOUT
	MOVE	AC2,LRECL	;LRECL
	MOVEI	AC3,5
	CALL	DONOUT
	MOVE	AC2,DEN
	SUBI	AC2,1		;CONVERT TO STANDARD DENSITY
	MOVEI	AC3,1		;ONLY 1 PLACE WIDE
	SKIPLE	LABEL		;SL?
	 CALL	DONOUT		;YES.  WRITE DENSITY
	MOVEI	AC2,"A"		;CARRIAGE CONTROL
	MOVE	AC3,RECFM
	TRNE	AC3,$A
	 DPB	AC2,[POINT 7,DSL2+7,13]
	MOVEI	AC2,"B"		;BLOCK ATTRIBUTE
	TRNE	AC3,$B
	 DPB	AC2,[POINT 7,DSL2+7,27]
	MOVE	AC1,[POINT 7,DSL2+^D10]
	MOVE	AC2,BLKPFX	;BLOCK PREFIX
	MOVEI	AC3,2
	SKIPG	LABEL		;SL?
	 CALL	DONOUT		;NO--AL.
	MOVE	AC1,[POINT 7,DSL2]
	MOVE	AC2,[POINT 8,OUTBF2]
	CALL	TLBLWT		;WRITE HDR2 LABEL
	CALL	TCLOSE
	RET

TLBLWT:	SOJ	AC2,		;SET BUFFER ADDR IN IO LIST
	HRRM	AC2,LBWRIT
	AOJ	AC2,
	MOVEI	AC3,^D80	;TRANSFER TO OUTPUT BUFFER
	ILDB	AC4,AC1
	SKIPLE	LABEL		;SL?
	 HLRZ	AC4,TRNTAB(AC4)	;TRANSLATE TO EBCDIC
	IDPB	AC4,AC2
	SOJG	AC3,.-4
	MOVE	AC1,TJFN
	MOVEI	AC2,LBWRIT
	TLO	AC2,(DM%NWT)
	DUMPO			;WRITE LABEL
	 ERCAL	ERROR
	RET
;
;	TEOFWT  --  WRITE EOF LABELS
;
;	INPUT:	NONE
;	OUTPUT:	NONE
;	RETURNS: +1=OK
;
TEOFWT:	SKIPN	LABEL
	RET			;NO LABELS
	CALL	TOPEN
	MOVE	AC2,[POINT 7,[ASCIZ/EOF1/]]
	MOVE	AC1,[POINT 7,DSL1]
	MOVEI	AC3,0
	CALL	MOVBYT
	MOVE	AC1,[POINT 7,DSL1+^D10,27]
	MOVE	AC2,IOBCNT
	MOVEI	AC3,6
	CALL	DONOUT			;BLOCK COUNT
	MOVE	AC1,[POINT 7,DSL1]
	MOVE	AC2,[POINT 8,OUTBF1]
	CALL	TLBLWT			;WRITE EOF1
	MOVE	AC2,[POINT 7,[ASCIZ/EOF2/]]
	MOVE	AC1,[POINT 7,DSL2]
	MOVEI	AC3,0
	CALL	MOVBYT
	MOVE	AC1,[POINT 7,DSL2]
	MOVE	AC2,[POINT 8,OUTBF2]
	CALL	TLBLWT			;WRITE EOF2
	CALL	TCLOSE
	RET
	SUBTTL TAPE INPUT
;
;	TAPE INPUT
;	INPUT:	NONE
;	OUTPUT:	INBCT,INRCT,INBPT
;	RETURN:	+1=EOF, +2=OK
;
TREAD:	MOVE	AC1,TJFN	;GET STATUS OF LAST READ
	GDSTS
	TRNE	AC2,MT%DVE+MT%DAE
	 CALL	ERROR
	TRNE	AC2,MT%EOF	;EOF?
	JRST	TREOF		;YES
	AOS	IOBCNT		;COUNT # OF BLOCKS
	HLRZ	AC3,AC3
	MOVE	INBCT,AC3	;SET INBCT,INRCT,INBPT
	MOVEI	INRCT,0
	MOVE	AC1,INLST
	MOVE	INBPT,-2(AC1)
	MOVE	AC1,-1(AC1)	;SWITCH BUFFERS
	MOVEM	AC1,INLST
TRD1ST:	CALL	TCLEAR
	MOVE	AC2,INLST	;IO LIST PTR
	TLO	AC2,(DM%NWT)	;DON'T WAIT FOR I/O
	DUMPI
	 ERCAL	ERROR
	RETSKP
TREOF:	TLO	FLAGS,%EOF	;FLAG EOF
	RET
	SUBTTL TAPE OUTPUT
;
;	TAPE OUTPUT
;	INPUT:	NONE
;	OUTPUT:	OUTBPT,OUTBCT,OUTRCT
;	RETURN:	+1=OK
;
TWRLST:	MOVE	AC3,BLKSZ	;WRITE LAST BLOCK IF NON-EMPTY
	TLNE	FLAGS,%VLR
	SUBI	AC3,8
	CAMG	AC3,OUTBCT
	RET			;EMPTY
	MOVE	AC3,LRECL
	TLNE	FLAGS,%VLR
	SUBI	AC3,4
	CAME	AC3,OUTRCT
	CALL	TWLREC		;END LAST RECORD
TWRITE:	TLNN	FLAGS,%VLR
	JRST	TWNVLR		;NOT VARIABLE LENGTH RECORDS
	MOVSI	AC1,41000
	HRR	AC1,@OUTLST	;CONSTRUCT BYTE PTR TO BDW
	MOVE	AC2,BDWCT
	CALL	ADDDW		;ADD BLOCK DESCRIPTOR
	LSH	AC2,-2		;UPDATE I/O LIST WRITE COUNT
	MOVN	AC2,AC2
	HRLM	AC2,@OUTLST
TWNVLR:	MOVE	AC1,TJFN	;WRITE CURRENT OUTPUT BUFFER
	MOVE	AC2,OUTLST
	TLO	AC2,(DM%NWT)
	DUMPO
	 ERCAL	ERROR
	AOS	IOBCNT		;INCR BLOCK COUNT
	MOVE	AC2,OUTLST	;SWITCH BUFFERS
	MOVE	AC2,-1(AC2)
	MOVEM	AC2,OUTLST
	TLNN	FLAGS,%VLR
	JRST	TWBFCL		;FIXED LENGTH RECORDS
	MOVE	AC1,RDWPT	;SAVE PTR TO BYTES ALREADY READ FROM NXT RECORD
	MOVEM	AC1,WXTRAP	;(IF ANY) SINCE THEY DIDN'T FIT INTO THIS BLOCK
	MOVE	AC1,LRECL
	SUB	AC1,OUTRCT	;COMPUTE # OF SUCH BYTES
	SUBI	AC1,4
	MOVEM	AC1,WXTRAC
TWBFCL:	MOVE	AC2,OUTLST
	MOVE	OUTBPT,-2(AC2)	;SET OUTBPT, OUTBCT, OUTRCT
	MOVE	OUTBCT,BLKSZ
	MOVE	OUTRCT,LRECL
	MOVE	AC3,[BYTE (8) 40,40,40,40]
	SKIPE	DATA
	MOVE	AC3,[BYTE (8) 100,100,100,100]
	SKIPN	BLANKS
	 MOVEI	AC3,0
	MOVEM	AC3,(OUTBPT)	;CLEAR OUTPUT BUFFER
	HRL	AC1,OUTBPT
	HRR	AC1,OUTBPT
	ADDI	AC1,1
	HRRZ	AC2,OUTBPT
	BLT	AC1,<<MAXBLK+3>/4-1>(AC2)
	TLNN	FLAGS,%VLR
	RET			;WRITING FIXED LENGTH RECORDS
	MOVEI	AC1,4		;ALLOCATE BLOCK DESCRIPTOR
	MOVEM	AC1,BDWCT	;INIT BLOCK DESCRIPTOR COUNT
	SUB	OUTBCT,AC1	;ADJUST BLOCK COUNTER
	ADJBP	AC1,OUTBPT	;AND OUTPUT POINTER
	MOVE	OUTBPT,AC1
	CALL	TWRDW		;ALLOCATE RECORD DESCRIPTOR
	SKIPG	WXTRAC
	RET			;NO BYTES READ FROM NEXT RECORD
	MOVE	AC2,WXTRAP
	MOVE	AC3,WXTRAC	;MOVE BYTES ALREADY READ TO START OF BUFFER
	MOVEI	AC1,4
	ADJBP	AC1,AC2
	ILDB	AC2,AC1
	IDPB	AC2,OUTBPT
	SOJ	OUTBCT,
	SOJ	OUTRCT,
	AOS	RDWCT
	SOJG	AC3,.-5
	RET
TWRDW:	MOVEM	OUTBPT,RDWPT	;ALLOCATE RECORD DESCRIPTOR
	MOVEI	AC1,4
	MOVEM	AC1,RDWCT	;INIT RECORD DESCRIPTOR COUNT
	SUB	OUTBCT,AC1	;ADJUST BLOCK COUNTER
	SUB	OUTRCT,AC1	;AND RECORD COUNTER
	ADJBP	AC1,OUTBPT	;AND OUTPUT POINTER
	MOVE	OUTBPT,AC1
	RET
TWLREC:	AOS	IORCNT		;BUMP RECORD COUNTER
	TLNE	FLAGS,%VLR
	JRST	WTVLRE		;VARIABLE LENGTH RECORDS
	MOVE	AC3,BLKSZ
	SUB	AC3,OUTBCT	;FIXED LENGTH
	ADDI	AC3,3
	LSH	AC3,-2		;ROUND BYTES WRITTEN TO MULTIPLE OF 4
	MOVN	AC3,AC3		;ADJUST I/O LIST WRITE COUNT
	HRLM	AC3,@OUTLST
	RET
	SUBTTL SKIP FILES
;
;	SKIP FILES (TAPE MARKS)
;	INPUT:  AC4= FILE #
;	OUTPUT: NONE
;	RETURNS: +1=USER ERROR, +2=OK
;
SKPOPN:	MOVE	AC1,TJFN	;OPEN FOR SKIP ROUTINES
	MOVE	AC2,[17B9+OF%RD]
	OPENF
	 ERCAL	ERROR
	JRST	SETPRM
;
	LAST			;SKIP TO LAST FILE
	EOT			;SKIP TO END OF TAPE
	RSKP			;SKIP TO NEXT FILE
TSKIP:	CAIG	AC4,0		;SYMBOLIC FILE #?
	JRST	@TSKIP-1(AC4)	;YES
	SUB	AC4,TFN		;COMPUTE # FILES TO SKIP
	JUMPE	AC4,RSKP	;NOTHING TO SKIP
	JUMPL	AC4,SKPBK	;BACKSPACE
	SKIPE	LABEL
	IMULI	AC4,3		;3 FILES FOR EACH DATA FILE IF LABELLED
	TRZ	FLAGS,%EOT	;EOT IS ERROR
SKPFW:	SETZM	TSKPCT
	CALL	SKPOPN		;OPEN TAPE & SET PARAMETERS
	MOVEI	AC2,INLST1
	DUMPI
	JRST	SKPEOT		;CHECK FOR EOF
SKPFOK:	CALL	TCLEAR
	CALL	TSKPTM		;SKIP A TAPE MARK
	AOS	TSKPCT
	CALL	TCLOSE
	SOJG	AC4,SKPFW+1	;SKIP ALL FILES
	MOVE	AC3,TSKPCT
	SKIPE	LABEL
	IDIVI	AC3,3		;UPDATE FILE #
	ADD	AC3,TFN
	MOVEM	AC3,TFN
	RETSKP
SKPEOT:	CAIE	AC1,IOX4
	JRST	SKPFOK		;IGNORE ERRORS
	MOVE	AC3,TSKPCT
	SKIPE	LABEL		;UPDATE FILE #
	IDIVI	AC3,3
	ADD	AC3,TFN
	MOVEM	AC3,TFN
	TRZE	FLAGS,%EOT	;EOT OK?
	RET			;YES
EOTERR:	MOVE	AC1,TJFN
	MOVEI	AC2,.MOBKF	;REPOSITION BEFORE LAST TM
	MTOPR
	 ERCAL	ERROR
	CALL	PCRIF
	TMSG	<?End of tape before specified file>
	CALL	TCLOSE
	RET

SKPBK:	CALL	SKPOPN		;OPEN TAPE & SET PARAMETERS
	MOVE	AC3,TFN
	ADD	AC3,AC4		;UPDATE FILE #
	MOVEM	AC3,TFN
	CAIE	AC3,1
	JRST	SKPBK1
	MOVEI	AC2,.MOREW	;1ST FILE= REWIND
	MTOPR
	 ERCAL	ERROR
	CALL	TCLOSE
	SKIPN	LABEL
	RETSKP
	CALL	SKPOPN		;READ VOL LABEL
	MOVEI	AC2,LBREAD
	DUMPI
	 ERCAL	ERROR
	CALL	TCLOSE
	RETSKP
SKPBK1:	SKIPE	LABEL
	IMULI	AC4,3		;3 FILES FOR EACH DATA FILE IF LABELLED
	MOVEI	AC2,.MOBKF	;BACKSPACE TAPE
	MTOPR
	 ERCAL	ERROR
	AOJLE	AC4,.-1		;BACKSPACE COUNT+1 TAPE MARKS
	CALL	TSKPTM		;SKIP OVER LAST TM
	CALL	TCLOSE
	RETSKP
EOT:	TRO	FLAGS,%EOT	;ALLOW EOT
	MOVEI	AC4,-1		;SKIP TO EOT
	CALL	SKPFW
	MOVE	AC1,TJFN
	MOVEI	AC2,.MOBKF	;BACKSPACE OVER LAST TAPE MARK
	MTOPR
	 ERCAL	ERROR
	CALL	TCLOSE
	RETSKP
LAST:	CALL	EOT		;SKIP TO EOT
	JFCL
	HRROI	AC4,-1		;BACKSPACE 1 FILE
	JRST	SKPBK
	SUBTTL	CONVERT INPUT BYTE
;
;	TRANSLATION TABLE: ASCII->EBCDIC,,EBCDIC->ASCII
;	NON-TRANSLATABLES ARE TRANSLATED TO SUB'S
;	BELIEVED TO BE THE SAME AS OPTCD=Q, EXCEPT:
;	ASCII->EBCDIC: ! -> ! (INSTEAD OF VERT BAR)
;		       ^ -> CENT (NOT)
;		       TILDE -> NOT (TILDE)
;	EBCDIC->ASCII: CENT -> ^ ([)
;		       NOT -> TILDE (^)
;			! -> ! (])
;			[ -> [ (^Z)
;			] -> ] (^Z)
;
TRNTAB:	0,,0			; NULL,,NULL
	1,,1			; SOH,,SOH
	2,,2			; STX,,STX
	3,,3			; ETX,,ETX
	67,,32			; EOT,,PF
	55,,11			; ENQ,,HT
	56,,32			; ACK,,LC
	57,,177			; BEL,,DEL
	26,,32			; BS,,GE
	5,,32			; HT,,RLF
	45,,32			; LF,,SMM
	13,,13			; VT,,VT
	14,,14			; FF,,FF
	15,,15			; CR,,CR
	16,,16			; SO,,SO
	17,,17			; SI,,SI
	20,,20			; DLE,,DLE
	21,,21			; DC1,,DC1
	22,,22			; DC2,,DC2
	23,,23			; DC3,,TM
	74,,32			; DC4,,RES
	75,,32			; NAK,,NL
	62,,10			; SYN,,BS
	46,,32			; ETB,,IL
	30,,30			; CAN,,CAN
	31,,31			; EM,,EM
	77,,32			; SUB,,CC
	47,,32			; ESC,,CU1
	34,,34			; FS,,IFS
	35,,35			; GS,,IGS
	36,,36			; RS,,IRS
	37,,37			; US,,IUS
	100,,32			; BLANK,,DS
	132,,32			; !,,SOS
	177,,32			; ",,FS
	173,,32			; #,,
	133,,32			; $,,BYP
	154,,12			; %,,LF
	120,,27			; &,,ETB
	175,,33			; ',,ESC
	115,,32			; (,,
	135,,32			; ),,
	134,,32			; *,,SM
	116,,32			; +,,CU2
	153,,32			; ,,,
	140,,5			; -,,ENQ
	113,,6			; .,,ACK
	141,,7			; /,,BEL
	360,,32			; 0,,
	361,,32			; 1,,
	362,,26			; 2,,SYN
	363,,32			; 3,,
	364,,32			; 4,,PN
	365,,32			; 5,,RS
	366,,32			; 6,,UC
	367,,4			; 7,,EOT
	370,,32			; 8,,
	371,,32			; 9,,
	172,,32			; :,,
	136,,32			; ;,,CU3
	114,,24			; <,,DC4
	176,,25			; =,,NAK
	156,,32			; >,,
	157,,32			; ?,,SUB
	174,,40			; @,,BLANK
	301,,32			; A,,
	302,,32			; B,,
	303,,32			; C,,
	304,,32			; D,,
	305,,32			; E,,
	306,,32			; F,,
	307,,32			; G,,
	310,,32			; H,,
	311,,32			; I,,
	321,,136		; J,,CENT SIGN
	322,,56			; K,,.
	323,,74			; L,,<
	324,,50			; M,,(
	325,,53			; N,,+
	326,,41			; O,,VERTICAL BAR
	327,,46			; P,,&
	330,,32			; Q,,
	331,,32			; R,,
	342,,32			; S,,
	343,,32			; T,,
	344,,32			; U,,
	345,,32			; V,,
	346,,32			; W,,
	347,,32			; X,,
	350,,32			; Y,,
	351,,41			; Z,,!
	255,,44			; [,,$
	340,,52			; \,,*
	275,,51			; ],,)
	112,,73			; ^,,;
	155,,176		; _,,NOT SIGN [136]
	171,,55			; GRAVE,,-
	201,,57			; a,,/
	202,,32			; b,,
	203,,32			; c,,
	204,,32			; d,,
	205,,32			; e,,
	206,,32			; f,,
	207,,32			; g,,
	210,,32			; h,,
	211,,32			; i,,
	221,,174		; j,,|
	222,,54			; k,,,
	223,,45			; l,,%
	224,,137		; m,,_
	225,,76			; n,,>
	226,,77			; o,,?
	227,,32			; p,,
	230,,32			; q,,
	231,,32			; r,,
	242,,32			; s,,
	243,,32			; t,,
	244,,32			; u,,
	245,,32			; v,,
	246,,32			; w,,
	247,,32			; x,,
	250,,140		; y,,GRAVE
	251,,72			; z,,:
	300,,43			; {,,#
	152,,100		; |,,@
	320,,47			; },,'
	137,,75			; TILDE,,=
	7,,42			; DEL,,"
	77,,32			;
	77,,141			; ,,a
	77,,142			; ,,b
	77,,143			; ,,c
	77,,144			; ,,d
	77,,145			; ,,e
	77,,146			; ,,f
	77,,147			; ,,g
	77,,150			; ,,h
	77,,151			; ,,i
	77,,32			;
	77,,32			;
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,152			; ,,j
	77,,153			; ,,k
	77,,154			; ,,l
	77,,155			; ,,m
	77,,156			; ,,n
	77,,157			; ,,o
	77,,160			; ,,p
	77,,161			; ,,q
	77,,162			; ,,r
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,176			; ,,TILDE
	77,,163			; ,,s
	77,,164			; ,,t
	77,,165			; ,,u
	77,,166			; ,,v
	77,,167			; ,,w
	77,,170			; ,,x
	77,,171			; ,,y
	77,,172			; ,,z
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,133			; ,,[
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,135			; ,,]
	77,,32			; 
	77,,32			; 
	77,,173			; ,,{
	77,,101			; ,,A
	77,,102			; ,,B
	77,,103			; ,,C
	77,,104			; ,,D
	77,,105			; ,,E
	77,,106			; ,,F
	77,,107			; ,,G
	77,,110			; ,,H
	77,,111			; ,,I
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,175			; ,,}
	77,,112			; ,,J
	77,,113			; ,,K
	77,,114			; ,,L
	77,,115			; ,,M
	77,,116			; ,,N
	77,,117			; ,,O
	77,,120			; ,,P
	77,,121			; ,,Q
	77,,122			; ,,R
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,134			; ,,\
	77,,32			; 
	77,,123			; ,,S
	77,,124			; ,,T
	77,,125			; ,,U
	77,,126			; ,,V
	77,,127			; ,,W
	77,,130			; ,,X
	77,,131			; ,,Y
	77,,132			; ,,Z
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,60			; ,,0
	77,,61			; ,,1
	77,,62			; ,,2
	77,,63			; ,,3
	77,,64			; ,,4
	77,,65			; ,,5
	77,,66			; ,,6
	77,,67			; ,,7
	77,,70			; ,,8
	77,,71			; ,,9
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			; 
	77,,32			;
;
;	INPUT:  AC1=BYTE
;	OUTPUT: AC1=CONVERTED BYTE
;	RETURNS: +1 ALWAYS
;
CHCASE:	SKIPN	CASE
	RET			;NOCHANGE
	SKIPG	CASE
	JRST	LOWER		;LOWER
UPPER:	CAIGE	AC1,"a"		;CAPITALIZE ASCII LOWER CASE
	RET			;NOT LOWER CASE
	CAILE	AC1,"z"
	RET
	TRZ	AC1,40
	RET
LOWER:	CAIGE	AC1,"A"		;CONVERT ASCII UPPER TO LOWER
	RET			;NOT UPPER CASE
	CAILE	AC1,"Z"
	RET
	TRO	AC1,40
	RET
CONVRT:	MOVE	AC2,DATA	;CONVERT BYTE IN AC1
	JRST	@.+1(AC2)
	CHCASE			;ASCII
	CVT1			;EBCDIC
CVT3:	HRRZ	AC1,TRNTAB(AC1)	;EBCDIC(READ), I.E EBCDIC->ASCII
	JRST	CHCASE
CVT1:	TLNE	FLAGS,%READ	;WRITE?
	JRST	CVT3		;NO, READ
	CALL	CHCASE		;EBCDIC(WRITE), I.E. ASCII->EBCDIC
	HLRZ	AC1,TRNTAB(AC1)	;ASCII->EBCDIC
	RET
	SUBTTL	READ INPUT BYTE
;	INPUT:  NONE
;	OUTPUT: AC1=BYTE
;	RETURNS: +1=EOF/COUNT EXHAUSTED, +2=BYTE IN AC1
;
READ:	TLNE	FLAGS,%READ	;READING FROM TAPE?
	JRST	RTAPE		;YES
RDISK:	TRNE	FLAGS,%XTAB	;EXPANDING TAB?
	JRST	RDTABX		;YES
RDGETB:	CALL	RDNXTB		;GET NEXT BYTE
	RET			;EOF
	SKIPG	SKIP		;SKIP?
	JRST	RDPMK
	CAIE	AC1,15		;END OF LINE?
	JRST	RDGETB
	CALL	RDNXTB
	RET
	CAIN	AC1,12
	SOS	SKIP		;YES, DECR SKIP COUNT
	JRST	RDGETB
RDPMK:	SKIPN	LINOS		;FLUSH PAGE MARKS & LINE #S?
	JRST	RDNULL		;NO
	MOVE	AC2,(INBPT)
	TRNN	AC2,1		;PAGE MARK OR LINE #?
	JRST	RDNULL		;NO
	MOVEI	AC3,5		;FLUSH LINE # & TAB OR PAGE MARK & CR
	MOVE	AC2,INEOF	;DECR EOF COUNT
	SUB	AC2,AC3
	MOVEM	AC2,INEOF
	SUB	INBCT,AC3	;DECR BLOCK COUNT
	ADJBP	AC3,INBPT	;ADJ BYTE PTR
	MOVE	INBPT,AC3
	JRST	RDGETB
RDNULL:	SKIPE	NULL		;FLUSH NULLS?
	JUMPE	AC1,RDGETB
	JUMPN	INCOL,RDCHK
	TLNN	FLAGS,%CC	;START OF RECORD: CC?
	JRST	RDCHK		;NO
	CAIE	AC1,12		;LF?
	JRST	RDCCPG		;NO, CHECK FOR FF
	MOVEI	AC1,"0"		;1 LF => CC=0
	MOVEM	AC1,CC
	CALL	RDNXTB
	RET
	CAIE	AC1,12
	JRST	RDCCPG
	MOVEI	AC1,"-"		;2 LF'S => CC=-
	MOVEM	AC1,CC
	CALL	RDNXTB
	RET
	CAIE	AC1,12
	JRST	RDCCPG
RDCCBK:	MOVE	AC1,CC		;3 LF'S => CC= "-" & BLANK LINE
	CALL	WRITE
	RET
	TRO	FLAGS,%EOL
	MOVEI	AC1," "
	MOVEM	AC1,CC
	RETSKP
RDCCPG:	CAIE	AC1,14		;^L?
	JRST	RDCCWR
	MOVEI	AC1,"1"		;CC="1"
	MOVEM	AC1,CC
	CALL	RDNXTB		;READ NEXT BYTE
	RET
	CAIN	AC1,12
	JRST	RDCCBK		;^L & LF => CC= "1" & BLANK LINE
RDCCWR:	PUSH	P,AC1		;SAVE CHAR
	MOVE	AC1,CC		;WRITE CARRIAGE CONTROL
	CALL	WRITE
	JFCL
	MOVEI	AC1," "		;RESET CC
	MOVEM	AC1,CC
	POP	P,AC1		;RESTORE CHAR
	SKIPG	COUNT
	RET			;COUNT EXHAUSTED
RDCHK:	CAIN	AC1,14		;FF?
	JRST	RDFF
	CAIN	AC1,11		;TAB?
	JRST	RDTAB
	CAIE	AC1,15		;CR?
	JRST	RDICOL
RDCR:	CALL	RDNXTB		;CRLF?
	RETSKP			;EOF, WRITE CR
	CAIN	AC1,12
	JRST	RDEOL		;YES
	TLNN	FLAGS,%CC	;CC?
	JRST	RDWRCR		;NO, WRITE CR
	MOVEI	AC2,"+"		;SET CC
	MOVEM	AC2,CC
	PUSH	P,AC1		;SAVE NEXT CHAR
	TRO	FLAGS,%EOL	;FLAG END OF LINE
	MOVEI	AC1," "		;REPLACE CR WITH BLANK
	MOVEI	INCOL,0
	JRST	RDWRTB
RDEOL:	HRROI	INCOL,-2	;RESET COL CNT IN CASE EOR=LRECL
	SKIPE	EOR		;EOR=CRLF?
	JRST	RDWRCR		;NO, WRITE CRLF
	TRO	FLAGS,%EOL	;FLAG EOL
	MOVEI	AC1," "		;REPLACE WITH BLANK
	MOVEI	INCOL,0		;RESET INPUT COLUMN
	RETSKP
RDWRCR:	PUSH	P,AC1		;SAVE NEXT CHAR
	AOJ	INCOL,
	MOVEI	AC1,15		;WRITE CR
RDWRTB:	CALL	WRITE
	JFCL
	POP	P,AC1		;WRITE NEXT CHAR
	SKIPG	COUNT
	RET			;COUNT EXHAUSTED
	JRST	RDPMK

RDFF:	SKIPE	FF		;FLUSH FF?
	JRST	RDGETB		;YES.
	TLNN	FLAGS,%CC	;WRITING CC?
	 JRST	RDICOL		;NO.  JUST SEND THE FF ITSELF
	MOVEI	AC2,"1"		;USE THIS CC
	MOVEM	AC2,CC
	TRO	FLAGS,%EOL	;THIS IS AN EOL
	MOVEI	AC1," "		;REPLACE FF WITH SPACE
	MOVEI	INCOL,0
	JRST	RDWRTB

RDICOL:	AOJ	INCOL,		;INCR COLUMN COUNT
	RETSKP
RDTAB:	SKIPN	TAB		;EXPAND TABS?
	JRST	RDICOL		;NO
	TRO	FLAGS,%XTAB	;SET TAB FLAG
RDTABX:	AOJ	INCOL,		;RETURN BLANKS TILL COL MOD 8=0
	TRNN	INCOL,7
	TRZ	FLAGS,%XTAB
	MOVEI	AC1," "
	RETSKP
RDNXTB:	SKIPG	INEOF
	RET			;EOF
	JUMPG	INBCT,RDNXLD
	MOVE	AC1,INPG	;MAP NEW DISK PAGE
	MOVE	AC2,[XWD .FHSLF,INBPG]
	MOVE	AC3,[PM%CNT+PM%RD+BUFL]
	PMAP
	MOVEI	INBCT,5000*BUFL	;RESET PAGE COUNT & BYTE POINTER
	MOVE	INBPT,[POINT 7,INBUF1]
	MOVE	AC1,INPG	;INCR INPUT PAGE #
	ADDI	AC1,BUFL
	MOVEM	AC1,INPG
RDNXLD:	ILDB	AC1,INBPT	;GET NEXT BYTE
	SOS	INEOF		;DECR EOF COUNT
	SOJ	INBCT,		;DECR PAGE COUNT
	RETSKP

RTAPE:	CALL	RTNXTB		;GET NEXT BYTE
	RET			;EOF
	SKIPLE	SKIP
	JRST	RTAPE		;SKIP
RTFL72:	CAMGE	INRCT,RTEEOR
	JRST	RTAPE		;THROW OUT 72-80
	SKIPE	NULL		;FLUSH NULLS?
	JUMPE	AC1,RTAPE
	CAIN	AC1,14		;FF?
	JRST	RTFF
	SKIPE	EOR
	RETSKP			;LOGICAL EOR AT LRECL CHARS
	CAIE	AC1,15		;CR?
	RETSKP
	CALL	RTNXTB		;CRLF?
	RET			;EOF
	CAIE	AC1,12
	JRST	RTCR		;NO, ONLY CR
	CALL	RTLEOR		;LOGICAL EOR
	RET			;EOF
	JRST	RTAPE
RTCR:	PUSH	P,AC1		;NO, ONLY CR
	MOVEI	AC1,15
	CALL	WRITE		;SO WRITE IT
	JFCL
	POP	P,AC1		;RESTORE NEXT CHAR
	SKIPG	COUNT
	RET			;COUNT EXHAUSTED
	JRST	RTFL72
RTFF:	SKIPE	FF		;FLUSH FF?
	JRST	RTAPE
	RETSKP
RTNXTB:	JUMPG	INBCT,RTRCT	;READ NEXT BYTE
RTNXT1:	CALL	RTREAD		;READ NEXT RECORD
	RET
RTRCT:	JUMPG	INRCT,RTGETB
	SKIPG	SKIP
	AOS	IORCNT		;INCR RECORD COUNT
	CALL	RTSOR		;TAPE EOR
	 JRST	RTNXT1		;RECORD CONTAINED PADDING ONLY
	SKIPN	EOR
	JRST	RTNXTB		;LOGICAL EOR IS AT CRLF
	CALL	RTLEOR		;LOGICAL EOR AT TAPE EOR
	RET			;EOF
	JRST	RTNXTB
RTGETB:	ILDB	AC1,INBPT	;GET NEXT BYTE
	CALL	CONVRT		;CONVERT BYTE
	SOJ	INBCT,
	SOJA	INRCT,RSKP
RTREAD:	CALL	TREAD		;START NEXT READ
	JRST	RTEOF		;EOF
	CAMLE	INBCT,BLKSZ	;RECORD(S)>BLKSIZE?
	TRO	FLAGS,%BIGBK	;YES
	MOVE	AC1,BLKPFX	;STRIP OFF BLOCK PREFIX (BDW)
	MOVE	AC2,RECFM
	ANDI	AC2,$B-1
	CAIN	AC2,$V
	MOVEI	AC1,4
	JUMPE	AC1,RSKP
	SUB	INBCT,AC1
	ADJBP	AC1,INBPT
	MOVE	INBPT,AC1
	RETSKP

RTEOF:	SKIPLE	SKIP		;EOF -> EOR
	RET
	AOS	IORCNT		;COUNT LAST RECORD
	CALL	TRLBLK		;DEAL WITH BLANKS
	MOVE	AC2,[POINT 7,[BYTE (7) 15,12]]
	CALL	RTWEOR		;WRITE EOR
	JFCL
	RET

RTSOR:	MOVE	AC1,RECFM	;START OF TAPE RECORD
	ANDI	AC1,$B-1
	JRST @[	RTD
		RTF
		RTU
		RTV ](AC1)	;DISPATCH ON RECFM
RTF:	MOVE	INRCT,LRECL	;RESET RECORD COUNT
	RETSKP

RTD:	MOVE	AC1,INBPT	;READ 4 BYTE ASCII LENGTH
	MOVEI	AC2,4
	CALL	DONIN
	JUMPG	AC3,RTD1
	ILDB	AC2,INBPT	;CHECK FOR END OF BLOCK (PADDING)
	CAIN	AC2,"^"
	 RET			;END OF BLOCK
RTD1:	MOVE	INBPT,AC1
	MOVE	INRCT,AC3
	JRST	RTVEND

RTV:	ILDB	INRCT,INBPT	;READ 2 BYTE BINARY LENGTH
	LSH	INRCT,10
	ILDB	AC2,INBPT
	IOR	INRCT,AC2
	IBP	INBPT		;SKIP 2 UNUSED BYTES
	IBP	INBPT
RTVEND:	SUBI	INBCT,4		;DECR BLOCK COUNT
	CAMLE	INRCT,LRECL	;RECORD > LRECL?
	 TRO	FLAGS,%CHOP	;YES (PROBABLY NOT VARIABLE LENGTH)
	SUBI	INRCT,4		;RECORD COUNT INCLUDES 4 BYTE LENGTH
	CAIGE	INRCT,0
	 MOVEI	INBCT,0		;PROCESS NULL RECORD, RECFM=V
	RETSKP

RTU:	MOVE	INRCT,INBCT	;RECFM=U, SET RECORD COUNT=BLOCK COUNT
	RETSKP

RTLEOR:	SOS	SKIP		;END OF LOGICAL RECORD
	JUMPE	OUTEOF,RTLSOR	;1ST RECORD
	CALL	TRLBLK		;DEAL WITH TRAILING BLANKS
	MOVE	AC2,[POINT 7,[BYTE (7) 15]]
	TLNN	FLAGS,%CC
	MOVE	AC2,[POINT 7,[BYTE (7) 15,12]]
	CALL	RTWEOR		;WRITE CR(LF)
	RET
	SOSG	COUNT
	RET			;COUNT EXHAUSTED
RTLSOR:	SKIPLE	SKIP		;START OF LOGICAL RECORD
	RETSKP
	TLNN	FLAGS,%CC	;CC?
	JRST	RTCLRC
	CALL	RTNXTB		;YES, PROCESS IT
	RET			;EOF
	CAIN	AC1,"+"		;CC="+"?
	 JRST	RTCLRC
	MOVE	AC2,[POINT 7,[BYTE (7) 12]]
	CAIN	AC1,"0"
	 MOVE	AC2,[POINT 7,[BYTE (7) 12,12]]
	CAIN	AC1,"-"
	 MOVE	AC2,[POINT 7,[BYTE (7) 12,12,12]]
	CAIE	AC1,"1"
	 MOVE	AC2,[POINT 7,[BYTE (7) 12,14]]
RTWCC:	CAIG	OUTEOF,0
	ILDB	AC1,AC2		;REMOVE 1 LF IF 1ST RECORD
	CALL	RTWTCC		;WRITE CC
	 RET
RTCLRC:	MOVEI	OUTCOL,0	;RESET COLUMN COUNT
	RETSKP
RTWEOR:	LDB	AC1,OUTBPT	;WRITE EOR
	CAIE	AC1,12		;BLANK LINE?
	 SETZM	LNBEOF		;NO
	SKIPN	LNBEOF
	 JRST	RTWTCC
	MOVE	AC1,[XWD IORCNT,IORSAV]
	BLT	AC1,IOBSAV	;SAVE RECORD/BLOCK COUNTS TO REMOVE BLANK LINES
	MOVE	AC1,[XWD OUTCOL,LNBCOL]
	BLT	AC1,LNBEOF	;SET LAST NONBLANK LINE PTRS
RTWTCC:	MOVEM	AC2,CC		;WRITE CC
RTWTC1:	ILDB	AC1,CC
	JUMPE	AC1,RSKP	;DONE
	CALL	WRITE
	 RET
	JRST	RTWTC1		;LOOP
	SUBTTL	WRITE OUTPUT BYTE
;	INPUT:  AC1=BYTE
;	OUTPUT: NONE
;	RETURNS: +1=COUNT EXHAUSTED, +2=OK
;
WRITE:	TLNE	FLAGS,%READ	;WRITING TO DISK?
	JRST	WDISK		;YES
	JUMPLE	OUTRCT,WTEOR	;JUMP IF END OF RECORD
WTAPE:	CALL	CONVRT		;CONVERT BYTE
	IDPB	AC1,OUTBPT	;WRITE NEXT BYTE
	AOS	RDWCT		;INCR RECORD DESCRIPTOR COUNT
	SOJ	OUTBCT,		;DECR BLOCK COUNT
	SOJG	OUTRCT,.+3	;DECR RECORD COUNT
	SKIPE	EOR		;EOR
	JRST	WTEOL		;EOR IS EOL ALSO
	TRZN	FLAGS,%EOL	;END OF LINE?
	JRST	WTOUT		;NO
WTEOL:	TLNN	FLAGS,%VLR
	JRST	WTFLR		;WRITING FIXED LENGTH RECORDS
	CALL	WTVLRE		;END VARIABLE RECORD
	MOVE	OUTRCT,LRECL
	CALL	TWRDW		;RESERVE SPACE FOR RECORD DESCRIPTOR
	JRST	WTCNT
WTFLR:	JUMPE	OUTRCT,WTCNT-1	;END OF RECORD?
	SUB	OUTBCT,OUTRCT	;NO, SKIP TO NEW LRECL
	ADJBP	OUTRCT,OUTBPT	;DECR BLOCK COUNT, ADJ BYTE POINTER
	MOVE	OUTBPT,OUTRCT
	MOVE	OUTRCT,LRECL	;RESET RECORD COUNTER
WTCNT:	SOS	COUNT		;DECR COUNT
	AOS	IORCNT		;INCR RECORDS PROCESSED
WTOUT:	MOVEI	AC1,<MINREC+3>/4*4
	TLNN	FLAGS,%VLR
	MOVEI	AC1,1
	CAMGE	OUTBCT,AC1
	CALL	WTFBLK		;WRITE FULL BLOCK
	SKIPG	COUNT
	RET			;COUNT EXHAUSTED
	RETSKP
WTFBLK:	CAIG	OUTRCT,0
	AOS	IORCNT		;HERE ONLY IF RECFM=F & LINE=BLKSIZE
	JRST	TWRITE
WTEOR:	CAIE	AC1," "		;TRUNCATING?
	TRO	FLAGS,%CHOP	;YES
	TRZE	FLAGS,%EOL	;END OF LINE?
	JRST	WTEOL		;YES, PROCESS EOL
	RETSKP
	IBP	OUTBPT		;ROUND RECORD LENGTH TO MULTIPLE OF 4
	SOJ	OUTBCT,		;NOTE THAT LRECL IS A MULT OF 4
	AOS	RDWCT
WTVLRE:	MOVE	AC1,RDWCT
	TRNE	AC1,3
	JRST	.-5
	MOVEI	AC4,<MINREC+3>/4*4
	SUB	AC4,RDWCT
	JUMPLE	AC4,WTRLOK
	SUB	OUTBCT,AC4	;INSURE RECORD IS (AT LEAST) 20 BYTES LONG
	ADJBP	AC4,OUTBPT
	MOVE	OUTBPT,AC4
	MOVEI	AC4,<MINREC+3>/4*4
	MOVEM	AC4,RDWCT
WTRLOK:	MOVE	AC1,RDWPT	;ADD DESCRIPTOR TO RECORD
	MOVE	AC2,RDWCT
	CALL	ADDDW
	ADD	AC2,BDWCT	;INCR BLOCK DESCRIPTOR COUNT
	MOVEM	AC2,BDWCT
	MOVE	AC1,RECFM
	TRNN	AC1,$B
	MOVEI	OUTBCT,0	;NOT BLOCKED: EOR IS EOB
	RET
WDISK:	MOVE	AC2,BLANKS	;STRIP BLANKS OR REPLACE WITH TABS?
	ADD	AC2,TAB
	JUMPE	AC2,WDDPB	;NO
	CAIE	AC1," "		;BLANK?
	JRST	WDNBK		;NO
	TRNE	FLAGS,%BLK	;1ST BLANK OF BLANK(S)?
	JRST	WDDPB		;NO
	MOVE	AC2,[XWD OUTCOL,SBKCOL]
	BLT	AC2,SBKEOF	;SET PTRS TO START OF BLANKS
	TRO	FLAGS,%BLK	;SET FLAG
	JRST	WDDPB
WDNBK:	PUSH	P,AC1		;SAVE CURRENT CHARACTER
	TRZE	FLAGS,%BLK	;RESET BLANKS FLAG
	CALL	SQUEEZ		;REPLACE BLANKS WITH TAB(S)?
	POP	P,AC1
WDDPB:	IDPB	AC1,OUTBPT	;WRITE NEXT BYTE
	AOJ	OUTEOF,		;INCR EOF COUNT
	AOJ	OUTCOL,		;INCR COLUMN COUNT
	SOJG	OUTBCT,RSKP	;DECR PAGE COUNT
WDMAP:	MOVE	AC1,[XWD .FHSLF,OUTBPG]
	MOVE	AC2,OUTPG
	MOVE	AC3,[PM%WR+PM%CNT+BUFL]
	PMAP			;WRITE TO DISK
	MOVE	AC1,OUTPG	;INCR OUTPUT PAGE #
	ADDI	AC1,BUFL
	MOVEM	AC1,OUTPG
	CALL	WDSET		;INITIALIZE
	RETSKP
WDSET:	MOVEI	OUTBCT,5000*BUFL ;RESET OUTPUT BLOCK COUNT & BYTE POINTER
	MOVE	OUTBPT,[XWD OUTBF1,OUTBF1+1]
	SETZM	OUTBF1
	BLT	OUTBPT,OUTBF1+1000*BUFL-1 ;CLEAR THE OUTPUT BUFFER
	MOVE	OUTBPT,[POINT 7,OUTBF1]
	RET
	SUBTTL	EXECUTE COMMAND
;	INPUT:  NONE
;	OUTPUT: NONE
;	RETURNS: +1=DONE
;
EXEC:	TLCE	FLAGS,%READ+%WRITE	;CHECK FOR CONSISTENCY
	 TLCN	FLAGS,%READ+%WRITE
	  WARN  <Internal error: both read and write flags set>
	TLNE	FLAGS,%READ	;READ?
	 JRST	EXREAD		;YES

	MOVE	AC4,@OJFNP
	CALL	TSKIP		;POSITION TAPE
	RET			;POSITION ERROR
EXWRT:	MOVE	AC1,BLKSZ
	LSH	AC1,-2		;COMPUTE # OF WORDS FOR I/O LISTS
	MOVN	AC1,AC1
	HRLM	AC1,OUTLS1
	HRLM	AC1,OUTLS2
	CALL	THDRWT		;WRITE ANY HEADER LABELS
	CALL	TOPEN
	SETZM	IORCNT		;RESET RECORDS PROCESSED
	SETZM	IOBCNT		;RESET BLOCKS PROCESSED
	CALL	TWBFCL		;INIT OUTPUT VARIABLES
	HRRZ	AC1,@IJFNP	;GET INPUT JFN
	MOVE	AC2,[7B5+OF%RD+OF%PLN]
	OPENF			;OPEN INPUT FILE
	 ERCAL	ERROR
	HRLZM	AC1,INPG	;INIT INPUT PAGE
	MOVE	AC2,[2,,11]	;CALCULATE EOF
	MOVEI	AC3,AC1
	GTFDB			;AC1=BYTE SIZE, AC2=EOF COUNT
	LSH	AC1,6		;ISOLATE BYTE SIZE
	LSH	AC1,-^D30
	MOVEI	AC3,^D36
	IDIV	AC3,AC1		;# BYTES/WORD
	IDIV	AC2,AC3		;# WORDS IN FILE
	CAIE	AC3,0
	AOJ	AC2,
	IMULI	AC2,5		;# 7 BIT BYTES IN FILE
	MOVEM	AC2,INEOF	;INIT EOF COUNT
	MOVEI	INBCT,0		;INIT PAGE COUNT
	MOVEI	INCOL,0		;INIT COLUMN COUNT
	HRRZ	AC2,@IJFNP	;PRINT INPUT FILE NAME
	CALL	PRTFIL
	CALL	PRTARW		;PRINT =>
	CALL	PRTTFN		;PRINT TAPE FILE #
EXGO:	CALL	READ		;READ NEXT BYTE
	JRST	EXEOF		;EOF
	CALL	WRITE		;WRITE BYTE
	JRST	EXEOF		;COUNT EXHAUSTED
	JRST	EXGO

EXREAD:	MOVE	AC4,@IJFNP	;GET TAPE FILE #
	CALL	TSKIP		;POSITION TAPE
	 RET			;POSITION ERROR
	CALL	THDRRD		;READ ANY HEADER LABELS
	 FMTERR <Tape not labelled as specified>	 
	CALL	TOPEN
	SETZM	IORCNT		;RESET RECORDS PROCESSED
	SETZM	IOBCNT		;RESET BLOCKS PROCESSED
	CALL	TRD1ST		;START 1ST READ
	JFCL
	MOVEI	OUTEOF,0	;INIT OUTPUT EOF COUNT
	MOVE	AC1,@OJFNP	;OPEN DISK FOR OUTPUT
	JUMPG	AC1,EXREA5	;A GOOD JFN WAS SPECIFIED
	SKIPE	LABEL		;WE BETTER HAVE A LABEL!
	 JRST	EXREA4		;WE DO.  USE IT
EXREA3:	HRROI	AC1,CMABUF	;BAD LABEL, OR NONE.  MAKE A FILE NAME
	HRROI	AC2,[ASCIZ/TAPEIO-FILE-/]
	SETZ	AC3,
	SOUT
	MOVE	AC2,TFN
	MOVEI	AC3,^D10
	NOUT
	SETZ	AC3,		;END WITH A NULL
	IDPB	AC3,AC1
EXREA4:	MOVSI	AC1,(GJ%FOU+GJ%SHT)
	HRROI	AC2,CMABUF	;POINT TO STRING FROM HEADER, IF ANY
	GTJFN
	 ERJMP	EXREA3
	MOVEM	AC1,@OJFNP
EXREA5:	MOVE	AC2,[7B5+OF%WR]
	OPENF
	 ERCAL	ERROR
	HRLZM	AC1,OUTPG	;INIT OUTPUT PAGE
	CALL	WDSET		;INIT OUTPUT VARS
	CALL	PRTTFN		;PRINT TAPE FILE #
	CALL	PRTARW		;PRINT =>
	HRRZ	AC2,@OJFNP	;PRINT OUTPUT FILE
	CALL	PRTFIL
EXREA6:	CALL	RTREAD		;START 2ND READ
	JRST [	SKIPN LABEL	;A NULL FILE ON A LABELLED TAPE IS NOT ERROR
		 JRST EOTERR	;TAPE EMPTY IS AN ERROR IF UNLABELLED
		JRST EXEOF ]
	CALL	RTSOR		;START OF 1ST TAPE RECORD
	 JRST	EXREA6		;IT WAS ALL PADDING???
	CALL	RTLSOR		;START OF 1ST LOGICAL RECORD
	JFCL
	JRST	EXGO		;READ THE TAPE

EXEOF:	TLNN	FLAGS,%READ	;READ?
	JRST	EXWEOF		;NO, WRITE
EXREOF:	MOVE	AC1,[XWD LNBCOL,SBKCOL]
	BLT	AC1,SBKEOF	;POINT TO LAST NONBLANK LINE
	SKIPN	BLANKS
	SETZM	LNBEOF		;NOT REMOVING
	SKIPE	LNBEOF
	CALL	RESET		;REMOVE BLANK LINE(S)
	SOS	IORSAV
	MOVE	AC1,[XWD IORSAV,IORCNT]
	SKIPE	LNBEOF
	BLT	AC1,IOBCNT	;RESET RECORD/BLOCK COUNTERS
	MOVE	AC1,[XWD .FHSLF,OUTBPG]
	MOVE	AC2,OUTPG	;MAP LAST PAGE(S)
	HRRZ	AC3,OUTBPT	;COMPUTE REPEAT COUNT
	LSH	AC3,-11
	SUBI	AC3,OUTBPG-1
	HRLI	AC3,(PM%WR+PM%CNT)
	CAIE	OUTBCT,5000*BUFL ;EMPTY PAGE?
	PMAP			;NO
	HRRZ	AC1,@OJFNP	;CLOSE OUTPUT
	TLO	AC1,(CO%NRJ)	;DON'T RELEASE JFN
	CLOSF
	 ERCAL	ERROR
	HRRZ	AC1,@OJFNP	;UPDATE FILE BYTE SIZE
	TLO	AC1,(CF%NUD+11B17)
	HRLZI	AC2,(FB%BSZ)
	MOVSI	AC3,700		;TO 7 BIT BYTES
	CHFDB
	HRRZ	AC1,@OJFNP	;UPDATE FILE EOF COUNT
	TLO	AC1,(12B17)
	HRROI	AC2,-1
	MOVE	AC3,OUTEOF
	CHFDB
	HRROI	AC1,[ASCIZ/ [OK]  /]
	TRZE	FLAGS,%BIGBK
	HRROI	AC1,[ASCIZ/ [block(s) > blksize]  /]
	TRZE	FLAGS,%CHOP
	HRROI	AC1,[ASCIZ/ [record(s) > lrecl]  /]
	PSOUT
	CALL	PRTCFM		;PRINT CONFIRMATION
	HRRZ	AC1,@OJFNP
	RLJFN			;RELEASE JFN
	 ERCAL	ERROR
	AOS	TFN		;INCR FILE #
	TLNN	FLAGS,%EOF
	CALL	TSKPTM		;COUNT EXHAUSTED, SKIP TM
	CALL	TCLOSE
	CALL	TEOFRD		;READ EOF LABELS
	MOVE	AC1,@IJFNP	;END OF INPUT FILES?
	CAIE	AC1,0
	 AOS	IJFNP		;NO, INCR TO NEXT
	AOS	OJFNP		;INCR OUTPUT JFN POINTER
	MOVE	AC1,@OJFNP	;GET NEXT JFN
	JUMPN	AC1,EXREAD	;PROCESS IT
	RET			;0->DONE


EXWEOF:	CALL	TWRLST		;WRITE LAST BLOCK IF NOT EMPTY
	CALL	TCLOSE
	AOS	TFN		;INCR TAPE FILE #
	CALL	TEOFWT		;WRITE EOF LABELS
	HRROI	AC1,[ASCIZ/ [OK]  /]
	TRZE	FLAGS,%CHOP
	HRROI	AC1,[ASCIZ/ [record(s) truncated]  /]
	PSOUT
	CALL	PRTCFM		;PRINT CONFIRMATION
	CALL	UNMAP		;UNMAP INPUT FILE
	HRRZ	AC1,@IJFNP	;CLOSE INPUT
	TLO	AC1,(CO%NRJ)	;DON'T RELEASE JFN
	CLOSF
	 ERCAL	ERROR
EXWJFN:	MOVE	AC1,@IJFNP	;ANOTHER FILE FOR THIS JFN?
	GNJFN
	JRST	EXWNFL		;NO, LOOK FOR ANOTHER FILE
	HRRZ	AC1,AC1
	MOVE	AC2,[1,,1]	;CHECK IF THIS IS A DIRECTORY
	MOVEI	AC3,3
	GTFDB
	TLNE	AC3,(FB%DIR)
	JRST	EXWJFN		;DON'T PROCESS DIRECTORIES
	JRST	EXWRT
EXWNFL:	AOS	IJFNP		;ANOTHER INPUT FILE?
	SKIPE	AC1,@IJFNP
	 JRST	EXWRT		;YES, PROCESS IT
	RET			;NO, DONE
	SUBTTL	MAIN PROGRAM

TAPEIO:	RESET			;START HERE
	MOVE	P,[IOWD STKL,STACK]
	TMSG	<TAPEIO version of 14-January-1982.
Type "HELP" for help.
>
	CALL	ASSIGN		;GET A TAPE DRIVE IF POSSIBLE
$PARSE:	MOVEI	AC2,[FLDDB. .CMINI] ;INIT COMND
	CALL	DOCMND
$REPAR:	MOVE	P,[IOWD STKL,STACK] ;RESET THE STACK ON A REPARSE
	HRROI	AC1,-1		;REPARSE STARTS HERE
	RLJFN			;RELEASE ALL JFN'S
	 JFCL
	SETZM	TJFN		;NOTE THAT TAPE JFN HAS BEEN RELEASED
	CALL	INIT		;INITIALIZE THE VARIOUS PARAMETERS
	MOVEI	AC2,[FLDDB. .CMKEY,,COMTAB] ;PARSE COMMAND
	CALL	DOCMND
	HRRZ	AC2,(AC2)
	CALL	CHKTAP		;DO WE HAVE A TAPE DRIVE ASSIGNED?
	 JRST	$PARSE		;NO, USER MUST GIVE TAPE COMMAND
	CALL	(AC2)		;PARSE REST OF COMMAND
	JRST	$PARSE
;CHKTAP - MAKE SURE USER HAS TAPE DRIVE ASSIGNED
;TAKES	AC2/ ADDRESS OF A COMMAND
;RETURNS +1 IF ASSIGNED OR ONE OF HELP OR TAPE COMMANDS
;	 +2 USER HAS BEEN TOLD TO USE TAPE COMMAND

CHKTAP:	SKIPE	TAPDES		;DO WE HAVE A TAPE DRIVE?
	 RETSKP			;YES, SKIP RETURN
	CAIE	AC2,$HELP
	CAIN	AC2,$TAPE
	 RETSKP			;ALLOW HELP OR TAPE IF NO DRIVE ASSIGNED
	CAIE	AC2,$QUIT
	CAIN	AC2,$DISPL
	 RETSKP			;ALLOW QUIT OR DISPLAY AS WELL
	CALL	PCRIF
	TMSG	<?You must use the TAPE-DRIVE command to specify a tape drive.>
	RET			;TELL USER WHAT'S UP
;INITIALIZE VARIABLES BETWEEN REPARSES

INIT:	SETOM	SWSET		;-1 MEANS NO VALUE SET
	MOVE	AC1,[XWD SWSET,SWSET+1]
	BLT	AC1,SWSET+SWLEN-1 ;NO NEW SWITCH VALUES SET YET
	MOVEI	FLAGS,0		;RESET FLAGS
	MOVEI	AC1,IJFNL	;INIT INPUT JFN POINTER
	MOVEM	AC1,IJFNP
	MOVEI	AC1,OJFNL	;INIT OUTPUT JFN POINTER
	MOVEM	AC1,OJFNP
	MOVE	AC1,[377777,,777777]
	MOVEM	AC1,COUNT	;INIT COUNT TO ALL
	SETZM	SKIP		;INIT SKIP TO NONE
	MOVEI	AC1," "		;INIT CARRIAGE CONTROL
	MOVEM	AC1,CC
	SETZM	LNBEOF		;INIT LAST BLANK LINE FLAG
	SETZM	WXTRAC		;INIT EXTRA READ COUNTER
	RET
;ROUTINE TO ACTUALLY DO A COMND% JSYS  
;CALL:	AC2/ SET UP FOR COMND
;RET:	+1 NORMALLY
;	ON ERR, RETURNS VIA NONLOCAL GOTO TO $PARSE.

DOCMND:	MOVE	AC1,CSB+.CMPTR
	MOVEM	AC1,OCMPTR	;SAVE CURRENT .CMPTR VALUE
	MOVEI	AC1,CSB
	COMND			;THE ONLY COMND JSYS IN THE PROGRAM
	 ERCAL	ERROR
	TXNN	AC1,CM%NOP
	 RET			;GOOD RETURN
	CALL	PCRIF
	TMSG	<?Unrecognized command - >
	MOVEI	AC1,.PRIOU
	HRLOI	AC2,.FHSLF
	SETZ	AC3,
	ERSTR
	 JFCL
	  JFCL
DOCMN0:	TMSG	< - >
	MOVE	AC1,CSB+.CMPTR	;POINTER TO REST OF "BAD" LINE
	PSOUT
	CALL	PCRIF
	TMSG	<(Hint: Type BACKSPACE and a question mark for help.)
>
	JRST	$PARSE		;NONLOCAL GOTO


;CONFRM - PARSE A CARRIAGE RETURN

CONFRM:	MOVEI	AC2,[FLDDB. .CMCFM]
	CALL 	DOCMND
	RET
;$WARN - USED BY WARN MACRO TO REPORT USER ERRORS WHILE PARSING

$WARN:	PUSH	P,AC1
	CALL	PCRIF
	TMSG	<?Invalid option - >
	POP	P,AC1
	PSOUT
	TMSG	< - ">
	MOVE	AC1,OCMPTR
	PSOUT			;PRINT BAD FIELD
	TMSG	<"
(Hint: Type BACKSPACE, then enter correct value.)
>
	MOVE	AC1,OCMPTR
	MOVEM	AC1,CSB+.CMPTR	;PUT BACK OLD .CMPTR VALUE
	MOVEI	AC1,.CHNUL
	IDPB	AC1,OCMPTR	;TIE OFF BAD FIELD WITH A NULL
	JRST	$PARSE		;GO TO TOP OF PARSING LOOP


;REPORTING INCOMPATIBLE FORMAT OPTIONS
;$INCOM IS USED BY THE FMTERR MACRO

$INCOM:	PUSH	P,AC1
	CALL	PCRIF
	TMSG	<?Incompatible format options - >
	POP	P,AC1
	PSOUT
	TMSG	<
>
	JRST	$PARSE
	SUBTTL	READ Command

$READ:	TLO	FLAGS,%READ	;SET READ FLAG
	NOISE	(FROM TAPE TO DISK)
	MOVSI	AC2,(GJ%FOU+GJ%XTN)
	MOVEM	AC2,JFNBLK	;SET JFN FLAG BITS
$RTFN:	MOVEI	AC2,[FLDDB. .CMKEY,,TFN2,<a file on the tape>,<NEXT>,<[
		     FLDDB. .CMNUM,CM%SDH,^D10,<the tape file(s) to be read>]>]
	CALL	DOCMND
	JUMPLE	AC2,[WARN <File number must be positive>]
	LDB	AC3,[POINT 9,(AC3),8]
	CAIN	AC3,.CMKEY	;SYMBOLIC FILE #?
	HRRE	AC2,(AC2)	;YES
	MOVEM	AC2,@IJFNP	;ADD FILE # TO LIST
	AOS	AC2,IJFNP	;INCR INPUT POINTER
	CAILE	AC2,IJFNL+JFNLSZ
	WARN	<Too many input files specified>
	MOVEI	AC2,[FLDDB. .CMCMA,CM%SDH,,<a "," followed by additional file(s) to be read>,<*>,<[
		     FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/*/]>,<"*" for default output file name>,,<[
		     FLDDB. .CMFIL,CM%SDH,,<one or more output file(s)>]>]>]
	CALL	DOCMND
	LDB	AC3,[POINT 9,(AC3),8]
	CAIN	AC3,.CMCMA
	JRST	$RTFN		;COMMA->MORE INPUT FILE(S)
	JRST	ROJFN1		;OUTPUT FILE SPECIFIED
$ROJFN:	MOVEI	AC2,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/*/]>,<"*" for default output file name>,,<[
		     FLDDB. .CMFIL,CM%SDH,,<one or more output file(s)>]>]
	CALL	DOCMND
	LDB	AC3,[POINT 9,(AC3),8]
ROJFN1:	CAIN	AC3,.CMTOK	;WAS IT "*"?
	 SETO	AC2,		;YES.  TREAT JFN AS -1
	MOVEM	AC2,@OJFNP	;ADD JFN TO LIST
	AOS	AC2,OJFNP	;INCR OUTPUT JFN POINTER
	CAILE	AC2,OJFNL+JFNLSZ
	 WARN	<Too many output files specified>
	MOVEI	AC2,[FLDDB. .CMCMA,CM%SDH,,<a "," followed by additional output files>,,<[
		     FLDDB. .CMSWI,,OPTTAB,,,<[
		     FLDDB. .CMCFM]>]>]
	CALL	DOCMND
	LDB	AC3,[POINT 9,(AC3),8]
	CAIN	AC3,.CMCMA
	JRST	$ROJFN		;COMMA->MORE OUTPUT FILE(S)
	CALL	$OPTS1		;EITHER SWITCH OR CR
	 JRST	$PARSE
	JRST	$GO		;GO DO IT
	SUBTTL	REWIND and UNLOAD Commands

;REWIND COMMAND

$REWIN:	NOISE	(TAPE)
	CALL	CONFRM
	CALL	.REWIN
	 CALL	ERROR
	RET

.REWIN:	MOVEI	AC1,1		;RESET TAPE FILE #
	MOVEM	AC1,TFN
	CALL	TAPJFN		;GET A JFN ON THE TAPE DRIVE
	MOVE	AC1,TJFN
	MOVX	AC2,OF%RD
	OPENF			;OPEN THE DRIVE
	 ERJMP	R
	MOVE	AC1,TJFN
	MOVEI	AC2,.MOREW	;REWIND
	MTOPR
	 ERJMP	R
	CALL	TCLOSE		;CLOSE JFN
	RETSKP			;RETURN TO TOP LEVEL

;UNLOAD COMMAND

$UNLOA:	NOISE	(TAPE)
	CALL	CONFRM
	CALL	TAPJFN		;GET A JFN ON THE TAPE DRIVE
	MOVE	AC1,TJFN
	MOVX	AC2,OF%RD
	OPENF			;OPEN THE DRIVE
	 ERCAL	ERROR
	MOVE	AC1,TJFN
	MOVEI	AC2,.MORUL
	MTOPR			;REWIND AND UNLOAD TAPE
	 ERCAL	ERROR
	CALL	TCLOSE		;CLOSE THE JFN
	MOVE	AC1,TAPDES
	RELD			;RELEASE THE TAPE DRIVE
	 ERCAL	ERROR
	SETZM	TAPDES		;CLEAR DRIVE DESIGNATOR
	RET			;RETURN TO TOP LEVEL
	SUBTTL	WRITE Command

$WRITE:	TLO	FLAGS,%WRITE
	NOISE	(FROM DISK TO TAPE)
	MOVSI	AC2,(GJ%OLD+GJ%IFG+GJ%XTN)
	MOVEM	AC2,JFNBLK	;SET JFN FLAGS
$WIJFN: MOVEI	AC2,[FLDDB. .CMFIL,CM%SDH,,<the file(s) to be written to tape>]
	CALL	DOCMND
	MOVEM	AC2,@IJFNP	;ADD JFN TO LIST
	AOS	AC2,IJFNP	;INCR INPUT JFN POINTER
	CAILE	AC2,IJFNL+JFNLSZ
	 WARN	<Too many files specified>
	MOVEI	AC2,[FLDDB. .CMCMA,,,<a "," followed by additional files to be written>,<END>,<[
		     FLDDB. .CMKEY,,TFN1,<a position on the tape>,,<[
		     FLDDB. .CMNUM,CM%SDH,^D10,<the tape file sequence number to be written>]>]>]
	CALL	DOCMND
	LDB	AC3,[POINT 9,(AC3),8] ;GET TYPE OF FIELD WE LAST PARSED
	CAIN	AC3,.CMCMA
	JRST	$WIJFN		;COMMA->MORE INPUT FILE(S)
	JUMPLE	AC2,[WARN <File number must be positive>]
	CAIN	AC3,.CMKEY	;TAPE FILE #
	HRRE	AC2,(AC2)	;SYMBOLIC FILE #
	MOVEM	AC2,@OJFNP	;ADD FILE # TO LIST
	AOS	OJFNP		;INCR OUTPUT POINTER
	CALL	$OPTS
	 JRST	$PARSE
	JRST	$GO
	SUBTTL	DEFAULT and REVERT Commands


;DEFAULT COMMAND
;SET NEW DEFAULT SWITCH SETTINGS

$DEFAU:	NOISE	(SWITCHES)
	CALL	$OPTS		;GO PARSE OPTIONS
	 JFCL
	RET			;THEN GET ANOTHER COMMAND


;REVERT COMMAND
;COPIES THE DEFAULT SWITCH VALUE TABLE INTO THE TABLE OF
;CURRENTLY USED SWITCH VALUES AND RESETS SOME ASSOCIATED FLAG WORDS.

$REVER:	NOISE	(TO DEFAULT SWITCH VALUES) ;SOME NOISE
	CALL	CONFRM		;WAIT FOR CONFIRMATION
	MOVE	AC1,[XWD SWDEF,SWUSE] ;FORM A BLT POINTER
	BLT	AC1,SWUSE+SWLEN-1 ;COPY SWDEF INTO SWUSE
	SETZM	EORFLG		;CLEAR THESE FLAGS
	SETZM	TABFLG
	SETZM	FFFLG
	SETZM	LINFLG
	RET			;RETURN TO CALLER
	SUBTTL	DISPLAY Command

$DISPL:	NOISE	(DEFAULT SWITCH VALUES)
	CALL	CONFRM
	CALL	VALUES		;DISPLAY THE DEFAULTS
	RET			;THEN GET ANOTHER COMMAND

;VALUES will print the default values of the switches

VALUES:	TMSG	<Current switch settings:
>
	HRROI	AC1,[ASCIZ/BLANKS/]
	CALL	PRT1ST
	MOVE	AC1,BLANKS
	HLRO	AC1,YNTAB+1(AC1)
	ADDI	AC1,1
	CALL	PRTLST
	HRROI	AC1,[ASCIZ/BLKSIZE/]
	CALL	PRT1ST
	MOVE	AC2,BLKSZ
	CALL	PRTNUM
	CALL	PRTEOL
	HRROI	AC1,[ASCIZ/BLOCK-PREFIX-LENGTH/]
	CALL	PRT1ST
	MOVE	AC2,BLKPFX
	CALL	PRTNUM
	CALL	PRTEOL
	HRROI	AC1,[ASCIZ/CASE/]
	CALL	PRT1ST
	MOVE	AC1,CASE
	HLRO	AC1,CASTAB+2(AC1)
	ADDI	AC1,1
	CALL	PRTLST
	HRROI	AC1,[ASCIZ/COUNT= ALL/]
	CALL	PRTLST
	HRROI	AC1,[ASCIZ/CTRL-L/]
	CALL	PRT1ST
	MOVE	AC1,FF
	HLRO	AC1,YNTAB+1(AC1)
	ADDI	AC1,1
	CALL	PRTLST
	HRROI	AC1,[ASCIZ/DATA-TYPE/]
	CALL	PRT1ST
	MOVE	AC1,DATA
	HLRO	AC1,DATAB+1(AC1)
	ADDI	AC1,1
	CALL	PRTLST
	HRROI	AC1,[ASCIZ/DENSITY/]
	CALL	PRT1ST
	MOVN	AC1,DEN
	HLRO	AC1,DENTAB+5(AC1)
	ADDI	AC1,1
	CALL	PRTLST
	HRROI	AC1,[ASCIZ/EOR/]
	CALL	PRT1ST
	MOVE	AC1,EOR
	HLRO	AC1,EORTAB+1(AC1)
	ADDI	AC1,1
	SKIPN	EORFLG
	HRROI	AC1,[ASCIZ/LRECL(read) or CRLF(write)/]
	CALL	PRTLST
	HRROI	AC1,[ASCIZ/LABEL/]
	CALL	PRT1ST
	MOVE	AC1,LABEL
	HLRO	AC1,LBLTAB+2(AC1)
	ADDI	AC1,1
	SKIPN	LBLFLG
	HRROI	AC1,[ASCIZ/???/]
	CALL	PRTLST
	HRROI	AC1,[ASCIZ/LEADING-TAPE-MARK/]
	CALL	PRT1ST
	MOVE	AC1,LTM
	HLRO	AC1,YNTAB+1(AC1)
	ADDI	AC1,1
	CALL	PRTLST
	HRROI	AC1,[ASCIZ/LINE-NUMS/]
	CALL	PRT1ST
	MOVE	AC1,LINOS
	HLRO	AC1,YNTAB+1(AC1)
	ADDI	AC1,1
	SKIPN	LINFLG
	HRROI	AC1,[ASCIZ/NO(read) or YES(write)/]
	CALL	PRTLST
	HRROI	AC1,[ASCIZ/LRECL/]
	CALL	PRT1ST
	MOVE	AC2,LRECL
	CALL	PRTNUM
	CALL	PRTEOL
	HRROI	AC1,[ASCIZ/NULLS/]
	CALL	PRT1ST
	MOVE	AC1,NULL
	HLRO	AC1,YNTAB+1(AC1)
	ADDI	AC1,1
	CALL	PRTLST
	HRROI	AC1,[ASCIZ/PARITY/]
	CALL	PRT1ST
	MOVN	AC1,PARITY
	HLRO	AC1,PARTAB+2(AC1)
	ADDI	AC1,1
	CALL	PRTLST
	HRROI	AC1,[ASCIZ/RECFM/]
	CALL	PRT1ST
	MOVE	AC1,RECFM
	HRRO	AC1,FMTRFM(AC1)
	CALL	PRTLST
	HRROI	AC1,[ASCIZ/SKIP= NONE/]
	CALL	PRTLST
	HRROI	AC1,[ASCIZ/TAB/]
	CALL	PRT1ST
	MOVE	AC1,TAB
	HLRO	AC1,YNTAB+1(AC1)
	ADDI	AC1,1
	SKIPN	TABFLG
	HRROI	AC1,[ASCIZ/NO(read) or YES(write)/]
	CALL	PRTLST
	CALL	PRTEOL
	RET
FMTRFM:	[ASCIZ/D/]		;TABLE TO CONVERT RECFM TO STRING
	[ASCIZ/F/]
	[ASCIZ/U/]
	[ASCIZ/V/]
	[ASCIZ/DB/]
	[ASCIZ/FB/]
	0			;no UB
	[ASCIZ/VB/]
	[ASCIZ/DA/]
	[ASCIZ/FA/]
	[ASCIZ/UA/]
	[ASCIZ/VA/]
	[ASCIZ/DBA/]
	[ASCIZ/FBA/]
	0			;no UBA
	[ASCIZ/VBA/]
PRTLST:	PSOUT
PRTEOL:	HRROI	AC1,[ASCIZ/
/]
	PSOUT
	RET
PRT1ST:	PSOUT
	HRROI	AC1,[ASCIZ/= /]
	PSOUT
	RET
	SUBTTL	QUIT Command

$QUIT:	NOISE	(AND)
	MOVEI	AC2,[FLDDB. .CMKEY,,QUITAB,,<UNLOAD>]
	CALL	DOCMND
	HRRE	AC4,(AC2)	;GET OPTION
	CALL	CONFRM
	SKIPN	TAPDES		;TAPE DRIVE NOT ASSIGNED?
	 JRST	$QUIT1		;YES....
	CAIGE	AC4,0		;OPTION= NOCHANGE?
	JRST	$QMSG		;YES
$QOPN:	MOVE	AC1,TJFN
	MOVE	AC2,[17B9+OF%RD]
	OPENF			;OPEN TO REWIND/UNLOAD
	 ERJMP	$QUIT0		;PROBABLY NOT ONLINE
	MOVEI	AC2,.MORUL	;UNLOAD IS DEFAULT
	CAIG	AC4,0
	MOVEI	AC2,.MOREW	;REWIND SPECIFIED
	MTOPR
	 ERCAL	ERROR
	MOVEI	AC1,1		;RESET TAPE FILE #
	MOVEM	AC1,TFN
	SETZM	LBLFLG		;RESET LABEL FLAG
$QMSG:	CAILE	AC4,0
	JRST	$QUIT1		;RELEASE AFTER UNLOAD
	CALL	PCRIF
	TMSG	<%You still have the tape drive assigned!>
	MOVE	AC1,TJFN	;CLOSE TAPE JFN
	CLOSF
	 ERCAL	ERROR
	SETZM	TJFN
$QUIT0:	HALTF
	RET

$QUIT1:	HRROI	AC1,-1		;CLOSE ALL FILES
	CLOSF
	 JFCL
	SETZM	TJFN		;RESET TAPE JFN
	MOVE	AC1,TAPDES
	RELD			;RELEASE THE TAPE DRIVE
	 JFCL
	SETZM	TAPDES
	HALTF
	JRST	TAPEIO
	SUBTTL	Switch Value Parsing

;	FOR READ AND WRITE COMMANDS
;	PARSE A SWITCH NAME, THEN DISPATCH TO THE APPROPRIATE VALUE
;	+1 ERROR
;	+2 GOOD PARSE

$OPTS:	MOVEI	AC2,[FLDDB. .CMSWI,,OPTTAB,,,<[
		     FLDDB. .CMCFM]>]
	CALL	DOCMND
	LDB	AC3,[POINT 9,(AC3),8]
$OPTS1:	CAIN	AC3,.CMCFM
	 JRST	$OPTS2		;<CR>->EXECUTE COMMAND
	HRRZ	AC2,(AC2)
	CALL	(AC2)		;PARSE REST OF OPTION
	 JFCL			;ERROR (NEVER USED)
	JRST	$OPTS

;AFTER CONFIRMATION WE COPY THE SWSET VALUES INTO SWUSE

DEFINE	YY ' (FOO,BAR) <
	MOVE	AC1,.'FOO	;;GET NEW SWITCH VALUE
	CAMN	AC1,[-1]	;;WAS ONE SET?
	JRST	.+3		;;NO, SKIP OUT OF THIS MACRO
	MOVEM	AC1,FOO		;;YES, SET NEW VALUE
	IFIDN <BAR> <> <JFCL>	;;IF NO FLAG, USE A NO-OP
	IFDIF <BAR> <> <SETOM BAR> ;;ELSE SET THE FLAG
>

;NOTE WELL: THE FOLLOWING IS NOT A TABLE!

$OPTS2:	YY (DEN)
	YY (BLKSZ)
	YY (LRECL)
	YY (RECFM)
	YY (PARITY)
	YY (DATA)
	YY (CASE)
	YY (BLANKS)
	YY (COUNT)
	YY (SKIP)
	YY (EOR,EORFLG)
	YY (TAB,TABFLG)
	YY (NULL)
	YY (FF,FFFLG)
	YY (LINOS,LINFLG)
	YY (LTM)
	YY (BLKPFX,BDWFLG)
	YY (LABEL)
	RETSKP
;	VALUE PARSING ROUTINES.  ALL RETURN +1 ON ERROR, +2 NORMALLY

$BLKSZ:	TROE	FLAGS,%BLKSZ	;BLKSIZE OPTION
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMNUM,CM%SDH,^D10,<block size of tape>,<8000>]
	CALL	DOCMND
	CAIL	AC2,MINBLK	;CHECK
	CAILE	AC2,MAXBLK
	 WARN	<BLKSIZE out of range 18-30720>
	MOVEM	AC2,.BLKSZ	;SET BLKSIZE
	RETSKP

$DEN:	TROE	FLAGS,%DEN	;DENSITY OPTION
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMKEY,,DENTAB,,<1600>]
	CALL	DOCMND
	HRRE	AC2,(AC2)
	MOVEM	AC2,.DEN
	RETSKP

$LRECL:	TROE	FLAGS,%LRECL	;LRECL OPTION
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMNUM,CM%SDH,^D10,<logical record length of tape>,<80>]
	CALL	DOCMND
	CAIL	AC2,MINREC
	CAILE	AC2,MAXREC
	 WARN	<LRECL not in range 18-30720>
	MOVEM	AC2,.LRECL
	RETSKP

$RECFM:	TROE	FLAGS,%RECFM	;RECFM OPTION
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMKEY,,RCFMTB,,<FB>]
	CALL	DOCMND
	HRRE	AC2,(AC2)
	MOVEM	AC2,.RECFM
	ANDI	AC2,$B-1	;CLEAR BLOCKED AND CC ATTRIBUTES
	CAIE	AC2,$D		;D AND V IMPLY CHARACTER SET CONSTRAINTS
	 CAIN	AC2,$V
	  JRST [TROE	FLAGS,%DATA
		 WARN	<Duplicate option specified>
		LSH	AC2,-1
		MOVEM	AC2,.DATA ;DATA TYPE IMPLIED BY RECFM=D,V
		JRST	.+1 ]
	RETSKP

$PARTY:	TROE	FLAGS,%PARTY	;PARITY OPTION
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMKEY,,PARTAB,,<ODD>]
	CALL	DOCMND
	HRRE	AC2,(AC2)
	MOVEM	AC2,.PARITY
	RETSKP
$DATA:	TROE	FLAGS,%DATA	;DATA OPTION
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMKEY,,DATAB,,<ASCII>]
	CALL	DOCMND
	HRRE	AC2,(AC2)
	MOVEM	AC2,.DATA
	RETSKP

$CASE:	TROE	FLAGS,%CASE	;CASE OPTION
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMKEY,,CASTAB,,<NOCHANGE>]
	CALL	DOCMND
	HRRE	AC2,(AC2)
	MOVEM	AC2,.CASE
	RETSKP

$BLNKS:	TLOE	FLAGS,%BLNKS
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMKEY,,YNTAB,,<YES>] ;PARSE YES OR NO
	CALL	DOCMND
	HRRE	AC2,(AC2)
	MOVEM	AC2,.BLANKS
	RETSKP

$COUNT:	TROE	FLAGS,%COUNT
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMKEY,,CNTAB,,<ALL>,<[
		     FLDDB. .CMNUM,CM%SDH,^D10,<number of records to write>]>]
	CALL	DOCMND
	LDB	AC3,[POINT 9,(AC3),8] ;GET TYPE OF FIELD PARSED
	CAIN	AC3,.CMKEY	;KEYWORD?
	MOVE	AC2,[377777,,777777] ;ALL SPECIFIED
	JUMPLE	AC2,[WARN <COUNT must be positive>] ;ERROR IF <= 0
	MOVEM	AC2,.COUNT
	RETSKP 

$SKIP:	TROE	FLAGS,%SKIP
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMKEY,,SKPTAB,,<NONE>,<[
		     FLDDB. .CMNUM,CM%SDH,^D10,<# records to ignore>,<none>]>]
	CALL	DOCMND
	JUMPL	AC2,[WARN <SKIP value must be zero or greater>]
	LDB	AC3,[POINT 9,(AC3),8] ;GET TYPE OF FIELD WE PARSED
	CAIN	AC3,.CMKEY
	HRRE	AC2,(AC2)	;NONE SPECIFIED
	MOVEM	AC2,.SKIP
	RETSKP
$EOR:	TROE	FLAGS,%EOR
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMKEY,,EORTAB,,<LRECL-CHARACTERS>]
	TLNN	FLAGS,%READ
	MOVEI	AC2,[FLDDB. .CMKEY,,EORTAB,,<CRLF>]
	CALL	DOCMND
	HRRE	AC2,(AC2)
	MOVEM	AC2,.EOR
	RETSKP

$TAB:	TLOE	FLAGS,%TAB
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMKEY,,YNTAB,,<YES>]
	CALL	DOCMND
	HRRE	AC2,(AC2)
	MOVEM	AC2,.TAB
	RETSKP

$NULL:	TLOE	FLAGS,%NULL
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMKEY,,YNTAB,,<YES>]
	CALL	DOCMND
	HRRE	AC2,(AC2)
	MOVEM	AC2,.NULL
	RETSKP

$FF:	TLOE	FLAGS,%FF
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMKEY,,YNTAB,,<YES>]
	CALL	DOCMND
	HRRE	AC2,(AC2)
	MOVEM	AC2,.FF
	RETSKP

$LINOS:	TLOE	FLAGS,%LINOS
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMKEY,,YNTAB,,<YES>]
	CALL	DOCMND
	HRRE	AC2,(AC2)
	MOVEM	AC2,.LINOS
	RETSKP

$LTM:	TLOE	FLAGS,%LTM	;LEADING TAPE MARK
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMKEY,,YNTAB,,<NO>]
	CALL	DOCMND
	HRRE	AC2,(AC2)
	MOVEM	AC2,.LTM
	RETSKP
$BKPFX:	TLOE	FLAGS,%BPFX
	 WARN	<Duplicate option specified>
	TLNE	FLAGS,%WRITE
	 WARN	<Invalid when writing>
	MOVEI	AC2,[FLDDB. .CMNUM,CM%SDH,^D10,<the block prefix length in bytes [0-99]>,<0>]
	CALL	DOCMND
	CAIL	AC2,0
	CAILE	AC2,^D99
	 WARN	<Block prefix length must be 0-99>
	MOVEM	AC2,.BLKPFX
	RETSKP


$LABEL:	TLOE	FLAGS,%LABEL
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMKEY,,LBLTAB,,<NL>]
	CALL	DOCMND
	HRRE	AC2,(AC2)
	MOVEM	AC2,.LABEL
	RETSKP
$FMT:	TROE	FLAGS,%FMT
	 WARN	<Duplicate option specified>
	MOVEI	AC2,[FLDDB. .CMKEY,,FMTAB,,<VCARD>]
	CALL	DOCMND
	HRRE	AC2,(AC2)
	JRST	@[$FMT0
		$FMT1
		$FMT2
		$FMT3
		$FMT4
		$FMT5
		$FMT6
		$FMT7](AC2)
$FMT0:				;ILLEGAL
$FMT1:	MOVEI	AC1,^D80	;FCARD
	MOVEI	AC2,MAXBLK
	MOVEI	AC3,$FB
	JRST	$FMTRT

$FMT2:	MOVEI	AC1,^D80	;FPRINT
	MOVEI	AC2,MAXBLK
	MOVEI	AC3,$FBA
	JRST	$FMTRT

$FMT3:	SKIPA	AC3,[$VB]	;VCARD
$FMT4:	MOVEI	AC3,$VBA	;VPRINT
	MOVEI	AC1,^D235	;lrecl for Wylbur
	MOVEI	AC2,MAXBLK	;maximum block size
	TROE	FLAGS,%DATA
	 WARN	<Duplicate option specified>
	MOVEI	AC4,1
	MOVEM	AC4,.DATA	;RECFM=V IMPLIES DATA EBCDIC
	JRST	$FMTRT

$FMT5:	MOVEI	AC1,^D80	;TCARD
	MOVEI	AC2,^D8000
	MOVEI	AC3,$FB
	JRST	$FMTRT

$FMT6:	MOVEI	AC1,^D133	;TPRINT
	MOVEI	AC2,^D7980
	MOVEI	AC3,$FB
	JRST	$FMTRT

$FMT7:	TROE	FLAGS,%DATA	;ANSI
	SETZM	.DATA		;RECFM=DB IMPLIES DATA ASCII
	SETZM	.FF		;DON'T STRIP FF
	MOVEI	AC3,$DB
	MOVEI	AC1,^D2048-4	;SMALL BLOCKSIZE
	MOVEI	AC2,^D2048
$FMTRT:	MOVEM	AC1,.LRECL
	MOVEM	AC2,.BLKSZ
	MOVEM	AC3,.RECFM
	RETSKP	
	SUBTTL	FORMAT VERIFICATION

$FCHK:	MOVE	AC1,BLKSZ	;RECFM=F: LRECL=BLKSIZE?
	CAMN	AC1,LRECL
	RETSKP			;YES

$FBCHK:	MOVE	AC1,BLKSZ	;RECFM=FB: BLKSIZE MOD LRECL=0
	IDIV	AC1,LRECL
	JUMPN   AC2,[FMTERR<For RECFM=FB, BLKSIZE must be a multiple of LRECL>]
	TLNE	FLAGS,%READ	;WRITE?
	 RETSKP			;NO.  READ.
	MOVE	AC1,LRECL
	TRNE	AC1,3		;IS LRECL A MULTIPLE OF 4?
	 FMTERR<For RECFM=FB, LRECL must be a multiple of 4>
	RETSKP

$VCHK:	SKIPN	DATA		;RECFM=V,VB: EBCDIC & BLKSIZE>=LRECL+4
	 FMTERR	<For RECFM=V,VB data-type must be EBCDIC>
	SKIPE	BLKPFX
	 FMTERR	<For RECFM=V,BB BLOCK-PREFIX-LENGTH not allowed>
	MOVE	AC1,BLKSZ
	SUBI	AC1,4
	CAMGE	AC1,LRECL
	 FMTERR (For RECFM=V,VB: DATA-TYPE must be EBCDIC and BLKSIZE>=LRECL+4)
	TLO	FLAGS,%VLR	;SET VARIABLE LENGTH RECORDS FLAG
	RETSKP

$DCHK:	SKIPE	DATA		;RECFM=D,DB: ASCII & BLKSIZE >= LRECL+PREFIX
	 FMTERR	<For RECFM=D,DB data-type must be ASCII>
	MOVEI	AC1,4		;PREFIX MUST BE = 4 ON WRITING
	SKIPE	BDWFLG		;BLOCK DESCRIPTOR NEVER SPECIFIED?
	TLNE	FLAGS,%WRITE	;OR WRITING?
	 MOVEM	AC1,BLKPFX	;USE 4
	SKIPLE	AC1,LRECL
	CAILE	AC1,^D9999
	 WARN	<LRECL out of range 18-9999>
	SKIPLE	AC1,BLKSZ
	CAILE	AC1,^D9999
	 WARN	<BLKSIZE out of range 18-9999>
	TLO	FLAGS,%VLR
	TLNN	FLAGS,%READ	;IGNORE LENGTH CHECKS ON READ
	 CAML	AC1,LRECL
	  RETSKP
	FMTERR (For RECFM=D: BLKSIZE >= LRECL+4)

$RFMU:	TLNE	FLAGS,%WRITE
	 WARN	<RECFM=U illegal when writing>
	RETSKP

;	DISPATCH TABLE FOR BLKSIZE/LRECL CHECK
$BLRCK:	$DCHK			;D
	$FCHK			;F
	$RFMU			;U
	$VCHK			;V
	$DCHK			;DB
	$FBCHK			;FB
	$RFMU			;UB
	$VCHK			;VB
$GO:	MOVE	AC1,RECFM	;CHECK BLKSIZE/LRECL/DATA-TYPE
	TRNE	AC1,$A
	TLO	FLAGS,%CC	;SET CARRIAGE CONTROL FLAG
	ANDI	AC1,$A-1
	CALL	@$BLRCK(AC1)
	RET			;BLKSIZE/LRECL CONFLICT
	TLNE	FLAGS,%READ
	 JRST	$GO1
	MOVE	AC1,BLKSZ	;CHECK BLKSIZE FOR MULT OF 4
	TRNE	AC1,3
	 FMTERR <BLKSIZE must be multiple of 4>

$GO1:
$GO2:	CALL	TAPJFN		;GET A JFN ON THE TAPE DRIVE
	CALL	TLTM		;SKIP LEADING TAPE MARK
	CALL	TLBLCK		;VERIFY LABEL
	 FMTERR <Tape not labelled as specified>
	SETZM	@IJFNP		;MARK END OF INPUT FILE(S)
	SETZM	@OJFNP		;MARK END OF OUTPUT FILE(S)
	MOVEI	AC1,IJFNL	;RESET INPUT LIST POINTER
	MOVEM	AC1,IJFNP
	MOVEI	AC1,OJFNL	;RESET OUTPUT LIST POINTER
	MOVEM	AC1,OJFNP
	MOVEI	AC1,1
	TLNN	FLAGS,%READ
	MOVEI	AC1,0
	SKIPN	EORFLG
	MOVEM	AC1,EOR		;EOR NEVER SPECIFIED, SET TO DEFAULT
	TRC	AC1,1
	SKIPN	TABFLG
	 MOVEM	AC1,TAB		;TAB NEVER SPECIFIED, SET TO DEFAULT
	SKIPN	FFFLG
	 MOVEM	AC1,FF		;FF NEVER SPECIFIED.  SET TO DEFAULT
	SKIPN	LINFLG
	 MOVEM	AC1,LINOS	;LINOS NEVER SET, SET TO DEFAULT
	TLNN	FLAGS,%READ
	JRST	$GOEX
	SETZM	RTEEOR		;IF READ, SET EFFECTIVE EOR TO 8
	MOVE	AC1,LRECL	;IF LRECL=80, RECFM=FB, LINE #S=Y
	CAIE	AC1,^D80	;& EOR=LRECL; OTHERWISE TO 0
	JRST	$GOEX
	MOVE	AC1,RECFM
	ANDI	AC1,$A-1
	CAIE	AC1,$FB
	JRST	$GOEX
	SKIPN	EOR
	JRST	$GOEX
	MOVEI	AC1,^D8
	SKIPE	LINOS
	MOVEM	AC1,RTEEOR
$GOEX:	CALL	EXEC		;EXECUTE COMMAND
	RET
	SUBTTL	HELP Command

; #########################################################
; ###  Warning:  Do not include unmatched "<" or ">" in	###
; ###	    any help msgs on this page!			###
; #########################################################

;The HELP text is a giant macro so we can turn off code listing.

DEFINE %HELP% ' (LABEL,TEXT) <
H.'LABEL:
	XLIST
	ASCIZ\TEXT\
	LIST
>;%HELP%

;
; HELP on general-informational topics
;

%HELP% (INTRO,<
  This program may be used to read tape(s) written in IBM format (i.e.
written at CIT or on the HP) or write tape(s) in this format (i.e for use
at CIT or on the HP-3000). The tape must be nine-track and contain only
character data; this means that some of the things you CANNOT read or
write are: SPSS save files, files written with FORTRAN unformatted i/o,
compiled (.REL files) or executable (.EXE files) programs.

  The following commands are recognized: READ, WRITE, QUIT, HELP, and
DEFAULT.  The READ command reads tape file(s) to disk, the WRITE command
writes disk file(s) to tape, the QUIT command stops the program & returns
you to TOPS-20, the HELP command prints this and other information about the
program, and the DEFAULT command sets default switch values for later READ
and WRITE commands.

  The HELP command may be followed by an optional argument (a topic).  For
instance, HELP READ gives information relevant to the READ command, while 
HELP LRECL gives information pertaining to the use of the LRECL switch.

  The WRITE command must be followed by the list of disk files to be copied
to tape, and the location on the tape where the files should be written,
followed by the optional switches.  The allowable tape positions for
writing are: END (writes a file to the end of the tape), LAST (writes a file
over the last file on the tape), NEXT (writes a file into the next position
on the tape), or 'n' (where 'n' is the number of the tape file to write).

  The READ command must be followed by the positions of the files to be read
from tape, and the disk files they are to be written into, followed by any
switches.  The allowable tape positions for reading are: LAST (read the
last file on the tape), NEXT (read the next file on the tape), 'n' (where n is
the number of the tape file to read).

  The switches which may be specified in DEFAULT, READ, and WRITE and as
topics in the HELP command are:
/BLANKS (specifies the treatment of blanks and nulls),
/BLKSIZE (size of physical records on the tape)
/BLOCK-PREFIX-LENGTH (length of an optional block prefix for ascii tapes)
/CASE (specifies sensitivity to case)
/COUNT (number of logical records to be processed)
/CTRL-L (specifies that form-feeds are to be flushed)
/DATA-TYPE (specifies whether the tape is ASCII or EBCDIC)
/DENSITY (either 1600 or 800 bpi)
/EOR (specifies the method of determining the end of the record)
/FORMAT (specifies LRECL, BLKSIZE and RECFM in a single switch)
/LABEL (gives the label characteristics of the tape)
/LEADING-TAPE-MARK (specifies the presence of a leading tape mark)
/LINE-NUMS (specifies the handling of line numbers)
/LRECL (size of logical records on the tape)
/NULLS (specifies that nulls are to be flushed)
/PARITY (the parity of the tape)
/RECFM (the record format of the tape)
/SKIP (the number of logical records to skip over)
/TAB (specifies the handling of tabs)

Almost all of these swtiches require an argument.  For instance, "/skip:5"
means that five records should be skiped and "/nulls:no" means that nulls
are not to be flushed.  The defaults for each of these arguments can be
obtained by "HELP VALUES".

  To read the first file on a tape written with default parameters:
	read 1 myfile.typ

  To write a file on to the end of a tape with the default parameters:
	write myfile.typ end

  To write a file on to the end of the tape, including carriage control,
  in a format suitable to be taken to CIT for printing on their printer:
    [Make sure your tape is IBM labelled.  Use TAPELABEL if necessary.]
	write mythesis.mem/format:vprint

  To write a file on to the end of a tape with a density of 800bpi and
  without flushing nulls:
	write myfile.typ end /density:800 /nulls:no
>);END OF HELP MACRO
%HELP% (CIT,<
  The following is general information on transfering files to and from
the Stanford Center for Information Technology (CIT).
  The CIT Execfiles TOLOTS and FROMLOTS expect labelled tapes, so if you are
moving a file to CIT, and your tape is currently unlabelled, please run the
TAPELABEL program before using TAPEIO.  Then use /FORMAT:VCARD or
/FORMAT:VPRINT when writing the tape.
   If you are reading a labelled tape from CIT then you don't need to know
anything about the format of the tape, since TAPEIO will figure it out for you.
However, the tape must be 9-track, 800 or 1600 bpi density.
    Give the exec command HELP TAPEIO for more details.
>);END OF HELP MACRO
%HELP% (SWITC,<
  The syntax of the DEFAULT, READ, and WRITE commands includes optional
switches which describe the format of the tape & any transformations to
be done to the data. The following are the recognized switches:

	BLANKS   BLKSIZE   BLOCK-PREFIX-LENGTH   CASE  COUNT  CTRL-L
	DATA-TYPE  DENSITY   EOR   FORMAT  LINE-NUMS  LABEL  LEADING-TAPE-MARK
	LRECL   NULLS   PARITY   RECFM   SKIP   TAB.

BLKSIZE, BLOCK-PREFIX-LENGTH, DENSITY, LABEL, LEADING-TAPE-MARK, LRECL,
PARITY & RECFM describe, respectively, the block size, length of the
optional block prefix, density, whether the tape is labelled, whether it
has an initial null file, the logical record length, parity & record
format of the tape. FORMAT specifies useful mixes of LRECL, BLKSIZE and
RECFM in one switch.  BLANKS, CASE, CTRL-L, DATA-TYPE, EOR, LINE-NUMS,
NULLS & TAB specify data transformations.  SKIP and COUNT give,
respectively, the number of logical records to be ignored and processed.
  Once assigned a value, all switches, except COUNT & SKIP, retain this
value until explicitly changed (this means that you only have to specify
the block size or density or etc. of a tape on the DEFAULT command
before any READ or WRITE commands); COUNT & SKIP, on the other hand, are
re-initialized to their default values ("ALL" & "NONE" respectively)
before each command (Note: this means that using SKIP and/or COUNT when
reading or writing multiple files probably doesn't make sense).
  Try HELP on these for more details.
>);END OF HELP MACRO

;
; HELP on commands:
;

%HELP% (HELP,<
  Help is available on the following topics:

- an INTRODUCTION to this program; 
- the commands READ, WRITE, DEFAULT, DISPLAY, UNLOAD, REWIND, REVERT,	
 	       TAPE-DRIVE, and QUIT;
- VALUES which displays the current values of all switches;
- SWITCHES which explains switches for READ and WRITE; and
- the switches BLANKS, BLKSIZE,BLOCK-PREFIX-LENGTH, CASE, COUNT, CTRL-L,
		DATA-TYPE, DENSITY, EOR, FORMAT,LABEL, LEADING-TAPE-MARK,
		LINE-NUMS, LRECL, NULLS, PARITY, SKIP, and TAB.

To obtain help on a particular topic, type "HELP", a space and then the
topic (abbreviations and recognition can be used).
>);END OF HELP MACRO
%HELP% (DEFA,<
  The DEFAULT command allows you to specify the values for switches before
giving your first READ or WRITE command.  It accepts as arguments any
switches (see HELP SWITCHES for details).  All switches (except COUNT and
SKIP) are sticky -- their values are remembered and used on succeeding READ
or WRITE commands.
  For example, to read two files from an unlabelled 800 bpi tape
with LRECL=133, BLKSIZE=1330, and carriage control characters:
	default /density:800
	default /lrecl:133/blksize:1330/recfm:fba
	read 1 foo.txt
	read 5 bar.txt
  Note that, had you preferred, you could have combined the above commands
into 3, 2, or even 1 lines:
	read 1,5 foo.txt,bar.txt/den:800/lr:133/blk:1330/recfm:fba
>);END OF HELP MACRO
%HELP% (UNLOAD,<
  The UNLOAD command causes the tape to rewind and unload itself.  This is
the same action that is taken by the QUIT command without any arguments.
>);END OF HELP MACRO
%HELP% (REWIND,<
  The REWIND command causes the tape to be positioned at the beginning of the
of the reel.
>);END OF HELP MACRO
%HELP% (TAPE,<
  The TAPE-DRIVE command is used to specify which tape drive you want to use.
This command is useful only if the facility has more than one tape drive.
>);END OF HELP MACRO
%HELP% (DISPLAY,<
  The DISPLAY command shows the current switch settings.
>);END OF HELP MACRO
%HELP% (REVERT,<
  The REVERT command resets all switch settings to their default values.
>);END OF HELP MACRO
%HELP% (QUIT,<
  The QUIT command stops the program and returns you to TOPS-20 command
level.  This command has 3 options ("NOCHANGE", "REWIND" & "UNLOAD") which
describe where to position the tape before returning to TOPS-20.  These
are specified immediately after the command. "NOCHANGE" and "REWIND" leave
the tape drive assigned; "UNLOAD" deassigns it.
 The default is UNLOAD.
>);END OF HELP MACRO
%HELP% (READ,<
  The READ command reads file(s) from tape to disk.  The syntax is:

	READ  input file(s)  output file(s) /switch(es)

where "input file(s)" is a list (separated by commas) of tape file #(s),
"output file(s)" is a list of disk file name(s), and "switch(es)" is any
of the optional tape and data switches (try HELP SWITCHES for details).
  After each file is copied to tape, a "confirmation" message is printed;
the messages are one of "OK", "BLOCK(S) GT BLKSIZE" or "RECORD(S) GT LRECL"
plus the number of records and blocks that were read from the tape.  The
1st indicates the obvious; the 2nd, that physical block(s) on the tape
were greater than the specified BLKSIZE; and the 3rd, that record(s)
(for RECFMs V, VB, D or DB) were greater than the specified LRECL.  These
last two messages indicate that the format of the tape was not specified
correctly and that data may have been lost.
  This command terminates when the OUTPUT list is exhausted.  If there
are more output files than input, succeeding file(s) are read from tape
until the output list is exhausted; if there are more input files than
output, the extra input file(s) are ignored.  When reading more than one
file with a single READ command, note that they all must have the same
LRECL, BLKSIZE, etc.
  A single "output file" may be either a disk file name or "*".  If "*"
is specified, then the file name found on the corresponding tape file label is 
used, or "TAPEIO-FILE-n" if the tape is unlabelled.

  Examples:
	READ 1 T.TXT		(tape file 1 to t.txt)
	READ 1 T1.TXT,T2.TXT	(tape file 1 to t1.txt, tape file 2 to t2.txt)
	READ 1,3 T1.TXT,T3.TXT	(tape file 1 to t1.txt, tape file 3 to t3.txt)
	READ 1,3 T1.TXT		(tape file 1 to t1.txt)
	READ NEXT T.TXT		(next tape file to t.txt)
	READ LAST T.TXT		(last tape file to t.txt)
	READ 1 T.TXT /BLK 6400	(tape file 1 to t.txt, block size= 6400)
	READ 1 T.TXT /REC DB	(tape file 1 to t.txt, record format= db)
	READ 4 * /LABEL NL	(tape file 4 to tapeio-file-4..1)
>);END OF HELP MACRO
%HELP% (WRIT,<
  The WRITE command writes disk file(s) to tape.  The syntax is:

	WRITE  input file(s)
or
	WRITE  input file(s)  output file /switch(es)

where "input file(s)" is a list (separated by commas) of disk file name(s)
that may include wildcard characters, "output file" is a tape file # and
"switch(es)" are any of the optional tape & data switches (try HELP
SWITCHES for more details).
  After each file is copied to disk, a "confirmation" message is printed;
the possible messages are either "OK" or "RECORD(S) TRUNCATED" plus the
number of records and blocks that were written to tape.  The 1st indicates
the obvious and the 2nd, that record(s) in the input file were greater than
the specified LRECL and were truncated to fit (data was lost).
  This command terminates when the INPUT list is exhausted.  When writing
more than one file with a single WRITE command, each file will have the same
LRECL, BLKSIZE, etc.
  Notes: when writing variable length records, RECFM=Dx or Vx, EACH record is
padded on the right with an appropriate number of either blank(s) or null(s)
[depending on the setting of the BLANKS switch], if necessary, to force
the length to the next multiple of 4 (note that this means that the smallest
block written is 24 bytes long).  Also, with variable length ASCII records,
RECFM=Dx, a 4 byte block prefix containing the length of the block is written
(corresponding to the IBM DCB parameter BUFOFF=L).

  Examples:
	WRITE T.TXT		(t.txt to end of tape)
	WRITE T1.TXT,T2.TXT 1	(t1.txt to tape file 1, t2.txt to tape file 2)
	WRITE T.*.*  END	(t.*.* to end of tape)
	WRITE T.TXT NEXT	(t.txt to next tape file)
	WRITE T.TXT LAST	(t.txt to last tape file)
	WRITE T.TXT 1 /LR 100	(t.txt to tape file 1, lrecl=100)
	WRITE T.TXT 1 /DE 800	(t.txt to tape file 1, density=800)
>);END OF HELP MACRO

;
; HELP on individual switches
;

%HELP% (BLAN,<
  The BLANKS switch specifies the following data transformation:
when reading, remove trailing blanks; when writing, use blank(s), if
necessary, to pad each line to LRECL characters (otherwise use NULLS).
  The default is YES.
>);END OF HELP MACRO
%HELP% (BLKS,<
  The BLKSIZE switch specifies the maximum size of the physical
records on the tape.  It must be a decimal # between 18 & 30720 which,
if the RECFM is F, equal to LRECL; FB, exactly divisible by LRECL; D or DB,
greater than or equal to LRECL + the block prefix (if any); V or VB, greater
than or equal to LRECL+4 (i.e. it includes the 4 byte block switch word).
Also, when writing, the BLKSIZE (and LRECL for FB) must be a multiple of four.
  The default is 8000.
  Notes: when writing variable length ASCII tapes (RECFM=Dx), remember
that the ANSI standard is a maximum BLKSIZE and LRECL of 2048; you can
write up to 9999, but the tape may not be readable elsewhere (it can,
however, be read at CIT).
>);END OF HELP MACRO
%HELP% (BPL,<
  The BLOCK-PREFIX-LENGTH switch specifies the length (in bytes) of the
optional block prefix for all ASCII format tapes.  It must be in the range
0-99 and can only be specified when reading (when writing variable length
ASCII records, RECFM=Dx, a 4 byte block prefix containing the length of the
block is written.  To read an unlabelled D-format tape at CIT, specify the
DCB parameter BUFOFF=L in your JCL to inform the system of this fact).
  The default is 0 (no block prefix) on reading, and 4 (BUFOFF=L) on writing.
>);END OF HELP MACRO
%HELP% (CASE,<
  The CASE switch specifies whether the case of the output is to
be changed: "UPPER" capitalizes lower case characters, "LOWER" makes
capitals lower case & "NOCHANGE" leaves the output "as is".
  The default is NOCHANGE.
>);END OF HELP MACRO
%HELP% (COUN,<
  The COUNT switch specifies the # of logical records to be processed.
It must be a positive integer or the keyword "ALL".
  The default is ALL.
>);END OF HELP MACRO
%HELP% (CTRL,<
  The CTRL-L switch specifies that CTRL-L's (form feeds) are to be
flushed (removed) when reading & writing.
  The default is YES on writing and NO on reading.

  Note: the translation specified by RECFM= xA of form feeds 
to ANSI carriage control takes precedence over CTRL-L.  Also,
/FORMAT:ANSI implies that CTRL-L's are to be retained.
>);END OF HELP MACRO
%HELP% (DATA,<
  The DATA-TYPE switch specifies the data type of the tape.  The
choices are "ASCII" or "EBCDIC". "ASCII" transfers the data "as is" when
both reading and writing and "EBCDIC" translates EBCDIC to ASCII when
reading and ASCII to EBCDIC when writing.
  The default is ASCII.
  Notes: the translation table used is the same as is used by IBM when
you specify OPTCD=Q in your JCL except(!):

	translation	input	output	output
			char	TAPEIO	  IBM
	===========	=====	======	======
	EBCDIC to ASCII	 CENT	  ^Z	   [
			 NOT	 TILDE	   ^
			  !        !       ]
			  [	   [	  ^Z
			  ]	   ]	  ^Z

	ASCII to EBCDIC	  !	   !	  VERTICAL BAR
			  ^	   CENT   NOT
			  TILDE    NOT    TILDE
>);END OF HELP MACRO
%HELP% (DENS,<
  The DENSITY switch specifies the density of the tape, either 800
or 1600 bpi.
  The default is 1600.
>);END OF HELP MACRO
%HELP% (EOR,<
  The EOR switch specifies how to determine the logical end of a record.
The choices are "CRLF" or "LRECL-CHARACTERS".  The 1st indicates that a
carriage-return/line feed (CRLF) terminates each logical record; the 2nd, that
every LRECL characters does (i.e. if LRECL=80, then each 80 characters, includ-
ing CR's, LF's, CRLF's etc., determines a logical record).
  The default is LRECL-CHARACTERS when reading and CRLF when writing.
>);END OF HELP MACRO
%HELP% (FORM,<
  The FORMAT switch allows you to specify certain useful combinations of
LRECL, BLKSIZE and RECFM in a single switch.  The following are the
recognized combinations:

	Keyword		LRECL	BLKSIZE	RECFM	Notes
	=======		=====	=======	=====	=====

	VCARD		235	30720	VB	cheapest for non-printing data
	VPRINT		235	30720	VBA	cheapest for data to be printed
	FCARD		80	30720	FB	good fixed length for data
	FPRINT		80	30720	FBA	good fixed length for printing
						(if each line is LEQ 80 chars)
	TCARD		80	8000	FB	TOSCIP's CARD format
	TPRINT		133	7980	FB	TOSCIP's PRINT format
						(read only)
	ANSI		2044	2048	DB	DEC's default labelled format

  The default is VCARD.
  Notes: since RECFM=Vx implies DATA-TYPE EBCDIC, VCARD and VPRINT set the
data type to EBCDIC.  ANSI sets the data type to ASCII and retains form feeds.
>);END OF HELP MACRO
%HELP% (LABE,<
  The LABEL switch specifies what kind of label (if any) the tape should
be presumed to have.  The choices are: "NL", "AL" and "SL".  "NL" indicates
that the tape doesn't have a label, "AL" that it has ANSI labels and "SL" that
it has IBM labels.  Specifying NL really means "bypass label processing", i.e.
when reading treat labels as ordinary files on the tape.  You should not
specify NL when writing a labelled tape.

  Notes:  when reading a labelled tape, you don't have to specify the RECFM,
LRECL, BLKSIZE, BLOCK-PREFIX-LENGTH, or DATA-TYPE since this information can
be obtained from the label; when writing, this information, which you have 
supplied either explicitly [by typing] or implicitly [through defaults], is
written into the label.  An unlabelled tape MUST be converted to a labelled
one by using IEHINIT at CIT or TAPELABEL here at LOTS before you can use it 
as a labelled tape.
>);END OF HELP MACRO
%HELP% (LEAD,<
  The LEADING-TAPE-MARK switch specifies whether or not the tape has a
leading tape mark, i.e. a null file at the start.
  The default is NO.
  Notes:  tapes written at IBM installations running under DOS have this 
somewhat bizarre format.
>);END OF HELP MACRO
%HELP% (LINE,<
  The LINE-NUMS switch specifies the following: when reading, remove
columns 73-80 of every logical record (presumed to contain WYLBUR line
numbers or sequence numbers) if (and only if!) LRECL=80, RECFM=FB and
EOR=LRECL; when writing, flush EDIT line numbers.
  The default is NO when reading & YES when writing.
>);END OF HELP MACRO
%HELP% (LREC,<
  The LRECL switch specifies the size of the logical records on the tape.
For fixed length records, RECFM=Fx, it is the exact length of each record; for
variable length records, RECFM=Vx or Dx, it is the maximum record length+4,
i.e. it includes the length of the record switch word (RDW).  LRECL must 
be a decimal # between 18 & 30720 which, if writing, must be a multiple 
of 4 (see BLKSIZE for other restrictions) and is ignored if RECFM=U.
  The default is 80.
>);END OF HELP MACRO
%HELP% (NULL,<
  The NULLS switch specifies that nulls are to be flushed (removed) when
reading and writing.
  The default is YES.
>);END OF HELP MACRO
%HELP% (PARI,<
  The PARITY switch specifies the parity of the tape, either
"EVEN" or "ODD".
  The default is ODD.  Since odd parity is an almost universal 
standard for 9-track tapes, you will never have to specify this 
switch.
>);END OF HELP MACRO
%HELP% (RECF,<
  The RECFM switch describes the record format of the tape.  The possible
RECFMs are:

	F		unblocked fixed length records
	FB		blocked   fixed length records
	FBA		as FB with ANSI carriage control (CC) in column 1
	U		undefined length records (only on READ)
	UA		undefined length records with CC (only on READ)
	V		IBM   unblocked variable length records
	VA		IBM   unblocked variable length records with CC
	D		ASCII unblocked variable length records
	DA		ASCII unblocked variable length records with CC
	VB		IBM   blocked   variable length records
	VBA		IBM   blocked   variable length records with CC
	DB		ASCII blocked   variable length records
	DBA		ASCII blocked   variable length records with CC

  The default is FB.

  Notes: the "A" causes CR's, LF's, FF's (^L's) & CRLF's to be translated to
and from ANSI carriage control characters as appropriate; however, LF's & FF's
are only recognized as carriage control at the start of a line.  RECFM=Dx
implies DATA-TYPE ASCII and RECFM=Vx implies DATA-TYPE EBCDIC, specifing one 
of these automatically sets the appropriate data-type.
>);END OF HELP MACRO
%HELP% (SKIP,<
  The SKIP switch specifies the # of logical records to be ignored (read
and discarded).  It must be a non-negative integer or the keyword "NONE".
  The default is NONE.
>);END OF HELP MACRO
%HELP% (TABS,<
  The TAB switch specifies the following: when reading, replace multiple
blanks with tab(s); when writing, expand tab(s) to blank(s).
  The default is NO when reading & YES when writing.

  Note: when reading, BLANKS takes precedence over TAB.
>);END OF HELP MACRO
;GENERAL HELP TOPICS

HLPTB0:	TABLE
	T CIT-TRANSFERS,H.CIT
	T DESCRIPTORS,H.SWITC,CM%INV ;"DESCRIPTORS" IS NOW "SWITCHES"
	T FORMAT,H.FORM
	T HELP-TOPICS,H.HELP
	T INTRODUCTION,H.INTRO
	T SWITCHES,H.SWITC
	TEND

;COMMANDS

HLPTB1:	TABLE
	T DEFAULT,H.DEFA
	T DISPLAY,H.DISP
	T HELP,H.HELP
	T QUIT,H.QUIT
	T READ,H.READ
	T REVERT,H.REVE
	T REWIND,H.REWI
	T TAPE-DRIVE,H.TAPE
	T UNLOAD,H.UNLO
	T WRITE,H.WRIT
	TEND

;SWITCHES

HLPTB2:	TABLE
	T BLANKS,H.BLAN
	T BLKSIZE,H.BLKS
	T BLOCK-PREFIX-LENGTH,H.BPL
	T CASE,H.CASE
	T COUNT,H.COUN
	T CTRL-L,H.CTRL
	T DATA-TYPE,H.DATA
	T DENSITY,H.DENS
	T EOR,H.EOR
	T LABEL,H.LABE
	T LEADING-TAPE-MARK,H.LEAD
	T LINE-NUMS,H.LINE
	T LRECL,H.LREC
	T NULLS,H.NULL
	T PARITY,H.PARI
	T RECFM,H.RECF
	T SKIP,H.SKIP
	T TABS,H.TABS
	TEND
$HELP:	NOISE	(ON TOPIC)
	MOVEI	AC2,[FLDDB. .CMKEY,,HLPTB0,<a general topic,>,<HELP-TOPICS>,<[
		     FLDDB. .CMKEY,,HLPTB1,<a TAPEIO command,>,,<[
		     FLDDB. .CMKEY,,HLPTB2,<a switch setting,>]>]>]
	CALL	DOCMND
	HRRZ	AC4,(AC2)	;NO, GET TOPIC POINTER
	CALL	CONFRM
	HRRO	AC1,AC4		;CONVERT TO POINTER
	CALL	PRTLST
	RET

	END	TAPEIO