Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	TITLE	TAPIN
	SUBTTL	MAGTAPE TRANSLATION AND UNBLOCKING PROGRAM

COMMENT @

Written by:

Paul Alciere
U. S. Department of Transportation
Transportation Systems Center
Kendall Square
Cambridge, Massachusetts 02142
U. S. A.

With acknowledgement for many suggestions and good ideas from Henrik Lind
of Bolt, Beranek, and Newman Inc.
@

	SEARCH	MACTEN,UUOSYM
	SALL
	TWOSEG

VMAJOR==1
VMINOR==6
VEDIT==24
VWHO==7
.JBVER==137

LOC .JBVER
BYTE (3)VWHO(9)VMAJOR(6)VMINOR(18)VEDIT

	SUBTTL	REVISION HISTORY

;001	THE FIRST ATTEMPT
;002	COSMETIC CHANGES, PLUS TTYIN MADE A SUBROUTINE
;	ALSO REMOVED TRCE'S FROM RECORD LENGTH COMPUTATION

;VERSION 1A

;003	ADD SIXBIT SUPPORT, PDP11 BINARY TAPES, AND CRLF IN 8-BIT ASCII
;004	ACCEPT 8-BIT ASCII WITH EITHER 0 OR 1 AS THE 8TH BIT.
;005	MINOR CHANGES IN TYPOUTS.
;006	FIXED SOME BUGS
;007	DELETE SEQUENCE NUMBERS FOR ANY LOGICAL RECORD LENGTH, NOT JUST 80.

;VERSION 1B

;010	PROCESS MULTIPLE FILES IF OUTPUT DEVICE IS A MAGTAPE.
;	ALSO,FIX BUG IN EOF ROUTINE WHICH CAUSED PDL. OV. AFTER MANY FILES.
;	ALSO, DO NOT COUNT END OF FILE AS AN "ERROR".

;VERSION 1C

;011	SUPPORT EBCDIC OR 8-BIT ASCII ON 7-TRACK TAPE

;VERSION 1D

;012	SUPPORT UNIVAC FIELDATA CODE ON 7-TRACK TAPE
;013	GIVE UP BUFFERS AFTER CLOSING OUTPUT FILE
;014	IF CODE="NAME", TRANSLATE AS 8-BIT ASCII, BUT GET THE FILE NAME,
;	EXTENSION FROM THE FIRST RECORD OF EACH FILE.
;015	IF CODE="R", PROCESS PDP-11 RT-11 PIP FILES
;016	Report density and blocksize of output MAGtape

;VERSION 1E

;017	Support variable EBCDIC
;020	Report density, etc. of input MAGtape.

;VERSION 1F

;021	Support Systems Concepts, Inc. SA-10 MAGtape controller.
;022	Fix bugs in SIXBIT processing.
;023	Fix EBCDIC table codes C0 and D0 to reflect real world
;	not COBOL packed decimal.
;024	Fix bugs in FIELDATA and RSX-11 FILES-11 tape support.

	SUBTTL	DEFINITIONS

PDLSIZ=20	;PUSHDOWN LIST SIZE


;AC'S:

	DEFINE	AC($A),<
	ZZ==ZZ+1
	$A==ZZ>
	ZZ==-1

AC(SW)		;SWITCH REGISTER
AC(T1)		;TEMPORARY AC'S:
AC(T2)
AC(REC)		;COUNTS CHARACTERS/RECORD FOR UNBLOCKING
AC(BLK)		;COUNTS RECORDS/BLOCK FOR UNBLOCKING
AC(LEFT)	;2 CONSECUTIVE AC'S USED FOR MULTIPLYING, DIVIDING
AC(RIGHT)	;2 CONSECUTIVE AC'S USED FOR MULTIPLYING, DIVIDING
AC(PNT)		;HOLDS A BYTE POINTER FOR CERTAIN SUBROUTINES
AC(CNT)		;COUNTER
AC(FROM)	;BYTE POINTER FOR TAPE INPUT BUFFER
AC(CH)		;HOLDS ONE CHARACTER
AC(BITS)	;HOLDS SOME BITS
AC(STATUS)	;HOLDS DEVICE, FILE STATUS TEMPORARILY
AC(P)		;PUSH-DOWN LIST POINTER

;BITS IN SWITCH REGISTER:

MAG==1		;OUTPUT DEVICE IS A MAGTAPE
SEQ==2		;DELETE SEQUENCE NUMBERS
STS==4		;SUPPRESS TRAILING SPACES
CRLFIN==10	;<CR>,<LF> INCLUDED IN 8-BIT ASCII DATA
SIX==20		;SIXBIT ASCII DATA
BIN==40		;BINARY DATA
MT7==100	;INPUT TAPE IS 7-TRACK
MT7AE==200	;7-TRACK ASCII/EBCDIC
NAME==400	;FILE NAMES ON 8-BIT ASCII FILES
RSX11==1000	;RSX11 FILES-11 FILES
EOF==2000	;LAST RECORD WAS EOF
V==4000		;VARIABLE EBCDIC
LBL==10000	;PROCESSING TAPE LABELS


;CHANNELS:

TTY==1
INN==2
OUT==3

;MACROS:

	DEFINE	PUTBYT,<
	SOSGE	OBUF+2
	PUSHJ	P,BUFOUT
	IDPB	CH,OBUF+1>

	DEFINE	TESTAT(B,M)<
	TRNE	STATUS,B			;;TEST BIT
	OUTSTR	M			;;TYPE OUT MESSAGE>

	SUBTTL	COMBINED BCD/EBCDIC TO ASCII LOOKUP TABLE

	RELOC	400000

;LEFT HALFWORD OF FIRST 64 WORDS CONTAINS ASCII EQUIVALENT OF BCD CHARACTER
;RIGHT HALFWORD OF EVERY WORD CONTAINS ASCII EQUIVALENT OF EBCDIC CHARACTER
;ILLEGAL CHARACTERS TRANSLATE TO QUESTION MARK
;FIRST 64 EBCDIC CHARACTERS ARE ILLEGAL EBCDIC, SO FIRST 64 WORDS ARE REALLY
;JUST THE BCD TABLE.

;BCD SUB-TABLE

