Google
 

Trailing-Edge - PDP-10 Archives - tops10and20_integ_tools_v9_3-aug-86 - tools/tape11/tape11.mac
There are 3 other files named tape11.mac in the archive. Click here to see a list.
     	Title	Tape11 - Files-11 (ANSI) tape writer
	Subttl	Berk Shands @ EE for ASW

	search	monsym,macsym
	sall

comment &
	This program writes ANSI format tapes (Compatable with RFIL11)
for transportability to RSX-11, VAX/VMS, Tops-10/20 or just about any
nerdy system that supports ANSI tape labels. The default density is 1600 BPI.
See Appendix G rsx-11 i/o operations manual (aa-2515d-tc)&

	;note: does not require TM02 controller

	if2	<Printx	[TAPE11: Start of pass two]>
	subttl	Table of nitwits

;           Table of Contents for Labeled tape facility
;
;
;			   Section			      Page
;
;    1. Berk Shands @ EE for ASW . . . . . . . . . . . . . . .   1
;    2. Table of nitwits . . . . . . . . . . . . . . . . . . .   2
;    3. Revision history . . . . . . . . . . . . . . . . . . .   4
;    4. definitions  . . . . . . . . . . . . . . . . . . . . .   5
;    5. entry vector address . . . . . . . . . . . . . . . . .   6
;    6. label fields
;         6.1   Volume 1 . . . . . . . . . . . . . . . . . . .   7
;         6.2   Header 1 . . . . . . . . . . . . . . . . . . .   8
;         6.3   Header 2 . . . . . . . . . . . . . . . . . . .   9
;         6.4   Header 3 and beyond  . . . . . . . . . . . . .  10
;    7. macros . . . . . . . . . . . . . . . . . . . . . . . .  11
;    8. Command tables . . . . . . . . . . . . . . . . . . . .  12
;    9. starting address - entry vector  . . . . . . . . . . .  17
;   10. fix command errors . . . . . . . . . . . . . . . . . .  19
;   11. reparse and confirm  . . . . . . . . . . . . . . . . .  20
;   12. Parsing
;        12.1   Ascii character set (default)  . . . . . . . .  21
;        12.2   Blocksize of physical record . . . . . . . . .  22
;        12.3   DDT pull out the raid  . . . . . . . . . . . .  23
;        12.4   Density of output device . . . . . . . . . . .  24
;        12.5   Device for output  . . . . . . . . . . . . . .  25
;        12.6   EBCDIC character set (non-default) . . . . . .  26
;        12.7   EOT skip to end of tape  . . . . . . . . . . .  27
;        12.8   Exit to monitor  . . . . . . . . . . . . . . .  28
;        12.9   File list  . . . . . . . . . . . . . . . . . .  29
;        12.10  Format of tape data  . . . . . . . . . . . . .  30
;        12.11  Help the forgetful user  . . . . . . . . . . .  32
;        12.12  Headers to write tape with . . . . . . . . . .  33
;        12.13  Information on status of parameters  . . . . .  34
;        12.14  Labels on tape . . . . . . . . . . . . . . . .  35
;        12.15  Padding character  . . . . . . . . . . . . . .  36
;        12.16  Parity of data on tape . . . . . . . . . . . .  37
;        12.17  Push to new exec . . . . . . . . . . . . . . .  38
;        12.18  Record size (logical block)  . . . . . . . . .  39
;        12.19  Volume label . . . . . . . . . . . . . . . . .  40
;   13. Execution
;        13.1   Ascii character set  . . . . . . . . . . . . .  41
;        13.2   Blocksize physical record  . . . . . . . . . .  42
;        13.3   DDT enter debugerer  . . . . . . . . . . . . .  43
;        13.4   Density of output  . . . . . . . . . . . . . .  44
;        13.5   Device for output  . . . . . . . . . . . . . .  45
;        13.6   Ebcdic character set . . . . . . . . . . . . .  48
;        13.7   EOT tape skip  . . . . . . . . . . . . . . . .  49
;[ C o n t i n u e d  o n  n e x t  p a g e ]
;[ C o n t i n u e d  f r o m  l a s t  p a g e]
;        13.8   Exit to monitor  . . . . . . . . . . . . . . .  50
;        13.9   Format of written data . . . . . . . . . . . .  51
;        13.10  Help the user  . . . . . . . . . . . . . . . .  52
;        13.11  Headers set header counts  . . . . . . . . . .  53
;        13.12  Information on status  . . . . . . . . . . . .  54
;        13.13  Labels on tape . . . . . . . . . . . . . . . .  57
;        13.14  Padding character  . . . . . . . . . . . . . .  58
;        13.15  Parity of tape . . . . . . . . . . . . . . . .  59
;        13.16  Push to new exec . . . . . . . . . . . . . . .  60
;        13.17  Record size (logical block length) . . . . . .  62
;        13.18  Volume labels  . . . . . . . . . . . . . . . .  63
;        13.19  File processing  . . . . . . . . . . . . . . .  64
;   14. Subroutines
;        14.1   maknam make file name into string  . . . . . .  67
;        14.2   Pfile process file data  . . . . . . . . . . .  70
;        14.3   PFILE - pfflr fixed len records  . . . . . . .  72
;        14.4   PFILE - pfuft image mode (N bit) . . . . . . .  75
;        14.5   PFILE - pfvlr variable length records  . . . .  77
;        14.6   mtaerr recover from tape errors  . . . . . . .  80
;        14.7   wrteof/wrtbot  . . . . . . . . . . . . . . . .  83
;        14.8   filbot/fileot  . . . . . . . . . . . . . . . .  84
;        14.9   filxhd write extra HDR labels  . . . . . . . .  87
;        14.10  opnmta open magtape device . . . . . . . . . .  88
;        14.11  cvtebc convert string to EBCDIC  . . . . . . .  89
;        14.12  Ascii to Ebcdic translation table  . . . . . .  90
;   15. Fatal errors here  . . . . . . . . . . . . . . . . . .  91
;   16. literals . . . . . . . . . . . . . . . . . . . . . . .  92
;   17. impure storage . . . . . . . . . . . . . . . . . . . .  93
	subttl	Revision history

	vmajor==	1
	vminor==	0
	vedit==		3		;21-nov-83
	vwho==		5		;efbs 31-oct-82

;[1]	New to support the 11 and IBM community
;[2]	13-jul-83 add HDR3 to HDRn support
;	since rsx11 (4.0) uses funny headers
;[3]	Zero length files ruin rsx11 tapes. check for null size
;	on the tape first
;
;[***]	end of revision history
	subttl	definitions

	f==	0			;flag register
	t1==	1			;jsys 1
	t2==	2			;jsys 2
	t3==	3			;jsys 3
	t4==	4			;jsys and string
	t5==	5			;string
	t6==	6			;string
	a==	10			;preserved acs
	b==	11
	c==	12
	d==	13
	e==	14
	p==	17			;the stack as usual
	pdlen==	200			;size of stack
	MAXNUM==^d32768		 	;biggest block size
	MINNUM==^d8 			;one card block
	MAXWRD== MAXNUM/4		;8 bit bytes/buffer in words
	dftpad== "^"			;DEC's padding character
	DDTSTR== 770000			;ddt's start address
	kno==	-1			;symbol for NO
	kyes==	0			;symbol for YES
	minhdr==2			;[2] min # headers
	maxhdr==9			;[2] max headers
	dfthdr==3			;[2] default headers to use

	;flags in f

	f.den==	1b0			;density was set
	f.vol==	1b1			;volume id was written
	f.blk==	1b2			;blocksize was set
	f.rec==	1b3			;recordsize was set
	f.dev==	1b4			;device is assigned
	f.vol1==1b5			;volume command given
	f.nul==	1b6			;output is nul device
	f.wvl==	1b7			;on file header write, add vol1 lbl
	f.ebc==	1b8			;convert all data to ebcdic on wrt
	f.eof==	1b9			;file EOF reached
	f.bin==	1b10			;8 bit i/o if set
	f.nlb==	1b11			;don't write labels
	f.exe==	1b12			;exec is initialized
	subttl	entry vector address

	twoseg	400000
	reloc	400000			;[2] use dual segments
entvec::
	jrst	start
	jrst	start
	byte(3)vwho(9)vmajor(6)vminor(18)vedit

skpret::
rskp::
cpopj1::aos     (p)				;incr stack addr
cpopj::	popj	p,
	subttl	label fields -- Volume 1

vol1c:
	exp	"V","O","L","1"

	;Volume label id

	exp	"A","n","y","l","b","l"

	;accessibility

	exp	" "

	;reserved

	repeat	^d26,<exp " ">

	;owner field

	;protection

	exp	"D","%","K"	;tops20
	exp	" "," "," "," "	;access field

	;owner uic

 	exp 	" "," "," "," "," "," "		;system depenent
	exp	"1"

	;reserved

	repeat	^d28,<exp " ">

	;label version

	exp	"1"
	subttl	Label fields -- Header 1

hdr1c:
	;label id

	exp	"H","D","R","1"

	;file name (17 characters)

	exp	"I","l","l","e","g","a","l",".","N","a","m","e"
	repeat	5,<exp " ">

	;file set id (copy of volume id label)

	repeat	6,<exp " ">

	;file section number (multi-volume file)

	exp	"0","0","0","1"

	;file sequence #

	exp	"0","0","0","1"

	;generation of file

	exp	"0","0","0","1"

	;generation version

	exp	"0","0"

	;creation date

	exp	" ","8","2","0","0","1"	;jan 01, 1982

	;expiration date

	exp	" ","0","0","0","0","0"	;No date set

	;accessibility

	exp	" "

	;block count

	exp	"0","0","0","0","0","0"

	;system code

	exp	"D","E","C","S","y","s","t","e","m","-","2","0"," "

	;reserved

	repeat	^d7,<exp " ">
	subttl	label fields -- Header 2

hdr2c:
	;label id

	exp	"H","D","R","2"

	;record format F,D,S,U

	exp	"D"

	;physical block length

	exp	"0","0","5","1","2"	;512. bytes/block

	;record length

	exp	"0","0","5","1","2"	;512. bytes/record

	;system dependent info (append the crlf) or (contains Crlf)

	repeat	^d35,<exp " ">

	;buffer offset

	exp	"0","0"

	;reserved

	repeat	^d28,<exp " ">
	subttl	label fields -- Header 3 and beyond

hdr3c:
	exp	"H","D","R","3",
	exp	"0","0","0","0","0","2","0","2"
	repeat	^d11,<exp "0">
	exp	"1",
	repeat	^d44,<exp "0">
	repeat	^d12,<exp " ">			;reserved fields
	subttl	macros

	define	nd(a,b),<
	ifndef	a,<a=b>
	>;end nd macro

	define	$table(addr,flags,text),<
	;;addr if not defined, is set to cpopj
	;;flags are comnd jsys flags (cm%inv)
	;;text is text of command name
	if2 <
	ND	addr,cpopj
	>;;end if2
	[cm%fw!flags
	asciz/text/],,addr>;end $table
	define	$tible(addr,flags,text),<
	;;addr  is a constant or a literal
	;;flags are comnd jsys flags (cm%inv)
	;;text is text of command name
	[cm%fw!flags
	asciz/text/],,addr>;end $table

	define	gword(text),<
	xlist
	<.cmnoi>b8
	point	7,[asciz/text/]
	list
	>;end gword

	define	ehalt(text),<
	ercal	[tmsg <?'text
>
		jrst fatal]
	>;end ehalt

	define	jhalt(text),<
	call	[tmsg	<?'text
>
		jrst	fatal]
	>;end jhalt

	define	etype(text),<
	ercal	[push p,t1		;;save the ac
		tmsg	<%'text
>
		call	lsterr		;;type last error
		pop	p,t1		;;restore ac
		RET]			;;return from macro
	>;end etype

	define	text(arg) <
	xlist
	asciz/arg/
	list