TABLE1:	XWD "?"," "	;00	NULL
	XWD "1","?"	;01	1
	XWD "2","?"	;02	2
	XWD "3","?"	;03	3
	XWD "4","?"	;04	4
	XWD "5","?"	;05	5
	XWD "6","?"	;06	6
	XWD "7","?"	;07	7
	XWD "8","?"	;10	8
	XWD "9","?"	;11	9
	XWD "0","?"	;12	0
	XWD "=","?"	;13	=
	XWD "'","?"	;14	'
	XWD ":","?"	;15	:
	XWD ">","?"	;16	>
	XWD """","?"	;17	"
	XWD " ","?"	;20	SPACE
	XWD "/","?"	;21	/
	XWD "S","?"	;22	S
	XWD "T","?"	;23	T
	XWD "U","?"	;24	U
	XWD "V","?"	;25	V
	XWD "W","?"	;26	W
	XWD "X","?"	;27	X
	XWD "Y","?"	;30	Y
	XWD "Z","?"	;31	Z
	XWD "?","?"	;32	?
	XWD ",","?"	;33	,
	XWD "(","?"	;34	(
	XWD "&","?"	;35	&
	XWD "\","?"	;36	\
	XWD "_","?"	;37	_
	XWD "-","?"	;40	-
	XWD "J","?"	;41	J
	XWD "K","?"	;42	K
	XWD "L","?"	;43	L
	XWD "M","?"	;44	M
	XWD "N","?"	;45	N
	XWD "O","?"	;46	O
	XWD "P","?"	;47	P
	XWD "Q","?"	;50	Q
	XWD "R","?"	;51	R
	XWD ":","?"	;52	:(-0)
	XWD "$","?"	;53	$
	XWD "*","?"	;54	*
	XWD "]","?"	;55	]
	XWD ";","?"	;56	;
	XWD "@","?"	;57	@
	XWD "+","?"	;60	+
	XWD "A","?"	;61	A
	XWD "B","?"	;62	B
	XWD "C","?"	;63	C
	XWD "D","?"	;64	D
	XWD "E","?"	;65	E
	XWD "F","?"	;66	F
	XWD "G","?"	;67	G
	XWD "H","?"	;70	H
	XWD "I","?"	;71	I
	XWD "?","?"	;72	?(+0)
	XWD ".","?"	;73	.
	XWD ")","?"	;74	)
	XWD "[","?"	;75	[
	XWD "<","?"	;76	<
	XWD "%","?"	;77	%

;	EBCDIC TO ASCII LOOKUP TABLE

	RADIX	10

			;00-3F ILLEGAL FOR EBCDIC, USED ONLY FOR BCD
	EXP	" "	;40 (BLANK)
	REPEAT 9,<"?">	;41-49 ILLEGAL
	EXP	"?"	;4A = "CENTS", NOT AVAILABLE IN ASCII
	EXP	"."	;4B
	EXP	"<"	;4C
	EXP	"("	;4D
	EXP	"+"	;4E
	OCT	174	;4F (VERTICAL BAR)
	EXP	"&"	;50
	REPEAT 9,<"?">	;51-59 ILLEGAL
	EXP	"!"	;5A
	EXP	"$"	;5B
	EXP	"*"	;5C
	EXP	")"	;5D
	EXP	";"	;5E
	EXP	"_"	;5F (APPROXIMATION FOR "NOT")
	EXP	"-"	;60
	EXP	"/"	;61
	REPEAT 9,<"?">	;62-6A ILLEGAL
	EXP	","	;6B
	EXP	"%"	;6C
	EXP	"_"	;6D (UNDERLINE)
	EXP	">"	;6E
	EXP	"?"	;6F
	REPEAT 10,<"?">	;70-79 ILLEGAL
	EXP	":"	;7A
	EXP	"#"	;7B
	EXP	"@"	;7C
	EXP	"'"	;7D
	EXP	"="	;7E
	EXP	""""	;7F (")
	EXP	"?"	;80 ILLEGAL
	EXP	"a"	;81	LOWER CASE LETTERS:
	EXP	"b"	;82
	EXP	"c"	;83
	EXP	"d"	;84
	EXP	"e"	;85
	EXP	"f"	;86
	EXP	"g"	;87
	EXP	"h"	;88
	EXP	"i"	;89
	REPEAT 7,<"?">	;8A-90 ILLEGAL
	EXP	"j"	;91
	EXP	"k"	;92
	EXP	"l"	;93
	EXP	"m"	;94
	EXP	"n"	;95
	EXP	"o"	;96
	EXP	"p"	;97
	EXP	"q"	;98
	EXP	"r"	;99
	REPEAT 8,<"?">	;9A-A1 ILLEGAL
	EXP	"s"	;A2
	EXP	"t"	;A3
	EXP	"u"	;A4
	EXP	"v"	;A5
	EXP	"w"	;A6
	EXP	"x"	;A7
	EXP	"y"	;A8
	EXP	"z"	;A9
	REPEAT 22,<"?">	;AA-BF ILLEGAL
	EXP	"{"	;C0
	EXP	"A"	;C1	UPPER CASE LETTERS:
	EXP	"B"	;C2
	EXP	"C"	;C3
	EXP	"D"	;C4
	EXP	"E"	;C5
	EXP	"F"	;C6
	EXP	"G"	;C7
	EXP	"H"	;C8
	EXP	"I"	;C9
	REPEAT 6,<"?">	;CA-CF ILLEGAL
	EXP	"}"	;D0
	EXP	"J"	;D1
	EXP	"K"	;D2
	EXP	"L"	;D3
	EXP	"M"	;D4
	EXP	"N"	;D5
	EXP	"O"	;D6
	EXP	"P"	;D7
	EXP	"Q"	;D8
	EXP	"R"	;D9
	REPEAT 8,<"?">	;DA-E1 ILLEGAL
	EXP	"S"	;E2
	EXP	"T"	;E3
	EXP	"U"	;E4
	EXP	"V"	;E5
	EXP	"W"	;E6
	EXP	"X"	;E7
	EXP	"Y"	;E8
	EXP	"Z"	;E9
	REPEAT 6,<"?">	;EA-EF ILLEGAL
	EXP	"0"	;F0
	EXP	"1"	;F1
	EXP	"2"	;F2
	EXP	"3"	;F3
	EXP	"4"	;F4
	EXP	"5"	;F5
	EXP	"6"	;F6
	EXP	"7"	;F7
	EXP	"8"	;F8
	EXP	"9"	;F9
	REPEAT 6,<"?">	;FA-FF ILLEGAL

	SUBTTL	UNIVAC FIELDATA LOOKUP TABLE

;LEFT HALFWORD CONTAINS ASCII EQUIVALENT OF FIELDATA CHARACTER.
;CODE TRANSLATION USES SAME LOGIC AS BCD.