>;end text
	subttl	Command tables

cmnd:
	cm%rai!rparse  			;addr of reparse
	.priin,,.priou			;in and out jfns
	point	7,[asciz/T11>/]
	point	7,bigbuf		;text buffer
	point	7,bigbuf		;parsed pointer
	200*5				;bytes in buffer
	z
	point	7,atom
	30*5				;bytes in atom
	jfnblk				;jfn long form addr

jfnb:					;dummy jfn long form block
	gj%ifg!.gjall			;use all generations
	.priin,,.priou			;jfns to use
	z				;use connected directory
	z				;and structure
	point	7,[asciz/*/]		;all file names
	point	7,[asciz/*/]		;all file types
	z				;no protection
	z				;accounts dont matter
	z				;no special jfn
	z				;no special argument block

cmdev:
	<.cmdev>b8!cm%hpp!cm%dpp!confrm	;parse a device
	z				;no data
	point	7,[asciz/Tape drive that output is to be done on/]
	point	7,[asciz/Mta0:/]
	z				;no break mask

cmvol:
	<.cmtxt>b8!cm%hpp!cm%dpp!confrm	;parse the volume id
	z
	point	7,[asciz/Volume label to identify tape by/]
	point	7,[asciz/TAPE11/]
	z				;no break mask

cmfil:
	<.cmfil>b8!cm%hpp!cm%dpp!confrm	;parse file list
	z
	point	7,[asciz/File to be written to tape/]
	point	7,[asciz/*.*.*/]	;default name
	z

cmfmt:
	<.cmkey>b8!cm%hpp!cm%dpp!confrm	;parse the format to write with
	exp	fmtkey			;data is format table
	point	7,[asciz/Format to write tape in/]
	point	7,[asciz/Default/]	;default is 512/512 compressed
	z
fmtkey:
	5,,5				;length of block
	$table	xbinr,,<Binary>
	$table	xdflt,,<Default>
	$table	xfxd,,<Fixed>
	$table	ximg,,<Image>
	$table	xvar,,<Variable>

cmcmd:
	<.cmkey>b8!cm%hpp!confrm	;parse a regular command
	cmdkey
	point	7,[asciz/Directive for TAPE11/]
	z
	z

cmdkey:
	cmk1,,cmk1			;size of table
	$table	xasc,,<Ascii>
	$table	xblk,,<Blocksize>
	$table	xddt,cm%inv,<DDt>
	$table	xden,,<Density>
	$table	xebc,,<Ebcdic>
	$table	xeot,,<Eot>
	$table	xexit,,<Exit>
	$table	xfile,,<File>
	$table	xfmt,,<Format>
	$table	xhdrs,,<Headers>
	$table	xhelp,,<Help>
	$table	xinfo,,<Information>
	$table	xlab,,<Labels>
	$table	xpad,,<Padding>
	$table	xpar,,<Parity>
	$table	xpush,,<Push>
	$table	xrec,,<Recordsize>
	$table	xdev,,<Tape>
	$table	xvol,,<Volume>
	cmk1==.-cmdkey-1
confrm:
	<.cmcfm>b8
	z
	z
	z

cmini:
	<.cmini>b8
	z
	z
	z
parkey:
	3,,3
	$tible	.sjpre,cm%inv,<Bad-parity>
	$tible	.sjpre,,<Even-parity>
	$tible	.sjpro,,<Odd-parity>

cmprty:
	<.cmkey>b8!cm%hpp!cm%dpp!confrm
	exp	parkey
	point	7,[asciz/Setting of 9th bit on tape, normally ODD/]
	point	7,[asciz/Odd-parity/]
	z

cmden:
	<.cmkey>b8!cm%hpp!cm%dpp!confrm	;parse the density keywords
	denkey
	point	7,[asciz/
Bits per inch to write the tape with. This command may only be given
once for each tape to be written./]
	point	7,[asciz/Default/]
	z				;no break mask

denkey:
	6,,6
	$tible  .sjd16,,<1600>
	$tible	.sjdn2,,<200>
	$tible	.sjdn5,,<556>
	$tible	.sjd62,,<6250>
	$tible	.sjdn8,,<800>
	$tible	.sjddn,,<Default>

cmnumd:
	<.cmnux>b8!cm%hpp!cm%dpp!confrm	;decimal number parse
	exp	^d10
	point	7,[asciz/Count of bytes to use/]
	point	7,[asciz/512/]
	z

cmnumo:
	<.cmnux>b8!cm%hpp!cm%dpp!confrm	;octal input (pad character)
	exp	^d8			;octal input
	point	7,[asciz/
Octal value of pad character to use if blocksize is not a multiple
of the recordsize. Useful only for the FIXED format./]
	point	7,[asciz/136/]		;padd with "^"
	z
cmlab:
	<.cmkey>b8!cm%hpp!cm%dpp!confrm	;label status
	exp	labkey			;two word table
	point	7,[asciz/Labels are required for ANSI
standard tapes. This option is provided to remove them if desired.
"YES" will write the labels (default). "NO" inhibits labels.
/]
	point	7,[asciz/Yes/]
	z

labkey:
	2,,2
	$tible	kno,,<No>
	$tible	kyes,,<Yes>

hdruno:
	<.cmnux>b8!cm%hpp!cm%dpp!confrm	;number input
	exp	^d10			;decimal
	point	7,[asciz/Number of HDR records in label 2 to 9/]
	point	7,[asciz/3/]		;[2] default dfthdr
	z
gwblk:
	GWORD	<In decimal bytes>

gwden:
	GWORD	<In BPI>

gwdev:
	GWORD	<For output>
gwexi:
	GWORD	<To monitor>
gwfil:
	GWORD	<To write on tape>
gwfor:
	GWORD	<Of written data>
gwpad:
	GWORD	<Character in octal>
gwrec:
	GWORD	<In decimal bytes>
gwvol:
	GWORD	<Label>
gwdef:
	GWORD	<To previous setting>
gwfix:
	GWORD	<Length records>
gwimg:
	GWORD	<No translation>
gwvar:
	GWORD	<Length records>
gweot:
	GWORD	<Postion tape at EOT>
gwasc:
	GWORD	<Character set>
gwebc:
	GWORD	<Character set>
gwddt:
	GWORD	<Bug repellent>
gwhel:
	GWORD	<For TAPE11>
gwinf:
	GWORD	<On current settings>
gwpar:
	GWORD	<Of data on tape>
gwlab:
	GWORD	<On tape>
gwpus:
	GWORD	<To new EXEC>
gwhdr:
	GWORD	<Contained in label field>
	subttl	starting address - entry vector

start:
	RESET%					;clear the world
	move	p,[iowd pdlen,pdlst]		;set up the regular stack
	tmsg	<
Tape11 ANSI Substandard tape writer Version 1(3) 26-Jan-84
>
	setz	f,				;clear all flags

	;clear memory

	move	t1,[.lowa,,.lowa+1]		;blt word for clearing
	setzm	.lowa				;clear first word
	blt	t1,.higha			;to last word

	;set up defaults

	movx	t1,.sjddn			;default density
	movem	t1,dens				;save density
	movei	t1,^d512			;default record size
	movem	t1,recl				;set record len
	movem	t1,pblk				;and blocksize
	move	t1,["U",,"M"]			;set up default format
	movem	t1,fmt				;save format
	movei	t1,dftpad			;get default pad char
	movem	t1,pad				;save character
	move	t1,[byte (8)dftpad,dftpad,dftpad,dftpad]
	movem	t1,padwrd			;save 4 of them
	movx	t1,dfthdr			;[2] set up counts
	movem	t1,numhdr			;[2] save count

	;here after successful command

top:
	dmove	t1,[bigbuf,,bigbuf+1		;clear text buffer
		    atom,,atom+1]		;and clear atom too
	setzm	bigbuf				;start clear
	blt	t1,bigbuf+177			;clear to end
	setzm	atom				;clear atom
	blt	t2,atom+27			;to the end

	;copy read only tables down

	move	t1,[cmnd,,comand]		;set up comand state block
	blt	t1,comand+.cmgjb		;move to writable store
	;here to reparse after error

top1:
	movei	t1,comand			;point to state block
	movei	t2,cmini			;reset system
	COMND%					;do the jsys
	 EHALT	<?Failed to INIT comand jsys>
	txne	t1,cm%nop			;total failure ?
	 JHALT	<?INIT function failed>

	;here for next keyword (after ^H)

top2:
	movei	t1,comand			;point to state block
	movei	t2,cmcmd			;and top of chain
	COMND%					;parse a command
	 EHALT	<?Failed to parse keyword>
	txne	t1,cm%nop			;failure ?
	 jrst	fixerr				;yes, analyse and report

	;dispatch the command

	movei	t3,(t3)				;isolate state word
	cain	t3,confrm			;lone confirm ?
	 jrst	top				;yes, ignore it
	hrrz	t2,(t2)				;get addr of next parse
	call	(t2)				;continue parsing
	 jrst	fixerr				;some form of parsing error
	call	(a)				;execute the function
	 jrst	fixerr				;error, type out string
	jrst	top				;done
	subttl	fix command errors

lsterr:
	push	p,t1				;save acs
	push	p,t2
	push	p,t3
	tmsg	<%Last error was: >
	hrloi	t2,.fhslf			;last error in this process
	movei	t1,.priou			;output to tty
	setz	t3,				;no limit
	ERSTR%					;type error string
	 ERJMP	.+1
	  ERJMP	.+1				;ignore error returns
	tmsg	<
>
	pop	p,t3
	pop	p,t2
	pop	p,t1				;restore acs
	RET					;return to caller

fixerr:
	call	lsterr				;type last error
	jrst	top1				;just do init
	subttl	reparse and confirm

rparse:
	skipe	t1,filjfn			;any jfn there ?
	 RLJFN%					;yes, bu no longer
	ETYPE	<Failed to release JFN on reparse>
	setzm	filjfn				;clear old stuff
	move	p,[iowd pdlen,pdlst]		;reset stack
	jrst	top2				;try again

firmup:
	movei	t1,comand			;comand block
	movei	t2,confrm			;confirm only
	COMND%					;ask user ok
	txne	t1,cm%nop			;given
	 RET					;no -  give ip
	RETSKP					;give good return
	subttl	Parsing -- Ascii character set (default)

xasc:
	movei	t1,comand			;point to state block
	movei	t2,gwasc			;and to (xxx)
	COMND%					;parse guide word
	txne	t1,cm%nop			;error ?
	 RET					;yes, lose
	movei	a,dasc				;dispatch to ascii
	jrst	firmup				;confirm it
	subttl	Parsing -- Blocksize of physical record

xblk:
	movei	t1,comand			;point to state block
	movei	t2,gwblk			;do guide word
	COMND%					;parse guideword
	txne	t1,cm%nop			;error ?
	 RET					;yes, turkey cant type

	;parse a decimal number for bytes per physical record

	movei	t1,comand			;reset to state block
	movei	t2,cmnumd			;decimal #
	COMND%					;parse it
	txne	t1,cm%nop			;error ?
	 RET					;yes, you lose

	;test number, MINNUM .le. X .le. MAXNUM

	caml	t2,[MINNUM]			;too small ?
	 camle	t2,[MAXNUM]			;too big ?
	  jrst	xblkne				;number error

	;save the number and confirm

	movem	t2,pblkt			;save temporary block size
	movei	a,dblk				;mark dispatch address
	jrst	firmup				;confirm request

	;here on error in number

xblkne:
	tmsg	<%Number is out of allowed range (8 - 32768)
>
	RET					;abort the request
	subttl	Parsing -- DDT pull out the raid

xddt:
	movei	t1,comand			;point to state block
	movei	t2,gwddt			;(bug spray)
	COMND%					;type guide word
	txne	t1,cm%nop			;error ?
	 RET					;you lose
	movei	a,dddt				;dispatch to ddt
	jrst	firmup				;confirm it
	subttl	Parsing -- Density of output device

xden:
	movei	t1,comand			;state block
	movei	t2,gwden			;guide word
	COMND%					;parse guide word
	txne	t1,cm%nop			;error ?
	 RET					;yes, return

	;look in table for density to set drive to

	movei	t1,comand			;state block
	movei	t2,cmden			;density lookup
	COMND%					;parse keywords
	txne	t1,cm%nop			;failed ?
	 RET					;yes, give up

	;save density (check it later)

	hrrz 	t2,(t2)				;get value
	movem	t2,denst			;save temporary
	movei	a,dden				;mark dispatch address
	jrst    firmup				;done
	subttl	Parsing -- Device for output

xdev:
	movei	t1,comand			;state block
	movei	t2,gwdev			;guide word
	COMND%					;parse it
	txne	t1,cm%nop			;error ?
	 RET					;yes, lose

	;parse the device name (mta0: or mtxxx)

	movei	t1,comand			;state block
	movei	t2,cmdev			;get the device
	COMND%					;parse the name
	txne	t1,cm%nop			;error ?
	 RET					;yes, lose

	;save the device id (6xxxxxx,,xxxxxx)

	movem	t2,devdt			;save temp
	movei	a,ddev				;set up dispatch address
	jrst    firmup				;and leave (for confirm)
	subttl	Parsing -- EBCDIC character set (non-default)

xebc:
	movei	t1,comand			;point to state block
	movei	t2,gwebc			;and to (xxx)
	COMND%					;parse guide word
	txne	t1,cm%nop			;error ?
	 RET					;yes, lose
	movei	a,debc				;dispatch to ebcdic
	jrst	firmup				;confirm it
	subttl	Parsing -- EOT skip to end of tape

xeot:
	movei	t1,comand			;state block
	movei	t2,gweot			;guide word
	COMND%					;parse guide word if any
	txne	t1,cm%nop			;error ?
	 RET					;yes, lose

	;confirm and dispatch

	movei	a,deot				;dispatch here
	jrst	firmup				;confirm it
	subttl	Parsing -- Exit to monitor

xexit:
	movei	t1,comand			;point to state block
	movei	t2,gwexi			;guide word
	COMND%					;parse it
	txne	t1,cm%nop			;error ?
	 RET					;yes, lose

	;hit the confirm

	movei	a,dexi				;dispatch to exit
	jrst	firmup				;confirm it
	subttl	Parsing -- File list

xfile:
	movei	t1,comand			;state block
	movei	t2,gwfil  			;guide words
	COMND%					;(or a wildcard)
	txne	t1,cm%nop			;error ?
	 RET					;lose

	;init the jfn arg block

	move	t1,[jfnb,,jfnblk]		;move it down
	blt	t1,jfnblk+.gjf2			;set up block

	;parse the file spec

	movei	t1,comand			;state block back
	movei	t2,cmfil			;parse the file
	COMND%					;or wildcard spec
	txne	t1,cm%nop			;error ?
	 RET					;they lose

	;save the jfn for later

	movem	t2,filjfn			;save it temp
	movei	a,dfile				;dispatch address
	jrst	firmup				;confirm it
	subttl	Parsing -- Format of tape data

xfmt:
	movei	t1,comand			;state block
	movei	t2,gwfor			;guide word
	COMND%					;parse guide word
	txne	t1,cm%nop			;error ?
	 RET					;yes, quit now

	;parse the keyword for the format to use

	movei	t1,comand			;state block
	movei	t2,cmfmt			;parse the keyword
	COMND%					;find it in table
	txne	t1,cm%nop			;couldnt ?
	 RET					;yes, give up

	;save the format and then confirm

	hrrz	t2,(t2)				;get next parse addr
	movei	a,dfmt				;dispatch addr
	jrst	(t2)				;continue parse later
	;more of format parsing

xdflt:
	movei	t2,gwdef			;guide word set up
	move	b,["F",," "]			;format word
	jrst	xfmt0				;continue

xfxd:
	movei	t2,gwfix			;guide word setup
	move	b,["F",," "]			;format word
	jrst	xfmt0				;continue

xbinr:
	setom	bit8				;set parse flag
	trna					;skip next one
ximg:
	setzm	bit8				;use 7 bits
	movei	t2,gwimg			;image guide word
	move	b,["U",,"M"]			;no format needed
	jrst	xfmt0				;continue

xvar:
	movei	t2,gwvar			;variable guide word
	move	b,["D",," "]			;variable
xfmt0:
	movei	t1,comand			;set up state block
	COMND%					;parse guide word
	txne	t1,cm%nop			;error ?
	 RET					;yes, lose
	movei	a,dfmt				;set up dispatch address
	movem	b,fmtt				;save format descriptor
	jrst	firmup				;go confirm command
	subttl	Parsing -- Help the forgetful user

xhelp:
	movei	t1,comand			;point to state block
	movei	t2,gwhel			;point to guide word
	COMND%					;parse it
	txne	t1,cm%nop			;error ?
	 RET					;yes, lose
	movei	a,dhelp				;dispatch to help
	jrst	firmup
	subttl	Parsing -- Headers to write tape with

xhdrs:
	movei	t1,comand			;point to state block
	movei	t2,gwhdr			;point to guide word
	COMND%					;parse it
	txne	t1,cm%nop			;error ?
	 RET					;yes, lose
	movei	t1,comand			;reset to block
	movei	t2,hdruno			;parse number of headers
	COMND%					;check it
	txne	t1,cm%nop			;error ?
	 RET					;[2] you lose
	cail	t2,minhdr			;[2] too small ?
	 caile	t2,maxhdr			;[2] too big?
	  jrst	xhdrs1				;[2] you lose idiot
	movem	t2,hdrnmt			;[2] save temp
	movei	a,dhdrs				;[2] dispatch addr
	jrst	firmup				;[2] continue
xhdrs1:
	tmsg	<?Number of headers is out of range 2 to 9
>
	RET					;[2] lose
	subttl	Parsing -- Information on status of parameters

xinfo:
	movei	t1,comand			;state block
	movei	t2,gwinf			;guide word
	COMND%					;parse guide word
	txne	t1,cm%nop			;error ?
	 RET					;yes, you lose
	movei	a,dinfo				;dispatch address to a
	jrst	firmup				;and continue
	subttl	Parsing -- Labels on tape

xlab:
	movei	t1,comand			;point to state block
	movei	t2,gwlab			;and to guide block
	COMND%					;parse it
	txne	t1,cm%nop			;error ?
	 RET					;yes, you lose

	;parse the answer

	movei	t1,comand			;state block again
	movei	t2,cmlab			;ask for label status
	COMND%					;which one ?
	txne	t1,cm%nop			;error ?
	 RET					;yes, you lose

	;get the answer back

	hrrz 	t2,(t2)				;get (-1,0)
	hrrem	t2,labtmp			;save label status
	movei	a,dlab				;set up dispatch address
	jrst	firmup				;and continue
	subttl	Parsing -- Padding character

xpad:
	movei	t1,comand			;command state block
	movei	t2,gwpad			;guide word for pad
	COMND%					;parse it if any there
	txne	t1,cm%nop			;failure ?
	 RET					;yes, cant type

	;parse the octal character

	movei	t1,comand			;state block
	movei	t2,cmnumo			;octal number input
	COMND%					;read number
	txne	t1,cm%nop			;error ?
	 RET					;yes, lose

	;save the number if it looks good

	cail	t2,0				;negative ?
	 caile	t2,377				;too big (parity allowed)
	  jrst	xpadbn				;bad number
	movem	t2,padt				;save pad character
	movei	a,dpad				;set execution address
	jrst	firmup				;and confirm it

	;here if number flunks

xpadbn:
	tmsg	<%Number is not an ASCII character
>
	RET
	subttl	Parsing -- Parity of data on tape

xpar:
	movei	t1,comand			;point to state block
	movei	t2,gwpar			;guide word for parity
	COMND%					;parse word
	txne	t1,cm%nop			;error ?
	 RET					;yes, die

	;parse the type of parity

	movei	t1,comand			;state block again
	movei	t2,cmprty			;parity block
	COMND%					;parse odd/even
	txne	t1,cm%nop			;error ?
	 RET					;yes, lose
	hrrz	t2,(t2)				;get setting
	movem	t2,party			;save it
	movei	a,dpar				;set dispatch addr
	jrst	firmup				;confirm it
	subttl	Parsing -- Push to new exec

xpush:
	movei	t1,comand			;state block
	movei	t2,gwpus			;guide word
	COMND%					;parse it
	txne	t1,cm%nop			;error ?
	 RET					;die if not right
	movei	a,dpush				;dispatch address
	jrst	firmup				;and confirm the request
	subttl	Parsing -- Record size (logical block)

xrec:
	movei	t1,comand			;state block
	movei	t2,gwrec			;guide word if escape
	COMND%					;parse it
	txne	t1,cm%nop			;error ?
	 RET					;yes, you lose

	;input the length of a logical record

	movei	t1,comand			;restore state block
	movei	t2,cmnumd			;decimal number
	COMND%					;read logical size
	txne	t1,cm%nop			;error ?
	 RET					;yes, lose

	;range check: must be in limits and smaller than phys limit

	caml	t2,[MINNUM]			;too small ?
	 camle	t2,[MAXNUM]			;too big ?
	  jrst	xrecbn				;bad number
	movem	t2,reclt			;save record length
	movei	a,drec				;dispatch to record addr
	jrst	firmup				;confirm it

	;here on number error

xrecbn:
	jrst	xblkne				;use error routine
	subttl	Parsing -- Volume label

xvol:
	movei	t1,comand			;state block
	movei	t2,gwvol			;guide word for this ftn
	COMND%					;parse it
	txne	t1,cm%nop			;error ?
	 RET					;yes, lose

	;parse the rest of the line (6 characters)

	movei	t1,comand			;return to state block
	movei	t2,cmvol			;get volume id
	COMND%					;read id
	txne	t1,cm%nop			;error ?
	 RET					;you lose

	;copy first 6 chars if any

	setzm	volx				;clear old if any
	setzm	volx+1				;and more too

	movei	t1,6				;count
	dmove	t2,[point 7,atom		;from
		    point 7,volx]		;get byte pointers
	ildb	t4,t2				;get byte from atom
	jumpe	t4,xvol1			;but stop on null
	idpb	t4,t3				;save byte
	sojg	t1,.-3				;loop for all 6

	;here after all 6

xvol1:
	movei	a,dvol				;set dispatch addr
	jrst	firmup				;and go confirm
	subttl	Execution -- Ascii character set

dasc:

	;volume labels defined yet ?

	txne	f,f.vol				;if labels written, forget it
	 jrst	dascvw				;volumes written
	txz	f,f.ebc				;clear ebc flag
	RETSKP					;done

	;here if labels applied

dascvw:
	tmsg	<%Labels written: can't change character set
>
	RET					;done
	subttl	Execution -- Blocksize physical record

dblk:
	;check to see if the logical record size is too big
	;if so, clear record length and require a new entry

	txo	f,f.blk				;blocksize was set
	move	t1,pblkt			;get phys length
	movem	t1,pblk				;set as current
	caml	t1,recl				;new size smaller ?
	 RETSKP					;no. still ok
	movem	t1,recl				;clear it

	;oops, better issue a message about that

	txz	f,f.rec				;clear record length flag
	tmsg	<%Recordsize exceeds Blocksize resetting recordsize