TABLE2:	XWD	"@",0
	XWD	"[",0
	XWD	"]",0
	XWD	"#",0
	XWD	"^",0
	XWD	" ",0
	XWD	"A",0
	XWD	"B",0
	XWD	"C",0
	XWD	"D",0
	XWD	"E",0
	XWD	"F",0
	XWD	"G",0
	XWD	"H",0
	XWD	"I",0
	XWD	"J",0
	XWD	"K",0
	XWD	"L",0
	XWD	"M",0
	XWD	"N",0
	XWD	"O",0
	XWD	"P",0
	XWD	"Q",0
	XWD	"R",0
	XWD	"S",0
	XWD	"T",0
	XWD	"U",0
	XWD	"V",0
	XWD	"W",0
	XWD	"X",0
	XWD	"Y",0
	XWD	"Z",0
	XWD	")",0
	XWD	"-",0
	XWD	"+",0
	XWD	"<",0
	XWD	"=",0
	XWD	">",0
	XWD	"&",0
	XWD	"$",0
	XWD	"*",0
	XWD	"(",0
	XWD	"%",0
	XWD	":",0
	XWD	"?",0
	XWD	"!",0
	XWD	",",0
	XWD	"\",0
	XWD	"0",0
	XWD	"1",0
	XWD	"2",0
	XWD	"3",0
	XWD	"4",0
	XWD	"5",0
	XWD	"6",0
	XWD	"7",0
	XWD	"8",0
	XWD	"9",0
	XWD	"'",0
	XWD	";",0
	XWD	"/",0
	XWD	".",0
	XWD	"""",0
	XWD	"_",0

	RADIX	8

	SUBTTL	MODE SWITCHES

	LALL

	DEFINE	MODES(CHARS)<
TABLE3:	IRPC CHARS,<	EXP "CHARS">
TBLLEN==.-TABLE3

TABLE4:	IRPC CHARS,<	EXP WAS'CHARS>>

	MODES (ABEFINRSV1)

	SUBTTL	INITIALIZATION
	SALL

START:	JFCL
	RESET
	MOVEI	T1,GOTEOF
	MOVEM	T1,.JBREN		;SET UP REENTRY ADDRESS FOR HUNG DEVICE
	MOVE	P,[IOWD PDLSIZ,STACK]
	SETZB	SW,RECS#
	SETZM	LOWZRO			;ZERO BUFFERS, ETC.
	MOVE	T1,[XWD LOWZRO,LOWZRO+1]
	BLT	T1,LOWTOP
	OPEN	TTY,TTYBLK
	  HALT

;SET UP LOGICAL NAME OF INPUT MAGTAPE

ASKIN:	OUTSTR	[ASCIZ"
Input device:	"]
	INPUT	TTY,			;READ NAME OF MAGTAPE
	MOVE	PNT,[POINT 6,INNBLK+1]
	PUSHJ	P,SIXIN
	MOVE	T1,INNBLK+1
	MOVEM	T1,LOC			;SET UP DEVICE NAME FOR MTCHR.
	DEVCHR	T1,
	TLNN	T1,(DV.MTA)		;TEST FOR MAGTAPE
	JRST	NOTMTA			;NOT A MAGTAPE

;OPEN INPUT MAGTAPE

OPNINN:	OPEN	INN,INNBLK
	JRST	[OUTSTR	[ASCIZ/
?Cannot open a device by that name.
/]
		JRST	ASKIN]
	MOVE	STATUS,[XWD 21,LOC]
	MTCHR.	STATUS,
	  HALT
	OUTSTR	[ASCIZ/[Input MAGtape/]
	MOVE	T1,STATUS
	TRZE	T1,MT.7TR		;TEST FOR 7-TRACK
	OUTSTR	[ASCIZ/ 7-track,/]
	TRZE	T1,MT.WLK		;TEST FOR WRITE-LOCK
	OUTSTR	[ASCIZ/ write-locked,/]
	ANDI	T1,7			;TEST DENSITY
	OUTSTR	[ASCIZ/ density: /]
	MOVE	LEFT,[DEC 0,200,556,800,1600,6250](T1);LOOK UP DENSITY
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ/, reel ID: /]
	MOVE	T1,LOC+1		;REEL ID
	PUSHJ	P,SIXOUT
	OUTSTR	[ASCIZ/]
/]

	MOVE	T1,LOC+.MTSRE		;SAVE INITIAL ERROR COUNTS
	MOVEM	T1,OLDSRE
	MOVE	T1,LOC+.MTHRE
	MOVEM	T1,OLDHRE#
	TRNN	STATUS,MT.7TR		;SKIP IF 7-TRACK
	JRST	INDUST			;IT WAS 9-TRACK

;ASK 7-TRACK QUESTIONS

ASK7:	TRO	SW,MT7			;SET 7-TRACK SWITCH
	MOVSI	T1,(POINT 6)		;6-BIT BYTES IF 7-TRACK TAPE
	MOVEM	T1,BYTPTR#
	MOVEI	T1,6
	MOVEM	T1,BPERW#		;6 BYTES PER WORD
	OUTSTR	[ASCIZ"Parity:		"]
	MOVEI	BITS,.IODMP
	PUSHJ	P,TTYIN			;PICK UP O/E
	CAIL	CH,140			;LOWER CASE?
	SUBI	CH,40			;YES. CONVERT TO UPPER CASE
	CAIE	CH,"E"
	JRST	ASKCOD
	IORI	BITS,IO.PAR		;SET EVEN PARITY BIT IF "E"
	SETSTS	INN,(BITS)		;MODIFY STATUS BITS OF OPENED INPUT FILE
	MOVE	T1,[XWD 2,[EXP .TFKTP,INN]]
	TAPOP.	T1,			;TEST KONTROLLER TYPE
	  HALT
	CAIE	T1,7			;SA-10?
	JRST	ASKCOD			;NO
INDUST:	MOVE	T1,[XWD 3,[EXP .TFMOD+1000,INN,.TFM8B]]
	TAPOP.	T1,			;SET INDUSTRY-COMPATIBLE MODE
	  HALT
	MOVSI	T1,(POINT 8)
	MOVEM	T1,BYTPTR		;SET BYTE POINTER FOR SA-10
	MOVEI	T1,4
	MOVEM	T1,BPERW		;SET BYTES PER WORD

	;ASK WHICH CODE TO USE:

ASKCOD: OUTSTR	[ASCIZ/Code:		/]
	PUSHJ	P,TTYIN			;GET A/B/E/F/I/N/R/S/V/11
	MOVSI	T1,-TBLLEN
LOOP:	CAMN	CH,TABLE3(T1)
	JRST	@TABLE4(T1)
	AOBJN	T1,LOOP
	JRST	ASKCOD

;RSX-11 FILES-11 TAPE

WASR:	TRO	SW,RSX11
	TRNE	SW,MT7			;TEST FOR 7-TRACK
	  JRST	[OUTSTR	[ASCIZ/
? TAPIN does not support 7-track RSX-11 FILES-11 tapes yet.
/]
		EXIT]
	JRST	GETLEN


;8-BIT ASCII

WASN:	TRO	SW,NAME
WASA:	TRNE	SW,MT7			;IS IT 7-TRACK?
	TRO	SW,MT7AE		;SET 7-TRACK ASCII/EBCDIC BIT
	MOVEI	T1,ASCIIX
	MOVEM	T1,DISPCH#		;SET UP DISPATCH TO ASCII ROUTINE
	MOVSI	T1,(POINT 8)
	CAME	T1,BYTPTR
	MOVSI	T1,(POINT 4)
	MOVEM	T1,BYTPTR
	OUTSTR	[ASCIZ/CRLF in input?	/]
	PUSHJ	P,TTYIN
	CAIN	CH,"Y"
	TRO	SW,CRLFIN
	JRST	GETLEN

WASF:	SKIPA	T1,[FLDATA]		;FIELDATA
WASB:	MOVEI	T1,BCD			;BCD
	MOVEM	T1,DISPCH		;SET UP DISPATCH TO BCD/FIELDATA ROUTINE
	TRNN	SW,MT7
	OUTSTR	[ASCIZ/% BCD or Fieldata is unusual on a 9-track tape.
/]
	JRST	GETLEN

;EBCDIC

WASV:	TRO	SW,V			;VARIABLE EBCDIC
WASE:	TRNE	SW,MT7			;7-TRACK INPUT TAPE?
	TRO	SW,MT7AE		;SET 7-TRACK ASCII/EBCDIC BIT
	MOVEI	T1,EBCDIC
	TRNE	SW,V
	MOVEI	T1,VEBCDC
	MOVEM	T1,DISPCH		;SET UP DISPATCH TO EBCDIC ROUTINE
	MOVSI	T1,(POINT 8)
	CAME	T1,BYTPTR
	MOVSI	T1,(POINT 4)
	MOVEM	T1,BYTPTR
	JRST	GETLEN

;IMAGE MODE

WASI:	MOVEI	T1,IMAGE		;IMAGE MODE COPY
	MOVEM	T1,DISPCH
	MOVEI	T1,.IOIMG
	MOVEM	T1,OUTBLK
	MOVSI	T1,(POINT 36)
	MOVEM	T1,BYTPTR
	TRO	SW,BIN
	JRST	GETLEN

WASS:	TRO	SW,SIX			;SIXBIT ASCII
	MOVEI	T1,ASCIIX
	MOVEM	T1,DISPCH
	MOVSI	T1,(POINT 6)
	MOVEM	T1,BYTPTR
	MOVEI	T1,6
	MOVEM	T1,BPERW
	MTDEC.	INN,
	PUSHJ	P,SIXHDR		;TYPE OUT HEADER RECORD, IF ANY
	JRST	GETLEN

;PDP-11 BINARY FILE

WAS1:	ILDB	CH,TINP+1
	CAIE	CH,"1"
	JRST	ASKCOD
	MOVEI	T1,PDP11		;PDP11 BINARY FILE
	MOVEM	T1,DISPCH
	MOVEI	T1,.IOIMG
	MOVEM	T1,OUTBLK
	MOVSI	T1,(POINT 8)
	MOVEM	T1,BYTPTR
	TRO	SW,BIN

;DETERMINE PHYSICAL BLOCK LENGTH

GETLEN:	PUSHJ	P,READ
	SETZM	BLKNO
	MTBSR.	INN,			;BACKSPACE TAPE
	TRNE	SW,RSX11
	JRST	ASKOUT
	OUTSTR	[ASCIZ/
[Block length /]
	MOVE	LEFT,LOC+.MTCCR
	TRNN	SW,MT7AE		;7-TRACK ASCII/EBCDIC?
	JRST	GETLN1			;NO. USE COUNT AS IS
	IMULI	LEFT,^D6		;YES. MULTIPLY BY 6
	IDIVI	LEFT,^D8		;AND DIVIDE BY 8
GETLN1:	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ/ bytes]

/]

;ASK LOGICAL RECORD LENGTH:

ASKLEN:	TRNE	SW,BIN!V
	JRST	ASKOUT
	OUTSTR	[ASCIZ/Logical record length: /]
	TRNN	SW,SIX			;SIXBIT?
	JRST	ASKL1			;NO. MUST ASK
	MOVE	LEFT,@.JBFF		;YES. TELL USER.
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ/ bytes.
/]
	SKIPA	T1,@.JBFF
ASKL1:	PUSHJ	P,DECIN			;INPUT A DECIMAL NUMBER
	SKIPN	T1			;<CR>=BLOCK LENGTH
	MOVE	T1,LOC+.MTCCR
	MOVEM	T1,RECLEN#
	TRNE	SW,BIN
	JRST	GOTLEN
	OUTSTR	[ASCIZ/Delete sequence numbers? /]
	PUSHJ	P,TTYIN			;GET RESPONSE
	CAIE	CH,"Y"			;YES/NO
	JRST	GOTLEN			;NO
	TRO	SW,SEQ			;YES
	OUTSTR	[ASCIZ/Last column to keep: /]
	PUSHJ	P,DECIN
	MOVEM	T1,SEQ0#
GOTLEN:	OUTSTR	[ASCIZ/Suppress trailing spaces? /]
	PUSHJ	P,TTYIN			;GET ANSWER
	CAIN	CH,"Y"			;TEST FOR Y
	TRO	SW,STS			;YES. SET FLAG

;ASK OUTPUT QUESTIONS

ASKOUT:	OUTSTR	[ASCIZ/
Output device: /]
	INPUT	TTY,
	MOVE	PNT,[POINT 6,OUTBLK+1]
	PUSHJ	P,SIXIN
	MOVE	T1,OUTBLK+1		;GET NAME OF OUTPUT DEVICE
	DEVCHR	T1,			;GET ITS CHARACTERISTICS
	TLNE	T1,(DV.MTA)		;IS IT A MAGTAPE?
	TRO	SW,MAG			;YES.  SET FLAG
	TRNN	SW,MAG!NAME
	JRST	OPNOUT

;REPORT OUTPUT MAGTAPE INFO

REPORT:	MOVE	T1,[XWD OUTBLK,DVSZBL]	;MOVE OUTPUT OPEN BLOCK INFO
	BLT	T1,DVSZBL+1		;TO DEVSIZ BLOCK
	MOVEI	LEFT,DVSZBL
	DEVSIZ	LEFT,			;GET BLOCKSIZE
	  HALT
	OUTSTR	[ASCIZ/[Output blocksize: /]
	HRRZS	LEFT			;BLOCKSIZE IS IN RIGHT HALFWORD
	SUBI	LEFT,3			;3 EXTRA WORDS DON'T COUNT
	PUSHJ	P,DECOUT		;TYPE IT OUT
	OPEN	OUT,OUTBLK
	  JRST	[OUTSTR	[ASCIZ/
?Cannot	open a device by that name.
/]
		JRST	ASKOUT]
	MOVE	T1,[XWD 2,LOCOUT]	;GET OUTPUT TAPE CHARACTERISTICS
	MTCHR.	T1,
	  HALT
	TRZE	T1,MT.7TR		;TEST FOR 7-TRACK
	OUTSTR	[ASCIZ/, 7-track /]
	TRZE	T1,MT.WLK		;TEST FOR WRITE-LOCK
	OUTSTR	[ASCIZ/, write-locked /]
	ANDI	T1,7			;TEST DENSITY
	OUTSTR	[ASCIZ/, density: /]
	MOVE	LEFT,[DEC 0,200,556,800,1600,6250](T1);LOOK UP DENSITY
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ/, reel ID: /]
	MOVE	T1,LOCOUT+1		;REEL ID
	PUSHJ	P,SIXOUT
	OUTSTR	[ASCIZ/]
/]
	MOVEI	T1,1
	TRNE	SW,RSX11!NAME
	JRST	NFILES
	OUTSTR	[ASCIZ/How many files? /]
	PUSHJ	P,DECIN
NFILES:	MOVEM	T1,FILES#

;OPEN OUTPUT DEVICE

OPNOUT:	MOVE	T1,.JBFF
	MOVEM	T1,SVJBFF#		;SAVE JBFF SO WE CAN GIVE UP BUFFERS
	OPEN	OUT,OUTBLK
	  JRST	[OUTSTR	[ASCIZ/
?Cannot	open a device by that name.
/]
		JRST	ASKOUT]
DUMMY:	OUTPUT	OUT,			;DUMMY OUTPUT
	TRNE	SW,RSX11		;TEST FOR RSX-11 OPTION
	JRST	RSX11A			;GO TO RSX-11 CODE

;TEST WHETHER THE OUTPUT DEVICE IS A DIRECTORY DEVICE

TSTDIR:	MOVEI	BITS,OUT		;TEST WHETHER DIRECTORY DEVICE
	DEVCHR	BITS,
	TLNN	BITS,(DV.DIR)		;SKIP IF DIRECTORY DEVICE
	JRST	COPY			;ELSE JUMP

;GET FILE NAME FROM TAPE IF CODE = "N"

	TRNN	SW,NAME
	JRST	ASKFIL			;OPTION NOT CHOSEN
	PUSHJ	P,READ			;READ THE RECORD
	MOVSI	FROM,(POINT 8)
	HRR	FROM,.JBFF
	EXCH	FROM,TINP+1
	MOVE	PNT,[POINT 6,OUTNAM]
	PUSHJ	P,SIXIN
	MOVE	PNT,[POINT 6,OUTNAM+1]
	PUSHJ	P,SIXIN
	EXCH	FROM,TINP+1
	OUTSTR	[ASCIZ/
FILENAME: /]
	MOVE	T1,OUTNAM
	PUSHJ	P,SIXOUT
	OUTCHR	["."]
	MOVE	T1,OUTNAM+1
	PUSHJ	P,SIXOUT
	OUTSTR	[ASCIZ/
/]
	JRST	GOTNAM

;ASK FILENAME.EXT IF DIRECTORY DEVICE

ASKFIL:	OUTSTR	[ASCIZ/Output filename.ext: /]
	INPUT	TTY,
	MOVE	PNT,[POINT 6,OUTNAM]
	PUSHJ	P,SIXIN
	MOVE	PNT,[POINT 6,OUTNAM+1]
	PUSHJ	P,SIXIN
GOTNAM:	SETZM	OUTNAM+2
	SETZM	OUTNAM+3
	ENTER	OUT,OUTNAM
	  JRST	[OUTSTR	[ASCIZ/?Cannot open a file by that name.
/]
		JRST	ASKFIL]

;SKIP ONE LOGICAL RECORD IF CODE = "NAME"

	TRNN	SW,NAME			;NAME OPTION CHOSEN?
	JRST	COPY			;NO
	MOVE	FROM,BYTPTR		;YES. SKIP ONE LOGICAL RECORD
	HRR	FROM,.JBFF
	MOVEM	FROM,LEFT
	MOVEM	FROM,RIGHT
	MOVE	T1,RECLEN		;GET RECORD LENGTH
	TRNE	SW,CRLFIN		;CRLF ALSO?
	ADDI	T1,2			;YES. ADD 2 FOR CRLF
	MOVE	LEFT,LOC+.MTCCR
	IDIV	LEFT,T1			;DIVIDE BLOCK LENGTH BY RECORD LENGTH
	MOVEM	LEFT,RPERBL
	MOVE	REC,RECLEN
	IBP	FROM
	SOJG	REC,.-1
	MOVE	BLK,RPERBL
	JRST	CRLF3

COPY:	OUTSTR	[ASCIZ/
[Copying.]
/]

	SUBTTL	PROCESSING

PROCES:	PUSHJ	P,READ			;READ A BLOCK FROM MAGTAPE
	TRNN	SW,SIX			;SIXBIT?
	JRST	PROC1			;NO
	HRRZ	LEFT,@.JBFF		;COMPUTE ACTUAL BYTES/LOGICAL RECORD
	IDIVI	LEFT,6
	SKIPE	RIGHT			;FILLER BYTES FOR LAST WORD
	AOS	LEFT
	AOS	LEFT			;EXTRA WORD FOR COBOL FLAGS
	IMULI	LEFT,6
	MOVEM	LEFT,T1
	TRNE	SW,MT7			;7-TRACK?
	JRST	PROC2
	MOVE	LEFT,LOC+.MTCCR		;CORRECTION FOR 8-TRACK SIXBIT
	IDIVI	LEFT,5
	IMULI	LEFT,6
	MOVEM	LEFT,LOC+.MTCCR
	JRST	PROC2

PROC1:	MOVE	T1,RECLEN#		;GET RECORD LENGTH
	TRNE	SW,CRLFIN		;CRLF ALSO?
	ADDI	T1,2			;YES. ADD 2 FOR CRLF
PROC2:	MOVE	LEFT,LOC+.MTCCR
	IDIV	LEFT,T1
	MOVEM	LEFT,RPERBL#
	MOVE	FROM,BYTPTR		;CONSTRUCT INPUT BYTE POINTER
	HRR	FROM,.JBFF##
	MOVE	BLK,RPERBL		;RECORDS PER BLOCK
NEWREC:	TRNE	SW,SIX			;IF SIXBIT,
	AOS	FROM			;SKIP FLAG WORD
	MOVEM	FROM,LEFT		;SAVE POINTER TO BEGINNING OF LINE
	MOVEM	FROM,RIGHT
	MOVE	REC,RECLEN		;GET LOGICAL RECORD LENGTH
	TRNE	SW,SEQ			;DELETING SEQUENCE NUMBERS?
	MOVE	REC,SEQ0		;USE LAST COLUMN TO KEEP, INSTEAD
	TRNE	SW,SIX			;SIXBIT?
	JRST	@DISPCH			;YES. GO TO DISPCH IMMEDIATELY
	CAMLE	REC,LOC+.MTCCR		;IF RECORD LENGTH .GT. BLOCK LENGTH
	MOVE	REC,LOC+.MTCCR		;USE BLOCK LENGTH INSTEAD
	JRST	@DISPCH			;DISPATCH TO APPROPRIATE ROUTINE

;ALL TRANSLATION ROUTINES END WITH "JRST CRLF" OR "JRST ENDREC"

CRLF:	MOVEI	CH,15			;INSERT CARRIAGE RETURN
	PUTBYT
	MOVEI	CH,12			;INSERT LINE FEED
	PUTBYT
CRLF3:	TRNN	SW,CRLFIN		;CRLF IN INPUT?
	JRST	CRLF1			;NO
	IBP	FROM			;YES. IGNORE CR
	IBP	FROM			;IGNORE LF
CRLF1:	TRNN	SW,SIX			;SIXBIT?
	JRST	CRLF2			;NO
	AOS	FROM			;YES. ADVANCE POINTER TO BEGINNING
	HRLI	FROM,(POINT 6)		;OF NEXT WORD
CRLF2:	AOS	RECS#
	SOJG	BLK,NEWREC		;COUNT LOGICAL RECORDS PER BLOCK
	JRST	PROCES

GOTEOF:	TRON	SW,EOF			;TEST FOR 2ND EOF IN A ROW
	JRST	EOF1			;NO. ONLY ONE
	OUTSTR	[ASCIZ/
[Second EOF in a row.]
/]
	EXIT
EOF1:	MOVE	P,[IOWD PDLSIZ,STACK]	;INITIALIZE STACK POINTER
	TRNN	SW,LBL			;DON'T WRITE EXTRA EOF FOR RSX-11 LABELS
	CLOSE	OUT,
	MOVE	T1,SVJBFF		;GIVE UP THE BUFFERS
	MOVEM	T1,.JBFF
	PUSHJ	P,MTSTAT
	OUTSTR	[ASCIZ/[/]
	MOVE	LEFT,RECS
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ/ logical records, /]
	MOVE	LEFT,BLKNO
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ/ blocks read.]
[/]
	MOVE	LEFT,LOC+.MTSRE		;SOFT READ ERRORS
	SUB	LEFT,OLDSRE#
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ/ soft read errors.]
[/]
	MOVE	LEFT,LOC+.MTHRE		;HARD READ ERRORS
	SUB	LEFT,OLDHRE
	SKIPE	LEFT
	SOS	LEFT			;DON'T COUNT EOF AS AN "ERROR"
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ/ hard read errors.]
/]
	SETZM	BLKNO
	SETZM	RECS
	TRNE	SW,RSX11		;RSX11 OPTION?
	JRST	RSX11E			;DIFFERENT LOGIC
	TRNN	SW,SIX			;SIXBIT?
	JRST	MORFLS			;NO
	PUSHJ	P,SIXHDR		;TYPE OUT EOF1 TRAILER LABEL
	MTSKF.	INN,			;SKIP OVER END OF FILE MARK
MORFLS:	SOSLE	FILES			;COUNT FILES
	JRST	OPNOUT			;IF MORE FILES, COPY THEM
	OUTSTR	[ASCIZ/
More? /]
	PUSHJ	P,TTYIN
	CAIN	CH,"N"
	EXIT
	TRNE	SW,SIX			;PROCESSING SIXBIT?
	PUSHJ	P,SIXHDR		;YES. TYPE OUT HEADER
	JRST	OPNOUT

;SUBROUTINES

;OUTPUT A BUFFER TO OUTPUT DEVICE, CHECKING FOR MTA EOT

BUFOUT:	OUTPUT	OUT,
	STATZ	OUT,IO.BKT		;TEST FOR DISK FULL
	  JRST	[OUTSTR	[ASCIZ/
? Output device full.
/]
		EXIT]
	SOS	OBUF+2
	TRNN	SW,MAG			;IS IT MTA?
	POPJ	P,			;NO
	STATO	OUT,IO.EOT		;IS IT AT EOT?
	POPJ	P,			;NO
EOT:	MTEOF.	OUT,			;WRITE A TAPE MARK
	MTUNL.	OUT,			;UNLOAD
	OUTSTR	[ASCIZ/
Use SEND OPR: command to ask operator to mount next reel.
Then give CONTINUE command.
/]
	EXIT	1,
	POPJ	P,

;READ A BLOCK FROM TAPE

READ:	HRRZ	T1,.JBFF		;MAKE INPUT LIST
	SUB	T1,.JBREL##
	HRLZS	T1
	HRR	T1,.JBFF
	SOJ	T1,
	SETZ	T2,
	INPUT	INN,T1			;READ ONE RECORD (UNBUFFERED)
	GETSTS	INN,STATUS		;GET FILE STATUS FROM MONITOR
	TRNE	STATUS,IO.EOF
	JRST	GOTEOF
	TRZ	SW,EOF			;REMEMBER THIS WAS NOT AN EOF
	AOS	BLKNO#
	TRNE	STATUS,IO.ERR
	PUSHJ	P,MTSTAT
	MOVE	LEFT,[XWD 21,LOC]
	MTCHR.	LEFT,
		 HALT
	POPJ	P,

;8-BIT ASCII TRANSLATION ROUTINE


ASCIIX:	TRNE	SW,STS			;SUPPRESS TRAILING SPACES?
	JRST	ASC4			;YES
	TRNE	SW,SIX			;SIXBIT?
	JRST	SIXA			;SLIGHTLY DIFFERENT PROCESS
	TRNE	SW,MT7			;SEVEN TRACK INPUT TAPE?
	JRST	ASC5			;YES. EACH 8-BIT BYTE IS 2 4-BIT BYTES
ASC3:	ILDB	CH,FROM			;NO. GET A BYTE
	PUTBYT				;OUTPUT IT
	SOJG	REC,ASC3		;COUNT BYTES PER LOGICAL RECORD
	JRST	CRLF

ASC5:	ILDB	T1,FROM			;GET HIGH 4 BITS
	ILDB	CH,FROM			;GET LOW 4 BITS
	DPB	T1,[POINT 3,CH,31]	;COMBINE INTO 7-BIT ASCII CHARACTER
	PUTBYT
	SOJG	REC,ASC5		;COUNT BYTES PER LOGICAL RECORD
	JRST	CRLF

ASC4:	TRNE	SW,SIX			;SIXBIT?
	JRST	SIXB			;SLIGHTLY DIFFERENT PROCESS
	TRNE	SW,MT7			;7-TRACK INPUT TAPE?
	JRST	ASC6			;PICK UP BYTES DIFFERENTLY
ASC2:	ILDB	CH,FROM			;PICK UP ONE BYTE
	ANDI	CH,177			;TRIM OFF 8TH BIT
	CAILE	CH," "			;TEST FOR ASCII BLANK OR CONTROL CHARACTER
	MOVEM	FROM,RIGHT		;SAVE POINTER TO LAST-NON-BLANK BYTE
	SOJG	REC,ASC2		;COUNT CARACTERS PER RECORD
	TRNE	SW,SEQ			;DELETING SEQUENCE NUMBERS?
	PUSHJ	P,SKPEND		;SKIP TO END OF LOGICAL RECORD
	CAMN	LEFT,RIGHT		;TEST FOR COMPLETELY BLANK LINE
	JRST	CRLF
ASC1:	ILDB	CH,LEFT			;TRANSLATE AND OUTPUT
	PUTBYT
	CAME	LEFT,RIGHT		;STOP AFTER LAST NON-BLANK CHARACTER
	JRST	ASC1
	JRST	CRLF

ASC6:	ILDB	T1,FROM			;GET HIGH 4 BITS
	ILDB	CH,FROM			;GET LOW 4 BITS
	DPB	T1,[POINT 3,CH,31]	;COMBINE INTO ONE 7-BIT ASCII CHARACTER
	CAILE	CH," "			;TEST FOR ASCII BLANK OR CONTROL CHARACTER
	MOVEM	FROM,RIGHT		;SAVE POINTER TO LAST-NON-BLANK BYTE
	SOJG	REC,ASC6		;COUNT CARACTERS PER RECORD
	TRNE	SW,SEQ			;DELETING SEQUENCE NUMBERS?
	PUSHJ	P,SKPEND		;SKIP TO END OF LOGICAL RECORD
	CAMN	LEFT,RIGHT		;TEST FOR COMPLETELY BLANK LINE
	JRST	CRLF
ASC7:	ILDB	T1,LEFT			;GET HIGH 4 BITS
	ILDB	CH,LEFT			;GET LOW 4 BITS
	DPB	T1,[POINT 3,CH,31]	;COMBINE INTO ONE 7-BIT ASCII CHARACTER
	PUTBYT
	CAME	LEFT,RIGHT		;STOP AFTER LAST NON-BLANK CHARACTER
	JRST	ASC7
	JRST	CRLF

SIXA:	ILDB	CH,FROM			;NO. GET A BYTE
	ADDI	CH,40			;CONVERT FROM SIXBIT TO 7-BIT
	PUTBYT				;OUTPUT IT
	SOJG	REC,SIXA		;COUNT BYTES PER LOGICAL RECORD
	JRST	CRLF

SIXB:	ILDB	CH,FROM			;PICK UP ONE BYTE
	SKIPE	CH			;TEST FOR SIXBIT BLANK (=0)
	MOVEM	FROM,RIGHT		;SAVE POINTER TO LAST-NON-BLANK BYTE
	SOJG	REC,SIXB		;COUNT CARACTERS PER RECORD
	TRNE	SW,SEQ			;DELETING SEQUENCE NUMBERS?
	PUSHJ	P,SKPEND		;SKIP TO END OF LOGICAL RECORD
	CAMN	LEFT,RIGHT		;TEST FOR COMPLETELY BLANK LINE
	JRST	CRLF
SIXB1:	ILDB	CH,LEFT			;TRANSLATE AND OUTPUT
	ADDI	CH,40			;CONVERT FROM SIXBIT TO 7-BIT
	PUTBYT
	CAME	LEFT,RIGHT		;STOP AFTER LAST NON-BLANK CHARACTER
	JRST	SIXB1
	JRST	CRLF

;SKIP TO END OF LOGICAL RECORD

SKPEND:	MOVE	REC,RECLEN		;COMPUTE HOW FAR TO SKIP
	SUB	REC,SEQ0
	IBP	FROM
	SOJG	REC,.-1
	POPJ	P,

;TYPE OUT SIXBIT HEADER RECORD

SIXHDR:	PUSHJ	P,READ			;READ FIRST RECORD
	MOVE	REC,LOC+.MTCCR		;GET BLOCK LENGTH
	MOVSI	FROM,(POINT 6)		;CONSTRUCT BYTE POINTER
	HRR	FROM,.JBFF
	OUTSTR	[ASCIZ/
/]
SHLOOP:	ILDB	CH,FROM
	ADDI	CH,40
	OUTCHR	CH
	SOJG	REC,SHLOOP
	OUTSTR	[ASCIZ/
/]
	POPJ	P,

;BCD TRANSLATION ROUTINE

BCD:	TRNE	SW,STS			;SUPPRESS TRAILING SPACES?
	JRST	BCD3			;YES
BCD4:	ILDB	CH,FROM			;NO. GET A BYTE
	HLRZ	CH,TABLE1(CH)		;CONVERT TO ASCII FROM BCD
	PUTBYT				;OUTPUT IT
	SOJG	REC,BCD4		;COUNT BYTES PER LOGICAL RECORD
	JRST	CRLF

BCD3:	ILDB	CH,FROM			;PICK UP ONE BYTE
	CAIE	CH,20			;TEST FOR BCD BLANK
	MOVEM	FROM,RIGHT		;SAVE POINTER TO LAST NON-BLANK BYTE
	SOJG	REC,BCD3		;COUNT CARACTERS PER RECORD
	TRNE	SW,SEQ			;DELETING SEQUENCE NUMBERS?
	PUSHJ	P,SKPEND		;SKIP TO END OF LOGICAL RECORD
	CAMN	LEFT,RIGHT		;TEST FOR COMPLETELY BLANK LINE
	JRST	CRLF
BCD1:	ILDB	CH,LEFT			;TRANSLATE AND OUTPUT
	HLRZ	CH,TABLE1(CH)		;TRANSLATE FROM BCD
	PUTBYT
	CAME	LEFT,RIGHT
	JRST	BCD1
	JRST	CRLF

;FIELDATA TRANSLATION ROUTINE

FLDATA:	TRNE	SW,STS			;SUPPRESS TRAILING SPACES?
	JRST	FLD3			;YES
FLD4:	ILDB	CH,FROM			;NO. GET A BYTE
	HLRZ	CH,TABLE2(CH)		;CONVERT TO ASCII FROM FIELDATA
	PUTBYT				;OUTPUT IT
	SOJG	REC,FLD4		;COUNT BYTES PER LOGICAL RECORD
	JRST	CRLF

FLD3:	ILDB	CH,FROM			;PICK UP ONE BYTE
	CAIE	CH,5			;TEST FOR FIELDATA BLANK
	MOVEM	FROM,RIGHT		;SAVE POINTER TO LAST NON-BLANK BYTE
	SOJG	REC,FLD3		;COUNT CARACTERS PER RECORD
	TRNE	SW,SEQ			;DELETING SEQUENCE NUMBERS?
	PUSHJ	P,SKPEND		;SKIP TO END OF LOGICAL RECORD
	CAMN	LEFT,RIGHT		;TEST FOR COMPLETELY BLANK LINE
	JRST	CRLF
FLD1:	ILDB	CH,LEFT			;TRANSLATE AND OUTPUT
	HLRZ	CH,TABLE2(CH)		;TRANSLATE FROM FIELDATA
	PUTBYT
	CAME	LEFT,RIGHT
	JRST	FLD1
	JRST	CRLF

;EBCDIC TRANSLATION ROUTINE

EBCDIC:	TRNE	SW,MT7			;7-TRACK INPUT TAPE?
	JRST	EBC4			;PICK UP BYTES DIFFERENTLY
	TRNE	SW,STS			;SUPPRESS TRAILING SPACES?
	JRST	EBC2			;YES
EBC3:	ILDB	CH,FROM			;NO. GET A BYTE
	HRRZ	CH,TABLE1(CH)		;CONVERT EBCDIC TO ASCII
	PUTBYT				;OUTPUT IT
	SOJG	REC,EBC3		;COUNT BYTES PER LOGICAL RECORD
	JRST	CRLF

EBC2:	ILDB	CH,FROM			;PICK UP ONE BYTE
	CAIE	CH,100			;TEST FOR EBCDIC BLANK
	MOVEM	FROM,RIGHT		;SAVE POINTER TO LAST NON-BLANK BYTE
	SOJG	REC,EBC2		;COUNT CARACTERS PER RECORD
	TRNE	SW,SEQ			;DELETING SEQUENCE NUMBERS?
	PUSHJ	P,SKPEND		;SKIP TO END OF LOGICAL RECORD
	CAMN	LEFT,RIGHT		;TEST FOR COMPLETELY BLANK LINE
	JRST	CRLF
EBC1:	ILDB	CH,LEFT			;TRANSLATE AND OUTPUT
	HRRZ	CH,TABLE1(CH)		;TRANSLATE FROM EBCDIC
	PUTBYT
	CAME	LEFT,RIGHT
	JRST	EBC1
	JRST	CRLF

EBC4:	TRNE	SW,STS			;SUPPRESS TRAILING SPACES?
	JRST	EBC6			;DIFFERENT CODE
EBC5:	ILDB	T1,FROM			;GET HIGH 4 BITS
	ILDB	CH,FROM			;GET LOW 4 BITS
	DPB	T1,[POINT 4,CH,31]	;COMBINE INTO ONE 8-BIT EBCDIC CHARACTER
	HRRZ	CH,TABLE1(CH)		;CONVERT EBCDIC TO ASCII
	PUTBYT
	SOJG	REC,EBC5
	JRST	CRLF

EBC6:	ILDB	T1,FROM			;GET HIGH 4 BITS
	ILDB	CH,FROM			;GET LOW 4 BITS
	DPB	T1,[POINT 4,CH,31]	;COMBINE INTO ONE 8-BIT EBCDIC CHARACTER
	CAIE	CH,100			;TEST FOR EBCDIC BLANK
	MOVEM	FROM,RIGHT		;SAVE POINTER TO LAST NON-BLANK BYTE
	SOJG	REC,EBC6		;COUNT CARACTERS PER RECORD
	TRNE	SW,SEQ			;DELETING SEQUENCE NUMBERS?
	PUSHJ	P,SKPEND		;SKIP TO END OF LOGICAL RECORD
	CAMN	LEFT,RIGHT		;TEST FOR COMPLETELY BLANK LINE
	JRST	CRLF
EBC7:	ILDB	T1,LEFT			;GET HIGH 4 BITS
	ILDB	CH,LEFT			;GET LOW 4 BITS
	DPB	T1,[POINT 4,CH,31]	;COMBINE INTO ONE 8-BIT EBCDIC CHARACTER
	HRRZ	CH,TABLE1(CH)		;TRANSLATE FROM EBCDIC
	PUTBYT
	CAME	LEFT,RIGHT
	JRST	EBC7
	JRST	CRLF

;VARIABLE LENGTH EBCDIC

VEBCDC:	LDB	BLK,[POINT 16,(FROM),15];GET NUMBER OF BYTES IN THE BLOCK
	CAMLE	BLK,LOC+.MTCCR		;CHECK VS. MONITOR COUNT
	OUTSTR	[ASCIZ/
? Variable EBCDIC blocksize inconsistency.
/]
	SUBI	BLK,4			;COUNT INCLUDES 4 BYTES OF COUNT WORD ITSELF
	TRNE	SW,MT7			;7-TRACK TAPE?
	JRST	V3			;DIFFERENT CAN OF WORMS

;9-TRACK VARIABLE EBCDIC

	ADDI	FROM,1
V1:	ILDB	T1,FROM			;GET RECORD LENGTH
	ILDB	REC,FROM		;IN  STAGES
	DPB	T1,[POINT 8,REC,27]
	IBP	FROM			;SKIP OVER 2 BYTES
	IBP	FROM
	SUB	BLK,REC			;COUNT DOWN BLOCK SIZE
	SUBI	REC,4			;INCLUDES COUNT WORD ITSELF

V2:	ILDB	CH,FROM			;GET EBCDIC CHARACTER
	HRRZ	CH,TABLE1(CH)		;TRANSLATE TO ASCII
	PUTBYT				;OUTPUT IT
	SOJG	REC,V2			;COUNT BYTES/REC
V5:	AOS	RECS			;COUNT RECORDS
	MOVEI	CH,15			;CARRIAGE RETURN
	PUTBYT
	MOVEI	CH,12			;LINE FEED
	PUTBYT
	JUMPG	BLK,V1			;NEXT LOGICAL RECORD?
	JRST	PROCES			;NEXT BLOCK

;7-TRACK VARIABLE EBCDIC

V3:	MOVEI	T1,^D8			;SKIP OVER BLOCKSIZE
	IBP	FROM
	SOJG	T1,.-1
	MOVE	PNT,[POINT 4,BLK]
	MOVE	T1,4
	ILDB	T2,FROM			;GET LOGICAL RECORD LENGTH
	IDPB	T2,PNT
	SOJG	T1,.-2
	MOVEI	T1,4
	IBP	FROM			;SKIP OVER 4 BYTES
	SOJG	T1,.-1
	SUB	BLK,REC			;COUNT DOWN BLOCK SIZE
	SUBI	REC,4			;COUNT INCLUDES COUNT ITSELF

V4:	ILDB	T1,FROM			;PICK UP EBCDIC CHARACTER
	ILDB	CH,FROM			;IN STAGES
	DPB	T1,[POINT 4,CH,31]
	HRRZ	CH,TABLE1(CH)		;TRANSLATE TO ASCII
	PUTBYT
	SOJG	REC,V4			;COUNT BYTES/REC
	JRST	V5

;IMAGE MODE COPY WITHOUT TRANSLATION

IMAGE:	MOVE	LEFT,LOC+.MTCCR
	IDIV	LEFT,BPERW
	SKIPE	RIGHT
	AOJ	LEFT,
IMAGE1:	ILDB	CH,FROM
	TRNN	STATUS,MT.7TR		;TEST FOR 7-TRACK TAPE
	ASH	CH,-4			;IF 9-TRK, SHIFT RIGHT AND EXTEND SIGN
	PUTBYT
	SOJG	LEFT,IMAGE1
	JRST	ENDREC

;PDP11 BYTE SWAPPING BINARY COPY

PDP11:	MOVE	LEFT,LOC+.MTCCR
	IDIV	LEFT,BPERW
	SKIPE	RIGHT
	AOJ	LEFT,
PDP11A:	SETZ	CH,
	ILDB	T1,FROM			;PICK UP LEFT BYTE
	DPB	T1,[POINT 8,CH,15]	;1ST BYTE BECOMES 2ND
	ILDB	T1,FROM			;PICK UP RIGHT BYTE
	DPB	T1,[POINT 8,CH,7]	;2ND BYTE BECOMES 1ST
	ASH	CH,-^D20		;EXTEND SIGN TO 36 BIT WORD
	PUTBYT
	SOJG	LEFT,PDP11A		;LOOP
ENDREC:	AOS	RECS			;COUNT LOGICAL RECORD (=BLOCK)
	JRST	PROCESS

	SUBTTL	PROCESS RSX-11 FILES-11 TAPES

RSX11A:	TRO	SW,LBL			;PROCESSING TAPE LABELS
	PUSHJ	P,READ			;READ A BLOCK
	MOVSI	FROM,(POINT 8)		;BUILD A BYTE POINTER
	HRR	FROM,.JBFF
	MOVE	PNT,[POINT 7,BITS]	;EXAMINE 4 BYTES
	MOVEI	T1,4
RSX11B:	ILDB	CH,FROM
	IDPB	CH,PNT
	SOJG	T1,RSX11B
	LSH	BITS,-^D8
	CAMN	BITS,["VOL1"]
	JRST	RSX11V			;DISPLAY VOLUME LABEL
	CAMN	BITS,["HDR1"]
	JRST	RSX11H			;PROCESS HDR1 LABEL
	CAMN	BITS,["HDR2"]
	JRST	RSX11D			;PROCESS HDR2 LABEL
	CAMN	BITS,["EOF1"]
	JRST	RSX11Z			;PROCESS EOF LABEL
BAD:	OUTSTR	[ASCIZ/
? Bad record on tape (or bug in TAPIN).
/]
	EXIT

RSX11V:	PUSHJ	P,DISPLA		;DISPLAY VOLUME LABEL
	JRST	RSX11A			;GO LOOK AT THE NEXT BLOCK

RSX11H:	EXCH	FROM,TINP+1		;FUDGE SIXIN TO LOOK AT OUR DATA
	MOVE	PNT,[POINT 6,OUTNAM]	;TELL IT WHERE TO PUT THE FILE NAME
	PUSHJ	P,SIXIN			;CONVERT TO SIXBIT
	MOVE	PNT,[POINT 6,OUTNAM+1]
	PUSHJ	P,SIXIN			;EXTENSION, TOO
	EXCH	FROM,TINP+1		;UN-FUDGE SIXIN
	MOVSI	FROM,(POINT 8)		;RESTORE FROM
	HRR	FROM,.JBFF		;TO BEGINNING OF BUFFER
	PUSHJ	P,DISPLA		;AND DISPLAY THE LABEL
	SETZM	FORMAT#
	JRST	RSX11A			;NOW GO LOOK FOR HDR2, IF ANY

RSX11D:	PUSHJ	P,DISPLA		;DISPLAY HDR2 RECORD
	LDB	CH,[POINT 7,@.JBFF,34]	;EXAMINE FORMAT TYPE
	MOVEM	CH,FORMAT#		;SAVE FOR LATER
	MTSKF.	INN,			;SKIP OVER THE END OF FILE
	JRST	RSX11N

RSX11Z:	MTSKF.	INN,			;SKIP OVER EOF
	TRO	SW,EOF			;MTSKF. GOES TO EOF
	PUSHJ	P,DISPLA		;DISPLAY EOF LABEL
	JRST	OPNOUT

RSX11E:	TRZN	SW,LBL			;HERE ON END OF FILE
	JRST	RSX11A			;SHOULD BE EOF1 LABEL NEXT
RSX11N:	OUTSTR	[ASCIZ"
Copy? (Y/N): "]
	PUSHJ	P,TTYIN
	CAIN	CH,"Y"
	JRST	RSX11C			;COPY THE FILE IF HE WANTS IT
	MTSKF.	INN,			;ELSE SKIP IT
	TRO	SW,EOF			;MTSKF. GOES TO EOF
	JRST	RSX11A

RSX11C:	TRZ	SW,LBL
	SETZM	BLKNO
	TRNE	SW,MAG			;IS IT A MAGTAPE?
	MTBSF.	OUT,			;YES. ELIMINATE EXTRA EOF
	ENTER	OUT,OUTNAM
	  JRST	[OUTSTR	[ASCIZ/
? ENTER failed.
/]
		EXIT]
	OUTPUT	OUT,			;DUMMY OUTPUT
	OUTSTR	[ASCIZ/
[Copying.]
/]
	MOVE	CH,FORMAT		;GET FORMAT FROM HDR2 RECORD
	CAIE	CH,"D"			;"D" IS VARIABLE-LENGTH RECORDS
	JRST	RSX11I			;OTHERWISE COPY IMAGE MODE
RSX11O:	PUSHJ	P,RSX11R		;READ A BLOCK
RSX11J:	MOVEI	CNT,4			;EXAMINE 4-DIGIT ASCII KEY
	SETZ	REC,			;CLEAR RECORD LENGTH INITIALLY
RSX11K:	ILDB	CH,FROM			;PICK UP THE NEXT CHARACTER
	SOJLE	BLK,RSX11O		;SEE IF THE BUFFER IS EMPTY
	CAIN	CH,"^"			;END-OF-BLOCK FILLER
	JRST	RSX11O			;START OVER
	SUBI	CH,60			;ASCII CONVERSION
	JUMPL	CH,BAD
	CAILE	CH,^D9
	JRST	BAD
	IMULI	REC,12			;DECIMAL CONVERSION
	ADD	REC,CH
	SOJG	CNT,RSX11K		;LOOP 4 TIMES
	SUBI	REC,4			;COUNT INCLUDES 4 DIGITS THEMSELVES
	JUMPLE	REC,RSX11L		;COUNT OF 4 MEANS BLANK LINE
RSX11M:	ILDB	CH,FROM			;GET ONE CHARACTER OF DATA
	SOSG	BLK			;SEE IF THE BUFFER IS EMPTY
	PUSHJ	P,RSX11R		;READ ONE CHARACTER
	PUTBYT
	SOJG	REC,RSX11M		;COUNT DOWN LOGICAL RECORD
RSX11L:	MOVEI	CH,15			;CARRIAGE RETURN
	PUTBYT
	MOVEI	CH,12			;LINE FEED
	PUTBYT
	AOS	RECS			;COUNT ONE LOGICAL RECORD
	JRST	RSX11J			;START NEXT LOGICAL RECORD

RSX11R:	PUSHJ	P,READ			;READ NEXT BLOCK
	MOVSI	FROM,(POINT 8)		;BUILD A BYTE POINTER
	HRR	FROM,.JBFF
	MOVE	BLK,LOC+.MTCCR		;GET BLOCK SIZE (IN BYTES)
	POPJ	P,

RSX11I:	MTSKF.	INN,			;SKIP OVER EOF
	HRLI	T1,(POINT 36)
	HLLM	T1,OBUF+1		;SET UP OUTPUT POINTER
	MOVE	T1,OBUF+2		; AND COUNTER
	IDIVI	T1,5
	MOVEM	T1,OBUF+2
RSX11F:	PUSHJ	P,READ
	AOS	RECS
	MOVSI	FROM,-200
	HRR	FROM,.JBFF
RSX11G:	MOVE	CH,(FROM)		;PICK UP ONE WORD
	PUTBYT
	AOBJN	FROM,RSX11G		;LOOP
	JRST	RSX11F

DISPLA:	MOVSI	FROM,(POINT 8)		;DISPLAY AN RSX-11 FILES-11 LABEL
	HRR	FROM,.JBFF
	MOVSI	PNT,(POINT 7)
	HRR	PNT,FROM
	MOVEM	PNT,LEFT
	MOVEI	T1,^D80
DISPL1:	ILDB	CH,FROM
	IDPB	CH,PNT
	CAIE	CH," "
	MOVEM	PNT,LEFT		;REMEMBER WHERE LAST NON-BLANK BYTE WAS
	SOJG	T1,DISPL1
	MOVEI	CH,15			;APPEND CARRIAGE RETURN,
	IDPB	CH,LEFT
	MOVEI	CH,12			; LINE FEED,
	IDPB	CH,LEFT
	MOVEI	CH,0			; AND NULL.
	IDPB	CH,LEFT
	OUTSTR	@.JBFF			;TYPE IT OUT
	POPJ	P,

	SUBTTL	SUBROUTINES
;INTERPRET MAGTAPE STATUS BITS

MTSTAT:	TESTAT	IO.IMP,IMPMSG
	TESTAT	IO.DER,DERMSG
	TESTAT	IO.DTE,DTEMSG
	TRNE	STATUS,IO.BKT		;BLOCK TOO LARGE. TRY MORE CORE.
	JRST	MORCOR
	TESTAT	IO.EOF,EOFMSG
	TESTAT	IO.ACT,ACTMSG
	TESTAT	IO.BOT,BOTMSG
	TESTAT	IO.EOT,EOTMSG
	TRNN	STATUS,IO.PAR	;TEST BIT
	OUTSTR	ODDMSG
	TRNE	STATUS,IO.PAR
	OUTSTR	EVNMSG
	TESTAT	IO.NRC,NRCMSG

	PUSHJ	P,BLKOUT
	OUTSTR	[ASCIZ/
/]
	POPJ	P,

IMPMSG:	ASCIZ	/
[Tried to write while write-locked, or other illegal operation.]/
DERMSG:	ASCIZ	/
[Data was missed, tape is bad, or transport is hung.]/
DTEMSG:	ASCIZ	/
[Parity error.]/
EOFMSG:	ASCIZ	/
[End of file.]/
ACTMSG:	ASCIZ	/
[Device was active.]/
BOTMSG:	ASCIZ	/
[Unit is at beginning of tape.]/
EOTMSG:	ASCIZ	/
[Unit is at end of tape.]/
EVNMSG:	ASCIZ	/
[Even parity is set.]/
ODDMSG:	ASCIZ	/
[Odd parity is set.]/
NRCMSG:	ASCIZ	/
[Automatic error correction is suppressed.]/

;GET A CHARACTER FROM THE TTY. IGNORE NULL, SPACE. CONVERT LC TO UC

TTYIN:	INPUT	TTY,
TTYIN1:	ILDB	CH,TINP+1		;GET THE CHARACTER
	JUMPE	CH,TTYIN1		;IGNORE NULL
	CAIN	CH," "			;TEST FOR SPACE
	JRST	TTYIN1			;IGNORE SPACE
	CAIL	CH,140			;TEST FOR LOWER CASE
	SUBI	CH,40			;CONVERT LOWER CASE TO UPPER CASE
	POPJ	P,

;GET MORE CORE AND TRY READING TAPE AGAIN

MORCOR:	MTBSR.	INN,			;BACKSPACE TAPE ONE BLOCK
	MOVE	T1,.JBREL
	ADDI	T1,2000
	CORE	T1,
	  JRST	[OUTSTR	[ASCIZ/
? Could not get enough core to read tape block.
/]
		EXIT]
	OUTSTR	[ASCIZ/
[/]
	MOVE	LEFT,.JBREL
	ADDI	LEFT,1001		;ALLOW FOR WORD 0 AND UPMP
	ASH	LEFT,-^D9
	PUSHJ	P,DECOUT		;TYPE OUT LOSEG SIZE
	OUTCHR	["+"]
	MOVEI	LEFT,HITOP
	TRZ	LEFT,400000
	ASH	LEFT,-^D9
	SKIPE	RIGHT
	AOJ	LEFT,			;ROUND UP
	PUSHJ	P,DECOUT		;TYPE OUT HISEG SIZE
	OUTSTR	[ASCIZ/P Core.]
/]
	JRST	READ

;INPUT FROM TTY AND CONVERT TO SIXBIT

SIXIN:	HRRZ	T1,PNT			;GET ADDRESS FROM POINTER
	SETZM	@T1			;CLEAR DESTINATION WORD INITIALLY
	MOVEI	T2,6			;MAX. 6 CHARACTERS IN DEVICE NAME
GET:	ILDB	T1,TINP+1		;PICK UP A LETTER
	CAILE	T1,140			;TEST FOR LOWER-CASE
	SUBI	T1,40			;IF SO, CONVERT TO UPPER-CASE
	CAIN	T1,":"			;QUIT ON COLON
	POPJ	P,
	CAIN	T1,"."			;TEST FOR PERIOD
	JRST	DOT			;IGNORE PERIOD IF FIRST CHARACTER
	SUBI	T1,40			;CONVERT TO SIXBIT
	JUMPLE	T1,GOT			;QUIT ON ANY CONTROL CHARACTER OR BLANK
	IDPB	T1,PNT			;PUT SIXBIT CHARACTER INTO DEVICE NAME
SKIP:	SOJG	T2,GET			;LOOP
GOT:	POPJ	P,

DOT:	CAIL	T2,6			;SEE IF IT WAS THE FIRST CHARACTER
	JRST	SKIP			;YES. IGNORE IT
	POPJ	P,			;NO. GO HOME

;CONVERT SIXBIT TO ASCII AND OUTPUT TO TTY

SIXOUT:	MOVEI	T2,6			;COUNT 6 CHARACTERS
	MOVE	PNT,[POINT 6,T1]	;GET A BYTE POINTER
SIXX:	ILDB	CH,PNT			;PICK UP A SIXBIT CHARACTER
	JUMPE	CH,CPOPJ		;QUIT ON ZERO
	ADDI	CH,40			;CONVERT TO ASCII
	OUTCHR	CH			;TYPE OUT ON THE TTY
	SOJG	T2,SIXX			;LOOP
CPOPJ:	POPJ	P,			;RETURN

;DECIMAL TYPOUT ROUTINE FROM SYSTEM REFERENCE MANUAL:

DECOUT:	IDIVI	LEFT,^D10		;DIVIDE BY 10
	HRLM	RIGHT,(P)		;SAVE REMAINDER
	SKIPE	LEFT			;ALL DIGITS FORMED?
	PUSHJ	P,DECOUT		;NO. CALL SELF RECURSIVELY

	HLRZ	LEFT,(P)		;YES. TAKE OUT IN OPPOSITE ORDER
	ADDI	LEFT,"0"		;CONVERT TO ASCII
	OUTCHR	LEFT			;TYPE OUT ONE DIGIT
	POPJ	P,

NOTMTA:	OUTSTR	[ASCIZ/
? NOT A MAGTAPE.
/]
	JRST	ASKIN

;INPUT A DECIMAL NUMBER FROM THE TTY INTO AC T1

DECIN:	SETZB	T1,DIGIT#		;CLEAR NUMBER AND DIGIT FLAG
	INPUT	TTY,			;READ A LINE FROM THE TTY
DIN1:	ILDB	CH,TINP+1		;READ A CHARACTER
	CAIN	CH,15
	POPJ	P,			;QUIT ON CARRIAGE RETURN
	SUBI	CH,"0"
	JUMPL	CH,NONDIG		;CHARACTER LESS THAN "0"
	CAILE	CH,^D9
	JRST	NONDIG			;CHARACTER GREATER THAN "9"
	IMULI	T1,^D10			;MULTIPLY WHAT YOU HAVE BY 10
	ADD	T1,CH			;ADD THE NEXT DIGIT
	JRST	DIN1			;LOOK FOR MORE

NONDIG:	SKIPN	DIGIT			;HAVE WE SEEN ANY DIGITS YET?
	JRST	DIN1			;NO. KEEP LOOKING.
	POPJ	P,			;YES. NOW ANY NON-NUMERIC IS A TERMINATOR

;TYPE OUT THE CURRENT BLOCK NUMBER

BLKOUT:	OUTSTR	[ASCIZ/
[Block number /]
	MOVE	LEFT,BLKNO
	AOS	LEFT
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ/]
/]
	POPJ	P,

	XLIST
	LIT
	LIST
HITOP==.-1		;HIGHEST ADDRESS IN HIGH SEGENT

	SUBTTL	LOW SEGMENT

;LOW SEGMENT:
	RELOC	0

;NON-ZEROED LOW CORE:

TTYBLK:	0
	SIXBIT/TTY/
	XWD TOUT,TINP
INNBLK:	OCT 17,0,0
OUTBLK:	0
	SIXBIT/DSK/
	XWD OBUF,0
LOCOUT:	EXP	OUT,0	;OUTPUT MTCHR. BLOCK

;ZEROED LOW CORE:

LOWZRO==.
DVSZBL:	BLOCK	3	;DEVSIZ BLOCK
OUTNAM:	BLOCK 4


LOC:	BLOCK	21
TINP:	BLOCK 3
TOUT:	BLOCK 3
OBUF:	BLOCK 3
STACK:	BLOCK PDLSIZ	;PUSHDOWN LIST
LOWTOP==.

	END START