>
	RET					;and return to caller
	subttl	Execution -- DDT enter debugerer

dddt:
	;find ddt
	;look at x,,770000

	aos	(p)				;give skip return later
	move	t1,[.fhslf,,770]		;get ddt's page
	RMAP%					;is page there ?
	 ERJMP	.+1
	txne	t2,rm%pex			;page exist ?
	 jrst	DDTSTR				;yes, must be ddt

	tmsg	<% No DDT, try a fly swatter
>
	RET					;done
	subttl	Execution -- Density of output

dden:
	;density may only be given once per tape
	;tape command resets the flag (and unloads if needed)

	txoe	f,f.den				;set density yet ?
	 jrst	dden1				;yes. check more
dden0:
	move	t1,denst			;get density
	movem	t1,dens				;save it
	RETSKP					;done

	;here if the density was set already

dden1:
	txnn	f,f.vol				;done writing yet ?
	 jrst	dden0				;no, maybe density was wrong

	;issue error message

	tmsg	<%Volume labels written: can't change density
>
	RET					;give up
	subttl	Execution -- Device for output

ddev:

	;see if we have a device already if so, (and its different)
	;then dump current one (close if needed).
	;if device is the same, query about restarting

	txne	f,f.dev				;device selected yet ?
	 jrst	ddevgd				;got device already

	;no device, try to assign

ddev0:
	move	t1,devdt			;get designator
	ldb     t2,[point 6,t1,17]		;get device type
	cain	t2,.dvnul			;null device ?
	 jrst	[txo f,f.nul			;null device flag on
		 jrst ddev1]			;and skip next
        caie	t2,.dvmta			;or magtape ?
         jrst	ddevnm				;not a magtape
	txz	f,f.nul				;clear null flag now
        ASND%					;assign device
         ERJMP	ddevna				;not assigned

	;set flags and return

ddev1:
	txo	f,f.dev				;ok, got device
	move	t1,devdt			;get it back
	movem	t1,devd				;and save for later

	;now get jfn on device and set up for industry mode

	setzm	dxdev				;clear space holder
	setzm	dxdev+1				;and another word
	move	t2,t1				;get word from ac
	hrroi	t1,dxdev			;buffer area
	DEVST%					;convert to string
	 ETYPE	<Device designator would not convert to string>
	movei	t2,":"				;add the colon
	idpb	t2,t1				;save byte
	movx	t1,gj%sht!gj%fou		;short form gtjfn
	hrroi	t2,dxdev			;point to string
	GTJFN%					;get jfn
	 ETYPE	<Failed to assign a JFN to device>
	movem	t1,mtajfn			;save jfn for later
	;set mode to industry and density to current default

	movx	t2,8b5!17b9!of%wr       	;open drive for i/o
	OPENF%					;open
	 ERJMP	ddevco				;couldnt open
	move	t1,mtajfn			;restore jfn
	movx	t2,.mosdm			;set data mode function
	movx	t3,.sjdm8			;industry mode
	MTOPR%					;set mode
	 ETYPE	<Couldn't set industry mode for tape drive>
	move	t1,mtajfn			;restore jfn
	movx	t2,.mosdn			;set density
	move	t3,dens				;get density
	MTOPR%					;set density
	 ETYPE	<Couldn't set density in tape command>
	move	t1,mtajfn			;get jfn of tape
	movei	t2,.mospr			;set parity
	move	t3,parity			;get setting
	MTOPR%					;set parity
	 ETYPE	<Couldn't set parity in tape command>
	movx	t1,co%nrj			;do not give up jfn
	hrr	t1,mtajfn			;put jfn in rh
	CLOSF%					;dump device
	 ERJMP	.+1
	RETSKP					;done

	;here if device is not a magtape or null device

ddevnm:
	tmsg	<%Device is not a magtape
>
	RET					;error out

	;here if assign failed

ddevna:
	tmsg	<%Could not assign that device
>
	RET					;error out with message

	;here if device was assigned

ddevgd:
	move	t1,devd 			;get device id
	camn	t1,devdt			;assigning same device ?
	 jrst	ddevsd				;yes, take care of it
	;device is new, but we still have old device

	txze	f,f.vol				;written volume id yet ?
	 call	wrteof				;yes, write eof
	txz	f,f.dev!f.den			;clear device flag
	move	t1,mtajfn			;get old jfn
	RLJFN%					;dump jfn
	 ETYPE	<Failed to release JFN>
	move	t1,devd				;get old device id
	RELD%					;release old device
	 ETYPE	<Failed to deassign device>
	jrst	ddev0				;continue normally

	;here if same device

ddevsd:
	txze	f,f.vol				;written labels yet ?
	 call	wrteof				;yes, write close labels
	jrst	ddev1				;continue

	;here if open failed

ddevco:
	tmsg	<%Open failure on device
>
	call	lsterr				;give reason
	move	t1,mtajfn			;get jfn
	RLJFN%					;dump jfn
	 ERJMP	.+1
	move	t1,devd				;get designator
	RELD%					;and dump it too
	 ERJMP	.+1
	setzm	devd				;clear remainder
	setzm	mtajfn				;no jfn still
	txz	f,f.dev				;no device anymore
	RETSKP					;failure (no err rtn)
	subttl	Execution -- Ebcdic character set

debc:

	;volume labels defined yet ?

	txne	f,f.vol				;if labels written, forget it
	 jrst	dascvw				;volumes written
	txo	f,f.ebc				;set ebcdic flag
	RETSKP					;done
	subttl	Execution -- EOT tape skip

deot:
	;must have device specified

	txnn	f,f.dev				;device assigned ?
	 jrst	deotnd				;no, error out

	;openf the device and go for eot

	txoe	f,f.vol!f.vol1			;no need for label
	 jrst	deot2x				;but if done already...
	txne	f,f.nul				;nul device ?
	 RETSKP					;yes, ignore this

	;grab drive

	movei	b,^d512				;set big records
	call	opnmta				;and open the tape drive

	;now move to double tape mark

	move	t1,mtajfn			;put jfn back
	movx	t2,.moeot			;eot function
	setz	t3,				;clear just in case
	MTOPR%					;skip to eot
	 ETYPE	<Failed to hit EOT abort program NOW>
	movx	t1,co%nrj			;save jfn
	hrr	t1,mtajfn			;put jfn in rh
	CLOSF%					;close file
	 ETYPE	<Failed to save JFN on close>
	RETSKP					;ok.

	;here on no device

deotnd:
	tmsg	<%No tape specified
>
	RET					;die

	;here if done once (or more)

deot2x:
	tmsg	<%Volume ID set or tape at EOT
>
	RET
	subttl	Execution -- Exit to monitor

dexi:
	txze	f,f.vol				;volume labels written ?
	 call	wrteof				;yes, close out drive
	skipe	t1,mtajfn			;any open jfn ?
	 RLJFN%					;yes, close it
	  ETYPE	<Failed to release JFN of tape>
	move	t1,devd				;get device id
	txze	f,f.dev				;still assigned ?
	 RELD%					;yes, let go of it
	  ETYPE	<Failed to deassign device>
	HALTF%					;stop process
	tmsg	<[What if I don't want to?]
>
	RETSKP					;continue if needed
	subttl	Execution -- Format of written data

dfmt:
	txz	f,f.bin				;clear setting
	move	t1,fmtt				;get temp format
	movem	t1,fmt 				;save data format
	skipe	bit8				;use 8 bit ?
	 txo	f,f.bin				;yes, use 8 bit
	RETSKP					;done
	subttl	Execution -- Help the user

dhelp:
	hrroi	t1,hlpmsg			;point to text
	PSOUT%					;write it
	RETSKP					;and quit
hlpmsg:
	TEXT	<
Tape11 commands:
ASCII       Sets data mode to be ASCII characters (default)
BLOCKSIZE   Sets physical record length of data records (512. default)
DENSITY     Sets the bits per inch for writing (defaults to system)
EBCDIC	    Sets IBM compatable character set, affects labels too
EOT	    Positions tape after last file on tape (double tape mark)
EXIT	    Returns user to TOPS20 command level
FILE	    Specifies files to write to tape (defaults to *.*.*)
FORMAT	    Sets the type of logical record to be written (defaults to image)
HEADERS	    Sets the number of HDR records in tape labels
HELP	    Types this text
INFORMATION Lists status of current settings
LABELS	    Turns on or off the write labels flag (NO to inhibit labels)
PADDING	    Sets the ASCII character to be used to fill partial blocks
PARITY	    Sets the parity to use for output on tape (defaults to ODD)
PUSH        Gets and starts another EXEC. POP to return to TAPE11
RECORDSIZE  Sets the logical record length (defaults to 512. bytes)
TAPE	    Identifies the tape drive to use
VOLUME	    Sets the volume label
>
	subttl	Execution -- Headers set header counts

dhdrs:
	txne	f,f.vol				;[2] started labels yet?
	 jrst	dhdrs1				;[2] yes, you lose
	move	t1,hdrnmt			;get count
	movem	t1,numhdr			;[2] save count
	RETSKP					;[2] thats all
dhdrs1:
	tmsg	<%Volume labels written - can not change HDR count
>
	RET					;[2] you lose
	subttl	Execution -- Information on status

dinfo:
	tmsg	<Character set is: >
	hrroi	t1,[asciz/Ascii/]
	txne	f,f.ebc				;check ebc flag
	 hrroi	t1,[asciz/Ebcdic/]		;was ebcdic
	PSOUT%					;write it
	tmsg	<
Physical blocksize is: >
	movei	t1,.priou			;write to tty
	move	t2,pblk				;get blocksize
	movei	t3,^d10				;base 10
	NOUT%
	 ERJMP	.+1
	hrroi	t1,[asciz/ not set!/]		;see if user set it
	txnn	f,f.blk				;set blocksize ?
	 PSOUT%					;no, complain
	tmsg	<
Logical record size is: >
	movei	t1,.priou			;out to tty
	move	t2,recl				;get record length
	movei	t3,^d10				;base 10
	NOUT%					;type number
	 ERJMP	.+1
	hrroi	t1,[asciz/ not set!/]		;set yet ?
	txnn	f,f.rec				;check and see
	 PSOUT%					;no set, complain
	tmsg	<
Density is: >
	hrroi	t1,[asciz/Default/]		;assume the worst
	move	t2,dens				;get density
	cain	t2,.sjdn2			;200 bpi ?
	 hrroi	t1,[asciz/200/]			;yes
	cain	t2,.sjdn5			;556 ?
	 hrroi	t1,[asciz/556/]			;yes
	cain	t2,.sjdn8			;800 ?
	 hrroi	t1,[asciz/800/]			;yes
	cain	t2,.sjd16			;1600 PE ?
	 hrroi	t1,[asciz/1600/]		;yes
	cain	t2,.sjd62			;6250 ?
	 hrroi	t1,[asciz/6250/]		;yes
	PSOUT%					;type it
	tmsg	<
Format is: >
	move	t2,fmt				;get format
	hrroi	t1,[asciz/ERROR/]		;assume image
	camn	t2,["F",," "]			;fixed length ?
	 hrroi	t1,[asciz/Fixed length/]	;yes
	camn	t2,["U",,"M"]			;image ?
	 hrroi	t1,[asciz/Image/]		;yes
	camn	t2,["D",," "]			;variable length
	 hrroi	t1,[asciz/Variable - RSX11/]	;yes
	PSOUT%					;write it
	hrroi	t1,[asciz/ 8 bit binary/]	;for binary mode
	txne	f,f.bin				;using it ?
	 PSOUT%					;yes, say so
	tmsg	<
Parity is: >
	hrroi	t1,[asciz/Odd/]			;assume odd
	movei	t2,.sjpro			;test format
	came	t2,parity			;check parity
	 hrroi	t1,[asciz/Even/]		;other bad parity
	PSOUT%					;type it
	tmsg	<
Pad character is: >
	movei	t1,.priou			;out to tty
	move	t2,pad				;get it
	movei	t3,^d8 				;octal
	NOUT%					;write number
	 ERJMP	.+1
	tmsg	<
Number of HDR records in label field is: >
	movei	t1,.priou			;out to tty
	move	t2,numhdr			;get it
	movei	t3,^d10				;octal
	NOUT%					;write number
	 ERJMP	.+1
	hrroi	t1,[asciz/
No tape identified yet/]
	txnn	f,f.dev				;tape command given ?
	 PSOUT%					;no, inform user
	hrroi	t1,[asciz/
Tape output goes into the bit bucket!!/]
	txne	f,f.nul				;using bit bucket ?
	 PSOUT%					;yes, say so
	hrroi	t1,[asciz/
No volume label set yet/]
	txnn	f,f.vol1			;labels identified ?
	 PSOUT%					;no, complain
	hrroi	t1,[asciz/
Labels are written/]
	txne	f,f.vol				;labels applied ?
	 PSOUT%					;yes, say so
	tmsg	<
>
	hrroi	t1,[asciz/Tape label writing is inhibited!!!
/]
	txne	f,f.nlb				;labels being output ?
	 PSOUT%					;no, say so
	hrroi	t1,[asciz/EXEC is initialized
/]
	txne	f,f.exe				;exec started ?
	 PSOUT%					;yes, say so
	RETSKP					;done
	subttl	Execution -- Labels on tape

dlab:
	txne	f,f.vol				;lables applied ?
	 jrst	dlabla				;yes, too late
	txz	f,f.nlb				;assume cleared
	skipe	labtmp				;test for "NO" (0)
	 txo	f,f.nlb				;set flag
	RETSKP					;done

	;here if labels written

dlabla:
	tmsg	<% Tape output already in progress, can't change label status
>
	RET
	subttl	Execution -- Padding character

dpad:
	move	t1,padt				;get character
	movem	t1,pad				;save it
	move	t2,[point 8,padwrd]		;make 4 copies
	idpb	t1,t2				;save it
	idpb	t1,t2				;save it
	idpb	t1,t2				;save it
	idpb	t1,t2				;save it
	RETSKP					;done
	subttl	Execution -- Parity of tape

dpar:
	move	t1,party			;get parity id
	movem	t1,parity			;save it
	RETSKP					;done
	subttl	Execution -- Push to new exec

dpush:
	txoe	f,f.exe				;exec set up yet ?
	 jrst	dpushe				;yes, skip init code

	;find exec, and get it

	movx	t1,gj%sht!gj%old		;file must exist
	hrroi	t2,[asciz/ps:<system>exec.exe/]	;hard code name
	GTJFN%					;get a jfn
	 ERJMP	dpshnj				;you lose

	;create fork

	movem	t1,execjf			;save jfn
	movx	t1,cr%cap			;same privs
	setz	t2,				;no pc
	CFORK%					;create it
	 ERJMP	dpshnf				;no fork
	movem	t1,execfh			;save handle
	movss	t1				;swap handle
	hrr	t1,execjf			;add jfn (no flags)
	setz	t2,				;use all pages
	GET%					;get the program
	 ERJMP	dpshgf				;get failure

	;start wait and return

	hrrz	t1,execfh			;get fork handle back
	setz	t2,				;no offset
	SFRKV%					;start at entry vector
	 ETYPE	<Couldn't start EXEC>
	hrrz	t1,execfh			;recover handle
	WFORK%					;wait for it
	RETSKP					;done for now

	;here to continue

dpushe:
	movx	t1,sf%con			;continue exec
	hrr	t1,execfh			;get fork handle
	setz	t2,				;no pc, use old one
	SFORK%					;start over
	 ETYPE	<Couldn't continue EXEC>
	hrrz	t1,execfh			;get handle again
	WFORK%					;wait for it
	RETSKP					;and then return
	;here for gtjfn failure

dpshnj:
	tmsg	<? GTJFN failed for ps:<system>exec.exe
>
	txz	f,f.exe				;clear flag
	RET

	;here for cfork failure

dpshnf:
	move	t1,execjf			;dump jfn
	RLJFN%					;let go
	 ETYPE	<Failed to release EXEC JFN>
	tmsg	<? Couldn't create EXEC fork
>
	txz	f,f.exe				;clear flag
	RET

	;here for GET failure

dpshgf:
	tmsg	 <? Couldn't GET EXEC core image
>
	move	t1,execfh			;dump fork
	KFORK%					;lose the fork
	 ETYPE	<Couldn't kill EXEC fork>
	move	t1,execjf			;clean up
	RLJFN%					;dump jfn
	 ETYPE	<Failed to release EXEC JFN>
	txz	f,f.exe				;no exec
	RET					;and stop
	subttl	Execution -- Record size (logical block length)

drec:
	;see if block size set yet

	txnn	f,f.blk				;blocksize set ?
	 jrst	drecnb				;no blocksize

	;recordsize exceed blocksize ?

	move	t1,reclt			;get size specified
	camle	t1,pblk				;oversize ?
	 jrst	drecbb				;bad blocksize

	;good recordsize, check for modularity

	txo	f,f.rec				;recordsize given
	movem	t1,recl				;save it
	move	t2,pblk				;get blocksize
	idiv	t2,t1				;reduce and check
	skipn	t3				;remainder non-zero
	 RETSKP					;works ok

	;issue message about padding characters

	tmsg	<%Padding is needed to fill blocksize gap
>
	RETSKP					;still ok though

	;here if no blocksize set

drecnb:
	tmsg	<%Blocksize not set yet
>
	RET

	;here if recorsize exceeds blocksize

drecbb:
	tmsg	<%Recordsize exceeds blocksize
>
	RET
	subttl	Execution -- Volume labels

dvol:
	;see if labels written yet

	txne	f,f.vol				;writen labels yet ?
	 jrst	dvolvw				;yes, cant change

	;no label yet, copy the header VOL1 data down and insert
	;the label info

	movei	t1,1				;reset count
	movem	t1,seqnum			;for files on tape
	txo	f,f.vol1			;volume command given
	move	t1,[vol1c,,vol1]		;copy
	blt	t1,vol1+^d79			;into writable memory
        dmove   t1,[-6,,volid			;make aobjn pointer
		   point 7,volx]		;and byte pointer available
	ildb	t3,t2				;get a byte
	cain	t3,0				;null ?
	 movei	t3," "				;yes, substitute space
	movem	t3,(t1)				;save character
	aobjn	t1,.-4				;loop for more
dvol1:
	RETSKP					;done

	;here if labels written already

dvolvw:
	tmsg	<%Labels already written to tape, can't change Volume ID
>
	RET
	subttl	Execution -- File processing

dfile:
	;first things first, make sure all parameters are set up

	txnn	f,f.dev				;got a device ?
	 jrst	dfilnd				;no device
	txnn	f,f.blk				;blocksize ?
	 jrst	dfilnb				;no blocksize
	txnn	f,f.rec				;recordsize ?
	 jrst	dfilnr				;no recordsize
	txnn	f,f.vol1			;volume identified ?
	 jrst	dfilnv				;no volume
	hrroi	t1,[asciz/%Default density assumed
/]
	txnn	f,f.den				;density set ?
	 PSOUT%					;no, not fatal though
	jrst	dfil1				;continue processing

	;here on an error

dfilnd:
	tmsg	<%Tape not specified
>
	RET
dfilnb:
	tmsg	<%Blocksize not set
>
	RET
dfilnr:
	tmsg	<%Recordsize not set
>
	RET
dfilnv:
	tmsg	<%Volume ID not set
>
	RET
	;here to process tapes

dfil1:
	txon	f,f.vol				;labels applied yet ?
	 call	wrtbot				;no, do it first

	;initialize headers

dfiltp:
	dmove	t1,[hdr1c,,hdr1			;init low memory
		hdr2c,,hdr2]			;for both labels
	blt	t1,hdr1+^d79			;clear all
	blt	t2,hdr2+^d79			;labels

	;put in record junk

	call	maknam				;make the name fit
	hrroi	t1,numstr			;convert numbers
	setzm	(t1)				;clear scratch
	setzm	1(t1)				;area
	hrrz	t2,seqnum			;get number to write
	movx	t3,no%lfl!no%zro!4b17!^d10	;leading 0, base 10
	NOUT%					;write into scratch area
	 ERJMP	.+1				;no need for message
	dmove	t1,[-4,,filseq			;aobjn ptr
		point 7,numstr]			;and get byte ptr
	ildb	t3,t2				;get a byte
	movem	t3,(t1)				;save byte
	aobjn	t1,.-2				;loop for more

	;do same for phys block and logical block

	hrroi	t1,numstr			;convert numbers
	setzm	(t1)				;clear scratch
	setzm	1(t1)				;area
	hrrz	t2,pblk  			;get number to write
	movx	t3,no%lfl!no%zro!5b17!^d10	;leading 0, base 10
	NOUT%					;write into scratch area
	 ERJMP	.+1				;no need for message
	dmove	t1,[-5,,pblkx 			;aobjn ptr
		point 7,numstr]			;and get byte ptr
	ildb	t3,t2				;get a byte
	movem	t3,(t1)				;save byte
	aobjn	t1,.-2				;loop for more
	aos	seqnum				;incr seq number
	;do logical block size

	hrroi	t1,numstr			;convert numbers
	setzm	(t1)				;clear scratch
	setzm	1(t1)				;area
	hrrz	t2,recl  			;get number to write
	movx	t3,no%lfl!no%zro!5b17!^d10	;leading 0, base 10
	NOUT%					;write into scratch area
	 ERJMP	.+1				;no need for message
	dmove	t1,[-5,,lblk  			;aobjn ptr
		point 7,numstr]			;and get byte ptr
	ildb	t3,t2				;get a byte
	movem	t3,(t1)				;save byte
	aobjn	t1,.-2				;loop for more

	;copy volume id into hdr1

	dmove	t1,[-6,,volid			;aobjn ptr
		filset]				;output to file seq id
	move	t3,(t1)				;get a byte
	movem	t3,(t2)				;save the byte
	aos	t2				;incr ptr
	aobjn	t1,.-3				;loop for more

	;write the headers

	call	filbot				;write the file header
	call	pfile				;process data portion
	call	fileot				;process trailers

	;try for next file

	move	t1,filjfn			;get file jfn
	GNJFN%					;get next jfn
	 ERJMP	dfildn				;done!
	jrst	dfiltp				;do next file

	;clean up and leave

dfildn:
	tmsg	<[No more files in this specification]
>
	move	t1,filjfn			;get jfn
	CLOSF%					;dump file
	 ERJMP	.+1				;clear error if any
	setzm	filjfn				;and destroy old jfn
	RETSKP					;bye
	subttl	Subroutines -- maknam make file name into string

maknam:
	;process name, ext, gen and creation date

	tmsg	<[Working on: >
	movei	t1,.priou			;tell user the file name
	hrrz	t2,filjfn			;from current jfn
	move	t3,[111110,,js%paf]		;type full name
	setz	t4,				;no attribute
	JFNS%					;type file name
	 ETYPE	<Failed to type file name>

	;do individual parts of name

	dmove	t1,[" "				;char to clear with
		filnam,,filnam+1]		;get blt word
	movem	t1,filnam			;save blank
	blt	t2,filnam+^d16			;save name
	hrrz	t2,filjfn			;get file id for more work
	move	t1,[name,,name+1]		;clear name string
	setzm	name				;get force null
	blt	t1,years+2			;clean whole block
	hrroi	t1,name				;name first
	movx	t3,1b8				;name only
	JFNS%					;string out
	 ETYPE	<Failed to string name>
	hrroi	t1,ext				;ext next
	movx	t3,1b11				;type only
	JFNS%					;string it
	 ETYPE	<Failed to string type>
	hrroi	t1,gen				;generation next
	movx	t3,1b14				;gen only
	JFNS%					;string it
	 ETYPE	<Failed to string generation>

	;do creation  date

	hrrz	t1,filjfn			;get file jfn again
	move 	t2,[1,,.fbcrv]			;creation date
	movei	t3,cdate			;place to stick it
	GTFDB%					;get date
	 ETYPE	<Couldn't get creation date of file>
	setzb	t1,t3				;clear unused acs
	move	t2,cdate			;get creation date
	movx	t4,ic%jud			;use julian date
	ODCNV%					;convert to yy,ddd
	 ETYPE	<Illegal date from .fbcrv>
	push	p,t2				;save days (rh)
	hlrz	t2,t2				;get year
	idivi	t2,^d100			;make a two digit field
	move	t2,t3				;recover remainder
	hrroi	t1,years			;point to string area
	movx	t3,no%lfl!no%zro!2b17!^d10	;base 10 with leading 0
	NOUT%					;write number
	 ERJMP	.+1
	pop	p,t2				;recover days
	hrrzs	t2				;clear years, leave days
	tlo	t3,1				;set for 3 cols
	NOUT%					;write at end of string
	 ERJMP	.+1

	;set format

	move	t1,fmt				;get write format
	hlrzm	t1,rfmt				;save format
	hrrzm	t1,cctl				;save carriage ctl

	;convert string to word address

	dmove	t1,[-5,,filcdt+1		;aobjn ptr
		point 7,years]			;byte ptr to data
	ildb	t3,t2				;get a byte
	movem	t3,(t1)				;save byte
	aobjn	t1,.-2				;loop for all

	dmove	t1,[-^d13,,filnam		;at most 13 chars in name
		point 7,name]			;start lj on name
	ildb	t3,t2				;get a name byte
	jumpe	t3,mknam1			;stop on nul
	movem	t3,(t1)				;save byte
	aobjn	t1,.-3				;loop over name

	;name too long

	push	p,t1				;save pointer
	tmsg	< [truncating name] >
	pop	p,t1				;restore pointer
mknam1:
	sub	t1,[4,,0]			;allow at least 4 more chars
	movei	t3,"."				;dot the name
	movem	t3,(t1)				;save next byte
	aobjn	t1,.+1				;and account for it
	;do extension

	move	t2,[point 7,ext]		;reset pointer
	ildb	t3,t2				;get a byte of type
	jumpe	t3,mknam2			;stop on null
	movem	t3,(t1)				;save byte
	aobjn	t1,.-3				;loop for more

	;ext too long

	ildb	t3,t2				;maybe ok, check again
	jumpe	t3,mknam2			;was, dont panic
	tmsg	< [truncating type] >

mknam2:
	;do generation

	hrroi	t1,gen				;take care of x.x.100000
	setz	t2,				;no number yet
	movx	t3,^d10				;decimal generation
	NIN%					;read and convert to #
	 ETYPE	<Generation not converted to number>
	andi	t2,7777				;reduce to 4 max
	skipe	t2				;don't use null
	 movei	t2,1				;use one if was null
	setzm	gen				;clear gen again
	setzm	gen+1				;and next word too
	movx	t3,no%lfl!no%zro!4b17!^d8	;octal too
	hrroi	t1,gen				;reset pointer
	NOUT%					;write string
	 ERJMP	.+1
	dmove	t1,[-4,,filgen			;aobjn for generation
		point 7,gen]			;source for loop
	ildb	t3,t2				;get byte
	movem	t3,(t1)				;save it
	aobjn	t1,.-2				;loop for all
	RET					;done
	subttl	Subroutines -- Pfile process file data

pfile:
	txz	f,f.eof				;[3] force eof off

	;open the device, and set correct mode

	txnn	f,f.nul				;null device ?
	 jrst	pfilot				;no, continue on
pfilok:
	tmsg	< - OK]
[Blocks written: >
	movei	t1,.priou			;out to tty
	move	t2,blkcnt			;get blocks
	movei	t3,^d10				;base 10
	NOUT%					;write number
	 ERJMP	.+1
	tmsg	<. Records written: >
	movei	t1,.priou			;to tty
	skipe	t2,reccnt			;get record count
	 sos	t2				;decr for EOF record
	movei	t3,^d10				;base 10
	NOUT%
	 ERJMP	.+1
	tmsg	<.]
>
	RET
pfilot:
	;open file

	hrrz	t1,filjfn			;get jfn
	movx	t2,of%rd!7b5			;and identify mode
	txne	f,f.bin				;binary mode ?
	 txc	t2,17b5				;change to 8 bit if so
	OPENF%					;open file for read
	 ERJMP	pfilff				;failed.. find why
	move	b,pblk				;get next phys block size
	call	opnmta				;open mag tape drive

	;check for nul files

	hrrz	t1,filjfn			;[3] get jfn of new file
	dmove	t2,[1,,.fbsiz			;[3] get file size in bytes
		    t4]				;[3] and put it into t4
	setz	t4,				;[3] clear size
	GTFDB%					;[3] get file size
	 ETYPE	<File size is unknown assumed as zero length>
	jumple	t4,flrclz			;[3] stop if null file
 
	;dispatch on format for writing

	move	t1,rfmt				;get format
	cain	t1,"F"				;fixed length records ?
	 jrst	pfflr				;yes, go there
	cain	t1,"U"				;unformatted (image) ?
	 jrst	pfuft				;yes, go there
	cain	t1,"D"				;variable length (packed) ?
	 jrst	pfvlr				;yes, go there

	;error, format is unknown

	JHALT	<Format never setup in PFILE>

	;here on open failure

pfilff:
	tmsg	<? OPENF failed for named file
>
	jrst	lsterr				;return after call
	subttl	Subroutines -- PFILE - pfflr fixed len records

	;here for fixed length records... pack output buffer with
	;the records until full then add padding chars
	;fill each record with padchar if not correct... eat CRLF

pfflr:
	;compute records per block

	move	t1,pblk				;get phys len
	idiv	t1,recl				;divide by size of record
	movei	a,(t1)				;get recs/blk
	setzm	reccnt				;clear record count
	setzm	blkcnt				;clear block count
flr000:
	move	t1,padwrd			;get padding word
	move	t2,[outrec,,outrec+1]		;set up blt
	movem	t1,outrec			;clear first word
	blt	t2,outrec+MAXWRD-1    		;and then all the rest
	move	t1,[point 8,outrec]		;set up output counter
	movem	t1,outptr			;and save for data
	movei	b,(a)				;copy count

	;enter read loop

flr001:
	setzb	c,inrec				;have nulls put to buffer
	move	t2,[inrec,,inrec+1]		;in case of short records
	blt	t2,inrec+MAXWRD-1  		;and clear the rest
	hrrz	t1,filjfn			;get input jfn
	hrroi	t2,inrec			;point to buffer
	move	t3,recl				;get bytes to read
	addi	t3,2				;for stop bytes
	movei	t4,12				;stop on <LF>
	SIN%					;read string
	 ERCAL	flreof				;check eof
	;copy to output buffer

	move	t1,[point 7,inrec]		;get input pointer
	move	t2,outptr			;get output pointer
	movn	t3,recl				;get count expected

flr002:
	aosle	t3				;test count left
	 jrst	flr003				;done
	ildb	t4,t1				;read byte from input
	caie	t4,0				;null ?
	 cain	t4,15				;<CR> ?
	  jrst	flr002				;ignore it
	cain	t4,12				;lf ?
	 jrst	flr003				;yes, end of record
	idpb	t4,t2				;save byte
	aos	c				;keep count
	jrst	flr002				;do next

	;here if input is complete

flr003:
	caml	c,recl				;full count ?
	 jrst	flr005				;yes, stop
	ibp	t2				;no, boost counter
	aos	c				;keep track
	jrst	flr003				;loop
flr005:

	;full record... read next

	movem	t2,outptr			;save pointer again
	aos	t1,reccnt      			;incr record count
	txne	f,f.eof				;eof ?
	 jrst	flr006				;yes, stop
	sosle	b				;count records/blk
	 jrst	flr001				;no, continue

	;write record

flr006:
	hrrz	t1,mtajfn			;get jfn for drive
	move	t2,[point 8,outrec]		;get source addr
	movn	t3,pblk				;get exact record size
	setz	t4,				;no stop byte
	txne	f,f.ebc				;convert to ebcdic ?
	 call	cvtebc				;yes, do conversion
	SOUTR%					;write record
	 ERCAL	mtaerr				;error, retry
	aos	blkcnt				;add one for each block
	txzn	f,f.eof				;done ?
	 jrst	flr000				;continue with next record
flrcz0:						;[3] here on null or done

	;done with file, closef and close mta

	movx	t1,co%nrj			;never kill jfn
	hrr	t1,filjfn			;get file jfn
	CLOSF%					;close file
	 ETYPE	<Failed to close file after reading>
	movx	t1,co%nrj			;never kill this one either
	hrr	t1,mtajfn			;write tape marks
	CLOSF%					;close tape drive
	 ETYPE	<Failed to close tape drive after data write>
	jrst	pfilok				;done. say so

	;here on error reading file

flreof:
	push	p,t1
	push	p,t2
	movx	t1,.fhslf			;this process
	GETER%					;get my error
	 ERJMP	.+1				;ignore error return
	hrrzs	t2				;clear lh
	cain	t2,IOX4				;eof ?
	 jrst	flr004				;yes, continue
	tmsg	<% Error reading data file
>
	call	lsterr				;describe error

	;assume eof

flr004:
	txo	f,f.eof				;set eof bit
	pop	p,t2
	pop	p,t1
	RET					;and continue

flrclz:						;[3] here on nul file
	hrrz	t1,mtajfn			;[3] get device
	movx	t2,.moeof			;[3] write tape mark
	setz	t3,				;[3] no extra data
	MTOPR%					;[3] force eof mark
	 ETYPE	<MTOPR% failed to write a tape mark>
	jrst	flrcz0				;[3] continue
	subttl	Subroutines -- PFILE - pfuft image mode (N bit)

pfuft:

	;this routine writes PBLK length records in image
	; reading RECL bytes and padding

	setzm	reccnt				;clear record counter
	setzm	blkcnt				;clear block counter

uft000:
	setzm	inrec				;clear input buffer
	move	t1,padwrd			;get padding
	movem	t1,outrec			;force buffer clean
	dmove	t1,[inrec,,inrec+1		;get blt words
		outrec,,outrec+1]		;for buffer clear
	blt	t1,inrec+MAXWRD-1  		;clear input
	blt	t2,outrec+MAXWRD-1		;clear output

	;read a record

	hrrz	t1,filjfn			;get jfn of file for input
	move	t2,[point 7,inrec]		;point to input area
	txne	f,f.bin				;unless 8 bit set
	 hrli	t2,(point 8,)			;then use 8 bit bytes
	movn	t3,recl				;read exactly recl worth
	setz	t4,				;no stop byte
	SIN%					;read it
	 ERCAL	ufteof				;check eof
	aos	blkcnt				;incr counter
	aos	reccnt				;incr counter

	;convert string to 8 bit and write to tape

	move	t1,recl				;get string length
	move	t4,t1				;copy
	setzb	t3,t6				;no two word ptrs
	move	t2,[point 7,inrec]		;source
	txne	f,f.bin				;using 8 bits already ?
	 hrli	t2,(point 8,)			;yes, don't stop now
	move	t5,[point 8,outrec]		;destination
	extend	t1,[movslj			;move string
		   z]				;no fill
	trn					;nop in case of skip
	;write string

	hrrz	t1,mtajfn			;point to tape drive
	move	t2,[point 8,outrec]		;and to the source
	movn	t3,pblk				;write exact count
	setz	t4,				;clear stop byte
	txne	f,f.bin				;don't convert binary data
	 jrst	.+3				;avoid trashing 8 bit data
	txne	f,f.ebc				;ebcdic ?
	 call	cvtebc				;convert to IBM format
	SOUTR%					;write to tape
	 ERCAL	mtaerr				;try recovery

 	;do next record if any

	txzn	f,f.eof				;eof ?
	 jrst	uft000				;no, continue

	;close devices

	movx	t1,co%nrj			;never kill jfn
	hrr	t1,filjfn			;let go of file
	CLOSF%					;but keep jfn
	 ETYPE	<Failed to close file in image write>
	movx	t1,co%nrj			;keep jfn
	hrr	t1,mtajfn			;on tape drive
	CLOSF%					;too
	 ETYPE	<Failed to close tape drive in image write>
	jrst	pfilok				;done... say so

	;here on possible eof

ufteof:
	call	flreof				;re-use eof routine
	RET					;try again
	subttl	Subroutines -- PFILE - pfvlr variable length records

	;this routine writes compressed pdp-11 style records
	;in the format of
	;NNNN( NNNN bytes of text)NNNN( NNNN bytes of text) Padding....
	;0014this is xx0024This is abcdefghijkl00040011no crlf
	;translates to
	;this is xx
	;this is abcdefghijkl
	; <null line>
	;no crlf

pfvlr:
	move	t1,padwrd			;clear write buffer
	movem	t1,outrec			;to padd chars
	move	t1,[outrec,,outrec+1]		;get blt word
	blt	t1,outrec+MAXWRD-1		;clear buffer
	move	a,[point 8,outrec]		;master pointer
	move	b,pblk				;master count of space left
	setzm	reccnt				;clear counts
	setzm	blkcnt				;for later

	;here for next line

vlr000:
	txne	f,f.eof				;eof ?
	 jrst	vlr006				;yes, check more
	setzm	inrec				;clear buffer to null
 	move	t1,[inrec,,inrec+1]		;get blt word
	blt	t1,inrec+MAXWRD-1		;clear buffer
	hrrz	t1,filjfn			;source
	hrroi	t2,inrec			;destination
	move	t3,recl				;get max bytes to read
	movei	t4,12				;stop on lf
	SIN%					;read the string
	 ERCAL	flreof				;handle data error
	aos	reccnt				;count records read

	;count bytes really in string

	movei	t1,1(t2)			;clear lh, get stop addr
	setz	t2,				;clear count to zero
	move	t3,[point 7,inrec]		;ptr to data
vlr001:
	caige	t1,(t3)				;out of data ?
	 jrst	vlr002				;yes, end of counting
	ildb	t4,t3				;get the byte
	cain	t4,0				;null ?
	 jrst	vlr001				;ignore it
	cain	t4,15				;<CR> ?
	 jrst	vlr001				;ignore it
	cain	t4,12				;lf ? (not in buffer)
	 jrst	vlr002				;yes, stop there
	aos	t2				;incr counter
	jrst	vlr001				;continue
	;here after count done

vlr002:
	cail	b,4(t2)				;enough room ?
	 jrst	vlr004				;yes, plenty

	;must write record to tape

vlr003:
	push	p,t2				;save count
	hrrz	t1,mtajfn			;output device
	move	t2,[point 8,outrec]		;string ptr to data
	movn	t3,pblk				;exact len record
	setz	t4,				;no stop byte
	txne	f,f.ebc				;convert to ebc ?
	 call	cvtebc				;yes, do it
	SOUTR%					;write it
	 ERCAL	mtaerr				;try to recover on error

	;clean up

	aos	blkcnt				;keep track of blocks written
	move	t1,padwrd			;get padding
	movem	t1,outrec			;save in buffer
	move	t1,[outrec,,outrec+1]		;get blt word
	blt	t1,outrec+MAXWRD-1		;clear buffer
	move	a,[point 8,outrec]		;restore pointer
	move	b,pblk				;restore count
	pop	p,t2				;restore t2
	txze	f,f.eof				;done ?
	 jrst	vlr007				;yes

	;here to add record to block

vlr004:
	txnn	f,f.eof				;eof ?
	 jrst	.+3				;no, skip ahead
	skipn	t2				;eof and zero count ?
	 jrst	vlr000				;yes, quit
	subi	b,4(t2)				;decr count left
	move	t1,a				;get byte pointer
	push	p,t2				;save count again
	addi	t2,4				;count counter too
	movx	t3,no%lfl!no%zro!4b17!^d10	;write 4 chars with zeros
	NOUT%					;write it
	 ETYPE	<Illegal byte count internal to record>
	move	t2,t1				;[2] KLUDGE!
	move	t3,pad				;[2] KLUDGE
	idpb	t3,t2				;[2] KLUDGE
	pop	p,t2				;restore count
	move	a,t1				;recover pointer
	;copy data bytes in

	move	t1,[point 7,inrec]		;source
	skipn	t2				;null record ?
	 jrst	vlr000				;read next line
vlr005:
	ildb	t3,t1				;get a byte
	caie	t3,0				;null ?
	 cain	t3,15				;or cr ?
	  jrst	vlr005				;either, ignore it
	cain	t3,12				;lf ?
	 jrst	vlr005				;never should happen
	idpb	t3,a				;save byte
	sosle	t2				;decr count
	 jrst	vlr005				;and continue if more
	jrst	vlr000				;read next line

	;here on eof

vlr006:
	came	b,pblk				;empty buffer ?
	 jrst	vlr003				;no, empty it
vlr007:
	movx	t1,co%nrj			;keep jfn
	hrr	t1,filjfn			;for file
	CLOSF%					;close file
	 ETYPE	<Failed to close file in var len record>
	movx	t1,co%nrj			;keep jfn
	hrr	t1,mtajfn			;for tape drive too
	CLOSF%					;close tape
	 ETYPE	<Failed to close tape in var len record>
	jrst	pfilok				;give ok
	subttl	Subroutines -- mtaerr recover from tape errors

	;this routine tries to recover from a tape error
	;it assumes monitor retry has failed, so it clears the error bits
	;and writes a long tape mark
	;then retrys the write
	;if it still fails, yell and scream, then clear error and continue
	;if error was write passed phys EOT, scream

mtaerr:
	dmovem	t1,acs				;save acs
	dmovem	t3,acs+2			;for later
	dmovem	t5,acs+4			;restoring

	;get type of error

	movei	t1,.fhslf			;get self
	GETER%					;get error
	 ERJMP	.+1				;ignore this erro
	movei	t2,(t2)				;clear lh
	caie	t2,IOX5				;data error ?
	 cain	t2,IOX6				;write too far ?
	  jrst	mtaerd				;device (recoverable)

	;I dont recognize the error

	tmsg	<?Strange error while writing tape
>
	call	lsterr				;type error

	;here to return

mtaedn:
	dmove	t1,acs
	dmove	t3,acs+2
	dmove	t5,acs+4
	RET

	;here for a bonifide error

mtaerd:
	tmsg	<%Error writing tape
>
	push	p,t2				;save error
	call	lsterr				;explain it
	tmsg	<% Error at record: >
	movei	t1,.priou			;out to tty
	move	t2,reccnt			;this number
	movei	t3,^d10				;base ten
	NOUT%					;type number
	 ERJMP	.+1
	tmsg 	<. block: >
	movei	t1,.priou			;out to tty
	move	t2,blkcnt			;get block id
	movei	t3,^d10				;in base 10
	NOUT%
	 ERJMP	.+1				;ignore error
	tmsg	<.
>
	pop	p,t2				;restore error
	caie	t2,IOX5				;was it data error ?
	 jrst	mtaere				;no, eot mark

	;get device status bits

	hrrz	t1,mtajfn			;get device
	GDSTS%					;read status bits
	ERJMP	.+1
	txne	t2,mt%eot			;eot ?
	 jrst	mtaere				;handle it
	txne	t2,mt%ilw			;write locked ?
	 jrst   mtawlk				;handle it
	txne	t2,mt%dae!mt%dve		;data error ?
	 jrst	mtadat				;data error

	;who knows... tape offline ?

mtaask:
	tmsg	<% Type a return to retry >
	movei	t1,comand			;use comnd%
	movei	t2,confrm			;to confirm
	COMND%					;ask user
	txne	t1,cm%nop			;error ?
	 jrst	mtaedn				;yes, give up though

	;here to retry

mtatry:
	hrrz	t1,mtajfn			;get tape id
	move	t2,[point 8,outrec]		;and ptr to data
	movn	t3,pblk				;len to write
	setz	t4,				;clear stop byte
	SOUTR%					;write it
	 ERJMP	mtaafu				;you lose
	jrst	mtaedn				;return, successful
	;here if AFU

mtaafu:
	tmsg	<%Error on retry - I give up
>
	call	lsterr
	jrst	mtaedn				;quit

	;here for data error

mtadat:
	;backspace, write blank tape, retry

	hrrz	t1,mtajfn			;jfn of tape
	movx	t2,.mobkr			;back up record
	setz	t3,				;no funny stuff
	MTOPR%					;back up ?
	 ETYPE	<Failed to back up a record>

	;write blank tape

	hrrz	t1,mtajfn			;restore jfn
	movx	t2,.moers			;erase 3 inches
	setz	t3,
	MTOPR%					;do it
	 ETYPE	<Failed to erase tape>
	jrst	mtatry				;retry operation

	;here for eof reached

mtaere:
	tmsg	<?Write past end of tape not supported
>
	HALTF%
	jrst	mtaask

	;here for write locked

mtawlk:
	tmsg	<%Tape is write locked
>
	jrst	mtaask
	subttl	Subroutines -- wrteof/wrtbot

wrtbot:
	;no special processing, just set flag to force vol1 to be written

	txo	f,f.wvl				;write volume flag on
	RET					;thats it

wrteof:
	RET					;nothing to do yet
	subttl	Subroutines -- filbot/fileot

filbot:
	;called to write a hdr1/hdr2 label (and a vol1 label if needed)

	txne	f,f.nul!f.nlb			;nul device or no labels?
	 RET					;yes, ignore all
	movei	b,^d80				;80. char records
	call	opnmta				;open mta

	;check for vol1 request

	txzn	f,f.wvl				;need to write vol1 ?
	 jrst	filnvl				;no volume 1 needed

	;compress vol1 into a string format and then write it

	dmove	t1,[-^d80,,vol1			;aobjn ptr
		   point 8,outlbl]		;string area
	move	t3,(t1)				;get a byte
	idpb	t3,t2				;save byte
	aobjn	t1,.-2				;loop for all
	move	t1,mtajfn			;get jfn again
	move	t2,[point 8,outlbl]		;set up string ptr
	movni	t3,^d80				;exactly 80. bytes
	setz	t4,				;no stop byte
	txne	f,f.ebc				;ebcdic ?
	 call	cvtebc				;yes, convert it first
	SOUTR%					;write the record
	 ETYPE	<Failed to write VOL1 label>
	;here for hdr1

filnvl:
	;compress hdr1,hdr2 (all fields set up)

	dmove	t1,[-^d80,,hdr1			;aobjn ptr
		   point 8,outlbl]		;string area
	move	t3,(t1)				;get a byte
	idpb	t3,t2				;save byte
	aobjn	t1,.-2				;loop for all
	move	t1,mtajfn			;get jfn again
	move	t2,[point 8,outlbl]		;set up string ptr
	movni	t3,^d80				;exactly 80. bytes
	setz	t4,				;no stop byte
	txne	f,f.ebc				;ebcdic ?
	 call	cvtebc				;yes, convert it first
	SOUTR%					;write the record
	 ETYPE	<Failed to write HDR1 label>

	dmove	t1,[-^d80,,hdr2			;aobjn ptr
		   point 8,outlbl]		;string area
	move	t3,(t1)				;get a byte
	idpb	t3,t2				;save byte
	aobjn	t1,.-2				;loop for all
	move	t1,mtajfn			;get jfn again
	move	t2,[point 8,outlbl]		;set up string ptr
	movni	t3,^d80				;exactly 80. bytes
	setz	t4,				;no stop byte
	txne	f,f.ebc				;ebcdic ?
	 call	cvtebc				;yes, convert it first
	SOUTR%					;write the record
	 ETYPE	<Failed to write HDR2 label>

	;[2] more HDR records ?

	move	t4,numhdr			;[2] get count needed
	caile	t4,minhdr			;[2] min done ?
	 call	filxhd				;[2] yes, add extra headers

	;close device to get eof tape mark

	movx	t1,co%nrj			;don't kill jfn
	hrr	t1,mtajfn			;add jfn to arg
	CLOSF%					;close device
	 ETYPE	<Failed to close device after headers>
	txo	f,f.vol				;volume labels written
	RET					;done
	;here for eof labels (re-use hdr1,hdr2)

fileot:
	movei	t1,"E"				;EOF
	movei	t2,"O"				;EOF
	dmovem	t1,hdr1				;reset data
	dmovem	t1,hdr2				;reset data
	movei	t1,"F"
	movem	t1,hdr1+2			;set up
	movem	t1,hdr2+2			;for eof write

	;fill in the block count

	hrroi	t1,numstr			;convert numbers
	setzm	(t1)				;clear scratch
	setzm	1(t1)				;area
	hrrz	t2,blkcnt			;get number to write
	movx	t3,no%lfl!no%zro!6b17!^d10	;leading 0, base 10
	NOUT%					;write into scratch area
	 ERJMP	.+1				;no need for message
	dmove	t1,[-6,,filblk			;aobjn ptr
		point 7,numstr]			;and get byte ptr
	ildb	t3,t2				;get a byte
	movem	t3,(t1)				;save byte
	aobjn	t1,.-2				;loop for more
	setzm	blkcnt				;clean up for later
	setzm	reccnt				;and for nul files
	jrst	filbot				;re-use write stuff
	subttl	Subroutines -- filxhd write extra HDR labels

filxhd:						;[2] all below under this edit
	subi	t4,minhdr			;compute use count
	push	p,t4				;and save it
	move	t1,hdr1				;EOF or HDR ?
	move	t2,[hdr3c,,hdrn]		;init header rec
	blt	t2,hdrn+^d79			;80. char rec
	cain	t2,"H"				;"HDR1" ?
	 jrst	filxh1				;yes, skip
	movem	t1,hdrn				;make it EOF
	dmove	t2,hdr1+1			;get the rest
	dmovem	t2,hdrn+1			;save them
filxh1:
	dmove	t1,[-^d80,,hdrn			;aobjn ptr
		   point 8,outlbl]		;string area
	move	t3,(t1)				;get a byte
	idpb	t3,t2				;save byte
	aobjn	t1,.-2				;loop for all
filxh2:
	move	t1,mtajfn			;get jfn again
	move	t2,[point 8,outlbl]		;set up string ptr
	movni	t3,^d80				;exactly 80. bytes
	setz	t4,				;no stop byte
	txne	f,f.ebc				;ebcdic ?
	 call	cvtebc				;yes, convert it first
	SOUTR%					;write the record
	 ETYPE	<Failed to write HDRN label>
	sosg	(p)				;more to do ?
	 jrst	filxh3				;no done
	ldb	t1,[point 8,outlbl,31]		;get char
	aos	t1				;make it larger
	dpb	t1,[point 8,outlbl,31]		;set for next hdr
	jrst	filxh2				;loop for more
filxh3:
	pop	p,(p)				;clear stack
	RET					;done
	subttl	Subroutines -- opnmta open magtape device

	;b contains record size

opnmta:
	move	t1,mtajfn			;get jfn on tape
	movx	t2,10b5!of%wr             	;and set up i/o mode
	OPENF%					;open device
	 ETYPE	<Failed to open tape for writing HDR1>
	move	t1,mtajfn			;restore jfn
	movx	t2,.mosdm			;set data mode function
	movx	t3,.sjdm8			;industry mode
	MTOPR%					;set mode
	 ETYPE	<Couldn't set industry mode for tape drive>
	move	t1,mtajfn			;restore jfn
	movx	t2,.mosdn			;set density
	move	t3,dens				;get density
	MTOPR%					;set density
	 ETYPE	<Couldn't set density in tape command>

	;set xxx char records

	move	t1,mtajfn			;restore jfn
	movx	t2,.mosrs			;set record size ftn
	movei	t3,(b) 				;ansi label size
	MTOPR%					;set size
	 ETYPE	<Failed to set record size in OPNMTA>

	;set parity

	move	t1,mtajfn			;get jfn for tape
	movx	t2,.mospr			;set parity
	move	t3,parity			;get parity flag
	MTOPR%					;set parity please
	 ETYPE	<Failed to set required parity>
	RET					;done
	subttl	Subroutines -- cvtebc convert string to EBCDIC

cvtebc:
	;save 6 acs

	dmovem	a,acs				;save them
	dmovem	c,acs+2
	dmovem	e,acs+4				;for later

	;get count of bytes to move

	movn	a,t3				;get count from soutr
	move	d,a				;copy length
	tlo	a,400000			;set S bit
	movei	c,(t2)				;get source address
	tlo	c,(1b0)				;set local flag
;	movsi	b,(<point 8,0>!1b12)		;make glbl ptr
;	move	e,b				;identical pointer
;	movx	e+1,1b0!xlbuf			;make destination ptr
	movsi	b,(point 8,)			;use local pointer
	hrri	b,(t2)				;real pointer
	move	e,[point 8,xlbuf]		;no 2 word in tops20
	EXTEND	a,[movst xltbl			;do move string translated
		z]				;no fill chars
	jfcl					;ignore skip ?

	;copy string back to source

	movn	a,t3				;get count back
	lsh	a,-2				;divide by 4
	movsi	b,xlbuf				;source for blt
	hrri	b,(t2)    		        ;get destination
	addi	a,-1(t2)			;and compute length
	blt	b,(a)				;copy back
	dmove	a,acs				;restore acs
	dmove	c,acs+2
	dmove	e,acs+4				;to starting point
	RET					;and return
	subttl	Subroutines -- Ascii to Ebcdic translation table

xltbl:
	;format is even,,odd

	000,,001				;null to null, etc
	002,,003
	067,,055
	056,,057				;bell to ?
	026,,005
	045,,013
	014,,025
	006,,066
	044,,024
	064,,065
	004,,075
	027,,046
	052,,031
	032,,047
	023,,041
	040,,042
	100,,132				;space to space
	177,,173
	133,,154
	120,,175
	115,,135
	134,,116
	153,,140
	113,,141
	360,,361				;digits to digits
	362,,363
	364,,365
	366,,367
	370,,371
	172,,136
	114,,176
	156,,157
	174,,301				;@a
	302,,303
	304,,305
	306,,307
	310,,311
	321,,322
	323,,324
	325,,326
	327,,330
	331,,342				;rs
	343,,344
	345,,346
	347,,350
	351,,255				;[
	340,,275
	137,,155
	171,,201
	202,,203
	204,,205
	206,,207
	210,,211
	221,,222
	223,,224
	225,,226
	227,,230
	231,,242
	243,,244
	245,,246
	247,,250
	251,,300
	117,,320
	241,,007				;note that this table
						;is ^d64 words long
						;parity will give bizare
						;results
	subttl	Fatal errors here

fatal::
	call	lsterr				;type an error
	RESET%					;clear everything
	HALTF%					;die
	jrst	.-1				;never recover
	subttl	literals
	xlist
	lit
	list
	subttl	impure storage

	reloc	0			;low segment
.lowa:	block	1			;start of cleared area
vol1:
	block	4			;"VOL1"
volid:	block	6			;volume label
	block	1			;accessibility
	block	^d26			;reserved
ownid:	block	^d14			;owner info [uic]
	block	^d28			;reserved
	block	1			;label version

hdr1:
	block	4			;"HDR1"
filnam:	block	^d17			;file name
filset:	block	6			;copy of volume id
	block	^d4 			;unused file section
filseq:	block	4			;number of file on tape
filgen:	block	4			;file generation #
	block	2			;generation type
filcdt:	block	6			;creation date
	block	6			;expires (never)
	block	1
filblk:	block	6			;block count
	block	^d13			;system code (dec20)
	block	7			;reserved

hdr2:
	block	4			;"HDR2"
rfmt:	block	1			;format F,D,S,U
pblkx:	block	5			;block length physical
lblk:	block	5			;record length (logical)
	block	^d21			;system dependent info
cctl:	block	1			;" " or "M"
	block	^d13			;blank
	block	2
	block	^d28			;reserved

hdrn:	block	3			;[2] multi record HDR label
hdrnct:	block	1			;[2] lab #
	block	^d76			;[2] filler

outlbl:	block	<^d80/^d4>		;80. bytes at 4 bytes per word
outrec:	block	MAXWRD      		;max size of data record
	block	10
comand:	block	.cmgjb+1		;comand state block
bigbuf:	block	200			;text buffer
atom:	block	30			;atom buffer
jfnblk:	block	.gjatr+1		;jfn long form block
	;more
pblk:	block	1			;physical blocksize
pblkt:	block	1			;parse temp
dens:	block	1			;density value
denst:	block	1			;temp parse
devd:	block	1			;device designator
devdt:	block	1			;parse temp
filjfn:	block	1			;wildcard jfn from file command
pad:	block	1			;padding character
padt:	block	1			;temp for parse
padwrd:	block	1			;4 bytes of pad char
recl:	block	1			;record length (logical)
reclt:	block	1			;parse temp
reccnt:	block	1			;counter of records
blkcnt:	block	1			;counter of blocks
volx:	block	3			;buffer for volume string
numhdr:	block	1			;[2] number of headers
hdrnmt:	block	1			;[2] temp headers
fmt:	block	1			;format to write tape with
fmtt:	block	1			;parse temp
bit8:	block	1			;set if binary mode
party:	block	1			;parityltempifor parse
dxdev:	block	3			;temp string area
mtajfn:	block	1			;jfn of magtape unit
seqnum:	block	1			;sequence # of file on tape
labtmp:	block	1			;label writting temp for parse
execfh:	block	1			;exec fork handle
execjf:	block	1			;jfn of exec
numstr:	block	3			;string number work area
	;more
outptr:	block	1			;pointer to outrec
inrec:	block	MAXWRD    		;buffer for reading raw data (7bit)

	;*** do not change order

name:	block	10			;string file name
ext:	block	10			;string file type
gen:	block	10			;string file generation
cdate:	block	1			;file creation time
years:	block	3			;string area for date

	;*** do not change order

xlbuf:	block	MAXWRD      		;string translation area
acs:	block	6			;ac save area for translation
pdlst:	block	pdlen			;the stack area
.higha::
        block   1			;end of cleared area
	end	<3,,entvec>		;start address