Google
 

Trailing-Edge - PDP-10 Archives - QT020_T20_4.1_6.1_SWSKIT_851021 - swskit-hacks/mtvrfy.mac
There are no other files named mtvrfy.mac in the archive.
	Title	MTVRFY - Tape test program for old tapes
	Subttl	M. Raspuzzi/MDR May 1985
	search	macsym,monsym
	.require	sys:macrel
	.direct	flblst
	SALL

; MTVRFY is a product of the monitor support group of Software Services.
; It's primary function is to test old magtapes to see if they can still
; be used for data storage.

; Version Information

vwho==1					; Software Specialist
vmajor==1				; Major version
vminor==0				; Minor version
vedit==^d1				; Edit number
	Subttl	Table of Contents

;	Table of Contents				Page
;	----- -- --------				----
;
;	1. M. Raspuzzi/MDR May 1985........................1
;	2. Table of Contents...............................2
;	3. Revsion History.................................3
;	4. Definitions.....................................4
;	5. Storage.........................................5
;	6. Command tables/Entry vector.....................6
;	7. ASSIGN Command Routine..........................7
;	8. VERIFY Command Parser...........................8
;	9. Assign Error messages...........................9
;      10. EXIT Command Handler...........................10
;      11. UNLOAD Command/Routine.........................11
;      12. REWIND Command Parser..........................12
;      13. HELP command & Message.........................13
;      14. Verifying Routine..............................15
;      15. Devtst Routine.................................16
;      16. Chkok Routine..................................17
;      17. Chkhdr Routine.................................18
;      18. PUSH Handler...................................19
;      19. SET Command Parsing............................20
;      20. INFORMATION Command Handler....................21
;      21. DEASSIGN Command Routine.......................22
;      22. Fill Tape Routine..............................23
;      23. Rewind Routine.................................24
;      24. Read/verify Tape Routine.......................25
;      25. Tape header Routine............................26
;      26. Compare Routine................................27
;      27. Make Data Section Routine......................28
;      28. Enable ^A Interrupt Routine....................29
;      29. Disable ^A Interrupt...........................30
;      30. Interrupt Channel 0 Server Routine.............31
;      31. Back Space Routine.............................32
;      32. Interrupt Channel 1 Server Routine.............33
;      33. Interrupt Channel 2 Server Routine.............34
	Subttl	Revision History

; Revision history:
;
;	1   MDR   28-May-85
;		  Start keeping revision history.
;
;	2   MDR   28-May-85
;		  Eliminate ASSIGN command. Assign drives tranparently
;		  using the VERIFY command. Insert SET commands too.
;
;	3   MDR   28-May-85
;		  Add override features. Have header put on tape to
;		  indicate tape has been checked.
;
;	4   MDR	  3-Jun-85
;		  Put ASSIGN command back in. Add UNLOAD command so
;		  that user has the choice to unload the tape at prompt.
;
;	5   MDR   4-Jun-85
;		  Insert ^A so that when the tape is being verified the
;		  user can see if things are happening.
;
;	6   MDR   4-Jun-85
;		  Add in error recovery so that when a bad read or write
;		  is encountered, we don't die until after a specified
;		  number of consecutive read/write errors occur.
;
;	7   MDR   7-Jun-85
;		  Add ^E abort routine and prevent the user from ^C at
;		  the most inopertune time.
;
;	8   MDR	  25-Sep-85
;		  Add ERROR macro after MTOPR% calls so we don't blow up
;		  if twit makes our tape drive go off line.
STDAC.

	Subttl	Useful Macro Definitions for COMND

; Parse a string of noise words
DEFINE	NOISE	(STRING)	<
	movei	t2,[FLDDB. .CMNOI,,<-1,,[asciz /string/]>]
	COMND%
	 erjmp	[error]
	txne	t1,CM%NOP
	jrst	[error]		>	; Definition NOISE

; Obtain confirmation, an end of line indication. Tie off
; command line also.
DEFINE	CONFIRM			<
	movei	t2,[FLDDB. .CMCFM]
	COMND%
	 erjmp	[error]
	txne	t1,CM%NOP
	jrst	[error]		>	; Definition CONFIRM

; Call this macro to help build the command table. This macro is
; more complex (and more useful) than the CMD macro defined in MACSYM
DEFINE	TBL	(NAME,FLAGS,DISP)	<
ifnb <DISP>,<..DISP==DISP>		;; If a dispatch is given, use it
ifb  <DISP>,<..DISP==.'NAME>		;; If none, default to .NAME
ifb  <FLAGS>,<[asciz /NAME/],,..DISP>	;; If no flags, assemble just the name
ifnb <FLAGS>,<[FLAGS!CM%FW		;; If flags, use them and set CM%FW
		asciz /NAME/],,..DISP>	;;
	purge	..DISP			> ; TBL macro

define	fatal   <
	hrroi	t1,[asciz /ERROR: /]	; Send error typeout
	ESOUT%
	movei	t1,.CTTRM		; Message to this terminal
	hrloi	t2,.FHSLF		; This fork, most recent error
	setz	t3,			; No limit byte to count
	ERSTR%				; Convert last error to string
	 jfcl				; Would you believe two...
	 jfcl				; ...possible returns?
	hrroi	t1,bl			; Insert a CRLF
	PSOUT%
	HALTF%
		>

define	error   <
	hrroi	t1,[asciz /MTVRFY: /]	; Send error typeout
	ESOUT%
	movei	t1,.CTTRM		; Message to this terminal
	hrloi	t2,.FHSLF		; This fork, most recent error
	setz	t3,			; No limit byte to count
	ERSTR%				; Convert last error to string
	 jfcl				; Would you believe two...
	 jfcl				; ...possible returns?
	hrroi	t1,bl			; Insert a CRLF
	PSOUT%
	 jfcl
	ret				; Non-fatal error
		>
; Data Storage
pdlen==500				; Stack length
cmdbsz==^d50				; Length of command text buffer (250 chars)
atmbsz==^d20				; Length of atom buffer (100 chars)
datpag==13000				; Page where the data is stored to be moved on tape
bufpag==20000				; Page where the data is taken off tape and placed
maxtry==3				; Maximum number of data errors per tape

stkptr:	0				; Storage for the stack pointer
tapdes:	0				; Device designator for tape drive
excjfn:	0				; JFN for SYSTEM:EXEC
fkhan:	0				; Fork handle for EXEC.EXE
tapjfn:	0				; JFN for tape drive
errcod:	0				; Error code safe spot
ovride:	0				; Override tape header flag
unflg:	0				; Unload on done flag
pclev1:	0				; Place for level 1 interrupt PC
pclev2:	0				; Place for level 2 interrupt PC
pclev3:	0				; Place for level 3 interrupt PC
tries:	0				; Data error retry attempts
chntab:	3,,chn0sv			; Priority 3 for channel 0
	1,,chn1sv			; Priority 1 for channel 1
	2,,chn2sv			; Priority 2 for channel 2
	block	35			; Fill in remaining channels
levtab:	0,,pclev1			; Level 1 PC save address
	0,,pclev2			; Level 2 PC save address
	0,,pclev3			; Level 3 PC save address
finloc:	<datpag+datlen>			; Final location for BLT when making data page
source:	<data>				; Source of BLT for making data page
dest:	<datpag>			; Destination for BLT when making data page
stack:	block	pdlen			; Stack
lv2ac:	block	20			; Place for level 2 interrupt ACs
lv3ac:	block	20			; Place for level 3 interrupt ACs
tapinf:	15				; Number of words following this one
	block	15			; Block for tape information
atmbuf:	block	atmbsz			; Atom buffer
cmdbuf:	block	cmdbsz			; Command buffer
jfnmta:	block	2			; Should only need 7 characters (string)
adrcom:	iowd	2000,datpag		; Transfer2 pages starting at data (onto tape)
	0				; End of command list
getdat:	iowd	2000,bufpag		; Retrieve 2 pages and put into buffer
	0				; End of command list
mess:	iowd	100,msg			; Commands for putting on sniff message
	0
msg:	block	1000			; Sniff message for beginning of tape
bl:	byte(7)15,12,0			; CRLF for error routine
data:	asciz /ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 !@#$%^&*()
abcdefghijklmnopqrstuvwxyz-=`[];',.\_+~{}:"<>?|/	; Data BLTed to a page
datlen==<.-data>-1			; Find out how many words in data
; Command state block
cmdblk:	0,,cmrprs			; Flags,,address of reparse routine
	.PRIIN,,.PRIOU			; Primary input,,primary output
	-1,,[asciz /MTVRFY>/]		; Prompt string
	-1,,cmdbuf			; Pointer to start of text buffer
	-1,,cmdbuf			; Pointer to start of next input
	cmdbsz*5-1			; Size of command buffer in bytes
	0				; Number of unparsed characters
	-1,,atmbuf			; Pointer to start of atom buffer
	atmbsz*5-1			; Size of atom buffer
	0

; Command table
cmdtab:	cmdtbl,,cmdtbl			; Actual,,maximum number of entries
	tbl	(A,CM%INV!CM%ABR,$ASSD)	; Make sure we parse A and AS
	tbl	(AS,CM%INV!CM%ABR,$ASSD)
	tbl	(ASS,CM%NOR,0)		; Let's not be rude
$assd:	tbl	(ASSIGN,,.ASIND)
	tbl	(DEASSIGN,,.DEASN)
	tbl	(EXIT)
	tbl	(HELP)
	tbl	(INFORMATION,,.SHOW)
	tbl	(PUSH)
	tbl	(QUIT,CM%INV,.EXIT)
	tbl	(REWIND,,.REWIN)
	tbl	(SET)
	tbl	(UNLOAD,,.UNLD)
	tbl	(VERIFY,,.VERFY)
cmdtbl=<.-cmdtab>-1

evec:	jrst	begin			; Entry vector
	jrst	begin			; Re-entry point
versio:	byte	(3)vwho(9)vmajor(6)vminor(18)vedit
evecl==.-evec

begin:	RESET%				; Start properly
	setzm	tapjfn			; In case of CONT
	setom	ovride			; Init override flag
	setzm	unflg			; Init unload flag
	move	p,[iowd pdlen,stack]	; Stack initialization
	call	makdat
toplev:	call	getcmd			; Get a command and run it
	; Anything that needs to be done here (tie up loose JFNS)
	jrst	toplev			; Loop back to top level

getcmd:	movei	t1,cmdblk		; Point to state block
	movei	t2,[FLDDB. .CMINI]	; Initialize the state block, watch
	COMND%				;  for CTRL/H. do output prompt.
	 erjmp	[fatal]			; Fatal error that should never happen
	movem	p,stkptr		; Save stack pointer for reparse
cmrprs:	move	p,stkptr		; Restore stack pointer for reparse
	movei	t2,[FLDDB. .CMKEY,,cmdtab,<A command,>]
	COMND%
	 erjmp	[fatal]
	txne	t1,CM%NOP		; Did the parse fail?
	 jrst	[error]			; Yes, report the error and return
	hrrz	t2,(t2)			; Get address of command server
	jrst	(t2)			; Dispatch to it
	Subttl	Command servers
	Subttl	Assign command

; This routine will assgin the requested tape drive to this job.
.asind:	noise	(TAPE)
	movei	t2,[FLDDB. .CMDEV,,,<A tape>]
	COMND%				; Parse tape drive device name
	 erjmp	[fatal]
	txne	t1,CM%NOP		; Did we parse correctly?
	 jrst	[error]			; Apparantly not
	movem	t2,tapdes		; Safe keeping for tape drive device designator
	confirm				; Tie off command
	move	t1,tapdes		; Recapture tape drive device designator
	DVCHR%				; Find device characteristics
	txnn	t2,<FLD(.DVMTA,DV%TYP)>	; Did user type magtape?
	 jrst	nottap
	ASND%				; Attempt to assign device
	 erjmp	notasd			; Fatal assigning error
	tmsg	<Tape drive assigned - [OK]
>
	skipe	tapjfn			; Do we already have a JFN?
	 jrst	gotjfn			; Yes, don't get another one
	hrroi	t1,jfnmta		; Pointer to place where tape drive string is going
	move	t2,tapdes		; Drive's device designator
	DEVST%				; Get ASCIZ string name
	 erjmp	[fatal]
	movei	t2,":"			; DEVST% doesn't end string with colon
	idpb	t2,t1			; So we'll do it
	setz	t2,			; Let's also be sure there is a NUL
	idpb	t2,t1
	movx	t1,GJ%SHT		; Let's try to get a JFN
	hrroi	t2,jfnmta		; On the tape drive
	GTJFN%
	 erjmp	[fatal]			; We didn't
	movem	t1,tapjfn		; Save the drive's JFN
gotjfn:	ret
	Subttl	Verfiy Parser

; This routine begins the verification process.

.verfy:	skipe	tapdes			; Already assigned?
	 jrst	[noise	(CONFIRM)	; Yes, don't ask for tape name
		 jrst	alrdy]
	noise	(TAPE NAMED)
	movei	t2,[FLDDB. .CMDEV,,,<A tape>]
	COMND%				; Parse tape drive device name
	 erjmp	[fatal]
	txne	t1,CM%NOP		; Did we parse correctly?
	 jrst	[error]			; Apparantly not
	movem	t2,tapdes		; Safe keeping for tape drive device designator
alrdy:	confirm				; Tie off command
	move	t1,tapdes		; Recapture tape drive device designator
	DVCHR%				; Find device characteristics
	txnn	t2,<FLD(.DVMTA,DV%TYP)>	; Did user type magtape?
	 jrst	nottap
	ASND%				; Attempt to assign device
	 erjmp	notasd			; Fatal assigning error
	call	dovrfy
	ret
	Subttl	Assign Errors

; This routine handles the errors associated with assigning the tape
; drive to the user.

nottap:	tmsg	<ERROR: Device is not MAGTAPE - fix device name.
>
	setzm	tapdes			; There is no tape designator
	ret				; Start parsing over

notasd:	tmsg	<Tape drive not assigned - run OPR and set the drive unavailable, or
mount the tape via the MOUNT command.
>
	setzm	tapdes			; We have no tape designator
	ret
	Subttl	Exit command

; Straight forward.

.exit:	noise	(FROM PROGRAM)
	confirm
	skipe	tapdes			; We will deassign tape drive...
	 call	deasn1			; ...if necessary
	HALTF%				; Return to EXEC
	jrst	evec			; Continue starts us over
	Subttl	Unload command

; To unload a tape drive.

.unld:	noise	(CURRENT TAPE)
	confirm
.unld1:	skipn	tapdes			; Do we have a tape?
	 jrst	[tmsg	<%No tape to unload.
>
		 ret]
	move	t1,tapjfn
	movx	t2,<FLD(^d8,OF%BSZ)!FLD(.GSDMP,OF%MOD)!OF%WR!OF%RD>
	OPENF%				; Get tape ready for verification
	 ercal	devtst			; Is device assigned?
	tmsg	<Unloading tape - >
	move	t1,tapjfn		; Get tape's JFN
	movei	t2,.MORUL		; Rewind it and unload it
	MTOPR%
	 erjmp	labld			; Can't must be labelled tape
	jrst	labld			; Let's be neat and deassign tape drive too
okunl:	tmsg	<[OK]
>
	setzm	tapdes			; Reset memory
	setzm	tapjfn			; No JFN either
	ret

labld:	move	t1,tapjfn		; Get rid of JFN and close it
	CLOSF%				; So we can deassign it
	 jfcl				; No biggie
	move	t1,tapdes		; Get tape's JFN
	RELD%				; Get rid of device
	 erjmp	[error]
	jrst	okunl
	Subttl	Rewind command

; Rewind the tape

.rewin:	noise	(CURRENT TAPE)
	confirm
	skipn	tapdes			; Do we have a tape drive
	 jrst	notap			; No, can't rewind
	skipe	tapjfn			; Do we have a JFN for the tape?
	 jrst	dorew			; Yes, rewind tape
	hrroi	t1,jfnmta		; Pointer to place where tape drive string is going
	move	t2,tapdes		; Drive's device designator
	DEVST%				; Get ASCIZ string name
	 erjmp	[fatal]
	movei	t2,":"			; DEVST% doesn't end string with colon
	idpb	t2,t1			; So we'll do it
	setz	t2,			; Let's also be sure there is a NUL
	idpb	t2,t1
	movx	t1,GJ%SHT		; Let's try to get a JFN
	hrroi	t2,jfnmta		; On the tape drive
	GTJFN%
	 erjmp	[fatal]			; We didn't
	movem	t1,tapjfn		; Save the drive's JFN
dorew:	tmsg	<Rewinding...>
	call	rewind
	tmsg	<
>
	ret
	Subttl	Help command

.help:	confirm
	hrroi	t1,hlpmsg		; Get help text
	PSOUT%				; Now show it off
	ret

hlpmsg:	asciz	/

This program is used to check tape data integrity. It will write data from
the begining of the tape all the way until the end. Then it will check what
was just written against the data that was supposed to be written. Commands
are as follows:

ASSIGN [tape]
     The ASSIGN command will allow you to assign a tape drive that has been
     set available for system usage and is not under MOUNTR's control.

DEASSIGN
     This will deassign the tape drive that you have assigned. It works like
     DISMOUNT on a labelled tape.

EXIT
     To exit from the program. Note: If a tape drive has been assigned, it
     will be deassigned upon exitting.

HELP
     This is it.

INFORMATION (about parameter settings)
    This will show you the settings for OVERRIDE and UNLOAD.

PUSH
     To push to a lower EXEC.

REWIND
     This allows you to rewind the tape on the assigned drive.

SET
     Used to SET one of the following flags:

     UNLOAD - SET UNLOAD ON sets a flag so that after tape verification, the
              tape drive will be unloaded. Note, if tape verification fails,
              the tape will still be unloaded.
              SET UNLOAD OFF sets a flag so that after verification, the tape
              drive remains loaded. This is the default.

     OVERRIDE [ON,OFF] - If a tape has been verified good or bad, a "stamp"
              is placed at the beginning of the tape. SET OVERRIDE ON tells
              the program to ignore this stamp and verfiy the tape anyway.
              SET OVERRIDE OFF will allow a check to see if the tape has been
              already checked. Default setting: ON.

UNLOAD
    This will unload or DISMOUNT the current tape in use.

VERIFY [tape]
    Begins verification procedure. The program will write data on the tape,
    will rewind, and then read the data off the tape. If there are any tape
    errors, it will be reported. The tape name does not have to be supplied
    if a drive has been assigned using the ASSIGN command.

In addition to the above commands, the user may type a control-A during tape
verification for status information. This will enable the program to report
to the user which record the program is currently on. To abort the verification
process, type a control-E. This can only be done during verification.

A tape with a write ring must be placed in the assigned drive or an error
will occur. The tape drive must also be on line.

/
	Subttl	Verifying Routine

; This routine takes care of the tape verification.

dovrfy:	skipn	tapdes			; Do we have a drive?
	 jrst	notap			; No, can't verify something we don't have
	skipe	tapjfn			; Do we already have a JFN?
	 jrst	havjfn			; Yes, don't get another one
	hrroi	t1,jfnmta		; Pointer to place where tape drive string is going
	move	t2,tapdes		; Drive's device designator
	DEVST%				; Get ASCIZ string name
	 erjmp	[fatal]
	movei	t2,":"			; DEVST% doesn't end string with colon
	idpb	t2,t1			; So we'll do it
	setz	t2,			; Let's also be sure there is a NUL
	idpb	t2,t1
	movx	t1,GJ%SHT		; Let's try to get a JFN
	hrroi	t2,jfnmta		; On the tape drive
	GTJFN%
	 erjmp	[fatal]			; We didn't
	movem	t1,tapjfn		; Save the drive's JFN
havjfn:	move	t1,tapjfn
	movx	t2,<FLD(^d8,OF%BSZ)!FLD(.GSDMP,OF%MOD)!OF%WR!OF%RD>
	OPENF%				; Get tape ready for verification
	 ercal	devtst			; Is device assigned?
	move	t1,tapjfn		; Tape's JFN
	movei	t2,.MOSDN		; Set tape density...
	movei	t3,.SJD16		; ...at 1600 bpi
	MTOPR%
	 erjmp	[error]
	move	t1,tapjfn		; Get tape's JFN
	movei	t2,.MOSDM		; Set data mode...
	movei	t3,.SJDMC		; ...to 36 bit dump mode
	MTOPR%
	 erjmp	[error]
	skipe	ovride
	 call	chkok			; Tape been doen already?
	tmsg	<Writing data on tape...>
	call	filtap			; Write all over the tape
	call	discta			; Disable ^A while rewinding
	tmsg	<Rewinding...>
	call	rewind			; Rewind tape
	tmsg	<
>
	tmsg	<
Verifying tape...>
	move	t1,tapjfn
	movx	t2,<FLD(^d8,OF%BSZ)!FLD(.GSDMP,OF%MOD)!OF%WR!OF%RD>
	OPENF%				; Get tape ready for verification
	 ercal	devtst			; Is device assigned?
	call	vertap			; Verify what was written
	ret

notap:	tmsg	<You must assign a tape drive first.
>
	ret
	Subttl	Devtst Routine

; This routine tests to see if the OPENF% JSYS generates a meaningful
; error or if it is insignificant (%Device already opened or off-line).

devtst:	movem	t1,errcod		; Save error code (just in case)
	caie	t1,OPNX8		; Is the drive on line?
	 jrst	chkmor			; No, check for different error
	tmsg	<%Tape drive is not on line.
>
	pop	p,			; We don't want to return to OPENF%
	ret

ring:	tmsg	<%Tape is write protected. Insert a write ring.
>
	movx	t1,CO%NRJ		; Don't release the JFN
	hrr	t1,tapjfn		; Put JFN in right side
	CLOSF%				; Close the drive
	 erjmp	[ move	t1,tapjfn	; Try using...
		  txo	t1,CZ%ABT	; ...this set
		  CLOSF%		; Do it again
		   jfcl			; We don't care, we got paid
		  jrst	.+1 ]
	pop	p,			; We don't want to return to OPENF%
	ret

chkmor:	caie	t1,OPNX25		; Device write locked?
	 jrst	[caie	t1,OPNX1	; File already opened?
		  jrst	[fatal]		; Nope. Real trouble.
		 ret]			; All is OK
	move	t1,tapjfn		; See if user inserted a write ring
	GDSTS%
	txne	t2,[MT%ILW]		; Is tape drive write protected?
	 jrst	ring			; Yep, put in a ring
	ret
	Subttl	Chkok routine

; This routine checks to see if the tape has already been verified
; by this program already. If so, it will tell the user the results.

chkok:	call	rewind			; Let's get to the beginning first
	move	t1,tapjfn
	movx	t2,<FLD(^d8,OF%BSZ)!FLD(.GSDMP,OF%MOD)!OF%WR!OF%RD>
	OPENF%				; Get tape ready for reading of header
	 ercal	devtst			; Is device assigned?
	move	t1,tapjfn		; Get tape's JFN
	movei	t2,rethdr		; Read the tape's header
	DUMPI%
	 jfcl				; Ignore
	call	rewind			; Rewind the tape before beginning
	move	t1,tapjfn
	movx	t2,<FLD(^d8,OF%BSZ)!FLD(.GSDMP,OF%MOD)!OF%WR!OF%RD>
	OPENF%				; Get tape ready for reading of header
	 ercal	devtst			; Is device assigned?
	call	chkhdr			; Check the tape header
	 ret				; Here if no header
	pop	p,			; Tape header there, return to commands
	ret

rethdr:	iowd	100,hdr			; 100 words for header
	0
hdr:	asciz	/ABCDE/			; To make sure header was read
	block	77
	Subttl	Chkhdr Routine

; This will check the tape's header to see if if has been done yet.
; It returns +1 if there is no recognizeable header. It will return
; +2 if the header is recognizeable and it will tell the user what the
; tape status is, either OK or junk.

chkhdr:	setz	t3,			; Counter offset
	setz	t1,			; Are we ones or zeroes?
	came	t1,hdr
	 seto	t1,			; Must be ones
tstmor:	came	t1,hdr(t3)		; Recognize?
	 ret				; No header here.
	addi	t3,1			; Next word
	caige	t3,100			; All done?
	 jrst	tstmor			; No, look at more of header
	came	t1,[0,,0]		; We have done this one, was it OK?
	 jrst	allone			; No it wasn't
	tmsg	<%Tape already verified, verification was [OK]
>
	retskp
allone:	tmsg	<%Tape already verified, verification failed, possible junk tape
>
	retskp
	Subttl	Push command

.push:	noise	(TO EXEC)
	confirm
	movx	t1,GJ%SHT!GJ%OLD	; Try to get an EXEC
	hrroi	t2,[asciz /SYSTEM:EXEC.EXE/]
	GTJFN%
	 erjmp	[fatal]
	movem	t1,excjfn		; Safe keeping of JFN
	movx	t1,CR%CAP		; Same capabilities for inferior
	CFORK%				; Create another fork
	 erjmp	[fatal]
	movem	t1,fkhan		; Save fork handle for later
	hrl	t1,excjfn		; This gives JFN,,fork handle
	movs	t1,t1			; We want fork handle,,JFN
	GET%				; Map in .EXE pages into fork
	 erjmp	[fatal]
	move	t1,fkhan		; Restore the fork handle
 	setz	t2,			; No offset in entry vector
	SFRKV%				; Start the fork
	 erjmp	[fatal]
	WFORK%				; Wait for it to finish
	KFORK%				; Get rid of it
	ret				; Continue with this program
	Subttl	Set command

; Set one of the flags

.set:	movei	t2,[FLDDB. .CMKEY,,settab]
	COMND%				; Parse set option
	 erjmp	[fatal]			; Lots of problems
	txne	t1,CM%NOP		; No parse?
	 jrst	[error]			; Something GAKKED
	hrrz	t2,(t2)			; Keyword
	jrst	(t2)			; Dispatch to keyword handler

settab:	endset,,endset			; Secondary keyword table for SET
	tbl	(OVERRIDE,,.OVRD)
	tbl	(UNLOAD,,.UNLOD)
endset==<.-settab>-1

onoff:	endon,,endon			; Table for UNLOAD and OVERRIDE
	tbl	(OFF)
	tbl	(ON)
endon==<.-onoff>-1

.unlod:	movei	t2,[FLDDB. .CMKEY,,onoff,,OFF]
	COMND%				; Parse ON or OFF
	 erjmp	[fatal]			; Monitor blues
	txne	t1,CM%NOP		; Did we get one?
	 jrst	[error]			; Tell them so
	seto	t4,			; Flag that we are setting UNLOAD
	hrrz	t2,(t2)
	jrst	(t2)			; Dispatch to flag setting

.ovrd:	movei	t2,[FLDDB. .CMKEY,,onoff,,ON]
	COMND%				; Parse ON or OFF
	 erjmp	[fatal]			; Monitor blues
	txne	t1,CM%NOP		; Did we get one?
	 jrst	[error]			; Tell them so
	setz	t4,			; Flag that we are setting OVERRIDE
	hrrz	t2,(t2)
	jrst	(t2)			; Dispatch to flag setting

.on:	confirm
	camn	t4,[0,,0]		; Override?
	 jrst	[setom	ovride		; Set override flag
		 ret]
	setom	unflg			; Set unload flag
	ret

.off:	confirm
	camn	t4,[0,,0]		; Override?
	 jrst	[setzm	ovride		; Set override flag
		 ret]
	setzm	unflg			; Set unload flag
	ret
	Subttl	Information command handler

; Shows settings for OVERRIDE and UNLOAD.

.show:	noise	(ABOUT PARAMETER SETTINGS)
	confirm
	tmsg	<Unloading after verification: >
	skipe	unflg			; Setting off?
	 jrst	unflg1			; No, it is on
	tmsg	<OFF
>
	skipa	unflg			; Now show override flag
unflg1:	tmsg	<ON
>
	tmsg	<Override tape header: >
	skipe	ovride			; Is override off?
	 jrst	tison			; No, 'tis on
	tmsg	<OFF
>
	ret
tison:	tmsg	<ON
>
	ret
	Subttl	Deassign command

; To deassign the tape drive from user's job.

.deasn:	noise	(CURRENT TAPE)
	confirm
	skipn	tapdes			; Has a drive been assigned?
	 jrst	nodrv			; No, say so.
deasn1:	move	t1,tapjfn		; Put JFN in right side
	CLOSF%				; Close the drive
	 erjmp	[ move	t1,tapjfn	; Try using...
		  txo	t1,CZ%ABT	; ...this set
		  CLOSF%		; Do it again
		   jfcl			; We don't care, we got paid
		  jrst	.+1 ]
	move	t1,tapdes		; Release the tape drive
	RELD%
	 erjmp	[fatal]
	setzm	tapdes			; Get rid of device designator
	tmsg	<Tape drive deassigned - [OK]
>
	setz	t1,			; Get rid of tape drive name
	setz	t2,
	dmovem	t1,jfnmta		; Zero tape drive's name out
	ret

nodrv:	tmsg	<%No tape drive has been assigned, aborting command.
>
	ret
	Subttl	Filtap

; This routine will attempt to fill a tape in the assigned drive
; with data until the EOT marker is reached.

filtap:	call	ctrla			; Enable the ^A interrupt
$fill:	move	t1,tapjfn		; Clear any errors in tape status word
	movei	t2,.MOCLE
	MTOPR%
	 erjmp	[error]
	move	t1,tapjfn		; Tape's JFN
	movei	t2,adrcom		; Address of command list (no flags, wait until data is dumped)
	DUMPO%				; Dump data on tape
	 erjmp	done			; EOT?
	move	t1,tapjfn		; Get tape's JFN
	GDSTS%				; Get its status
	txne	t2,MT%DAE		; Data error in tape?
	 call	backup			; Yes, back up and try again (ret +2)
	setzm	tries			; Zero out error retry counter
	jrst	$fill			; Keep filing it.

done:	caie	t1,IOX4			; EOF?
	 call	[caie	t1,IOX5		; EOT?
		  jrst	[fatal]		; Nope. *GAK*
		 ret]			; Yes, OK
	move	t1,tapjfn		; Find out if we are at EOT or EOF
	GDSTS%
	txnn	t2,MT%EOT!MT%EOF	; End of tape or EOF?
	 jrst	[error]			; Nope. Something barfed out
	tmsg	<
Data written - [OK]
>
	move	t1,tapjfn		; Clear any errors in tape status word
	movei	t2,.MOCLE
	MTOPR%
	 erjmp	[error]

	ret
	Subttl	Rewind

; This routine will rewind the tape.

rewind:	move	t1,tapjfn		; Get tape JFN
	movx	t2,<FLD(^d8,OF%BSZ)!FLD(.GSDMP,OF%MOD)!OF%RD>
	OPENF%				; Get tape ready for verification
	 ercal	devtst			; Is device assigned?
	move	t1,tapjfn		; Clear any errors in tape status word
	movei	t2,.MOCLE
	MTOPR%
	 erjmp	[error]
	move	t1,tapjfn		; Get tape's JFN
	movei	t2,.MOREW		; Rewind the tape
	MTOPR%
	 erjmp	[error]
	move	t1,tapjfn		; Get tape JFN
	movei	t2,.MOREW		; Issue a second rewind so we
	MTOPR%				; so we don't do anything until...
	 erjmp	[error]			; ...the tape is ready
	movx	t1,CO%NRJ		; Don't release the JFN
	hrr	t1,tapjfn		; Put JFN in right half
	CLOSF%				; Close the drive
	 erjmp	[ move	t1,tapjfn	; Try using...
		  txo	t1,CZ%ABT	; ...this set
		  CLOSF%		; Do it again
		   jfcl			; We don't care, we got paid
		  jrst	.+1 ]
	ret
	Subttl	Vertap

; This routine reads each data block and verifies the data to make
; sure there are no tape errors.

vertap:	call	ctrla			; Enable the ^A interrupt
$verfy:	move	t1,tapjfn		; Clear any errors in tape status word
	movei	t2,.MOCLE
	MTOPR%
	 erjmp	[error]
	setzm	bufpag			; First we clear first word in buffer
	move	t1,[bufpag,,bufpag+1]	; Source and
	blt	t1,bufpag+1777		;  destination of zeroing out
	move	t1,tapjfn		; Get tape's JFN
	movei	t2,getdat		; Wait until data is in memory
	DUMPI%				; Read block
	 erjmp	eoft			; EOT?
	call	cmpstr			; Test the data read in
	 call	backup			; Try again on data error (return +2)
	setzm	tries			; Reset retry counter
	jrst	$verfy			; Continue reading data

eoft:	caie	t1,IOX4			; Are we at EOF?
	 call	[caie	t1,IOX5		; Are we at EOT?
		  jrst	[fatal]		; Nope, something went a foul.
		 ret]			; Yes, OK
	move	t1,tapjfn		; Find out if we are at EOT
	GDSTS%
	txnn	t2,MT%EOT!MT%EOF	; End of tape?
	 jrst	bogus			; Nope, something happened (bad tape)
	tmsg	<
Tape verified - [OK]
>					; Tape is A-OK
	call	discta			; Disable the ^A interrupt
	tmsg	<Rewinding...>
	call	rewind			; rewind tape first
	call	dogood			; Put good header on front
back:	call	rewind			; Rewind tape
	tmsg	<
>
	skipe	unflg			; Unload flag set?
	 call	.unld1			; Yes it is, so unload tape
	ret				; No, just return

bogus:	call	discta			; Disable the ^A interrupt
	tmsg	<
%Data error - tape may be no good.
>
	tmsg	<Rewinding...>
	call	rewind			; Rewind tape first
	call	dobad			; Put bad header on front of tape
	jrst	back
	Subttl	Dogood routine

; This routine puts a "Good tape" message at the beginning of the tape.

dogood:	setzm	msg			; Set OK message up
	move	t1,[msg,,msg+1]		; Zero out entire block
	blt	t1,msg+100		; Transfer data
domsg:	move	t1,tapjfn
	movx	t2,<FLD(^d8,OF%BSZ)!FLD(.GSDMP,OF%MOD)!OF%WR!OF%RD>
	OPENF%				; Put message on front of tape
	 ercal	devtst			; Is device assigned?
	move	t1,tapjfn		; Get tape JFN
	movei	t2,mess			; Dump message on tape
	DUMPO%
	 jfcl				; Ignore
	call	rewind
	ret

dobad:	setom	msg			; Set BAD message
	move	t1,[msg,,msg+1]		; Make entire block the same
	blt	t1,msg+100
	jrst	domsg			; Put it on tape
	Subttl	Cmpstr

; This routine compares the data block read in to what was supposed to
; be written onto the tape. It returns +1 if there is a discrepancy and
; +2 if the data blocks match.

cmpstr:	setz	t1,			; We'll use this as index register
cmptst:	move	t2,datpag(t1)		; This is what it should look like
	xor	t2,bufpag(t1)		; This is what it actually is
	came	t2,[0,,0]		; Did they match?
	 ret				; No, data error, ret +1
	addi	t1,1			; Next data location
	caie	t1,2000			; All out of memory locations to test?
	 jrst	cmptst			; No, test some more
	retskp				; Yes, we had data integrity, ret +2
	Subttl	Makdat

; This routine fills up datpag with data. Datpag is the page to be trnasferred
; to tape.

makdat:	hrl	t1,source		; Source of transfer
	hrr	t1,dest			; Destination of transfer
	blt	t1,@finloc		; Transfer all data
	move	t2,finloc		; Get final location
	movem	t2,dest			; It now becomes new destination
	addi	t2,datlen		; Get new final location for BLT
	movem	t2,finloc		; Put it in memory
	caig	t2,datpag+777		; Are we passed end of page?
	 jrst	makdat			; Not yet
	move	t1,[datpag,,datpag+1000]; Make another page just like the other one
	blt	t1,datpag+1777		; Transfer data
	ret				; Now we are!
	Subttl	Ctrla - To enable the ^A interrupt

; This routine will enable the control A interrupt so the user can
; find out what is going on. It also enables the CTRL/E interrupt
; so the user can abort operations.

ctrla:	CIS%				; Let's get rid of any stray ^A's
	movei	t1,.FHSLF		; This fork
	move	t2,[levtab,,chntab]	; Setup interrupts
	SIR%
	movei	t1,.FHSLF		; This fork
	EIR%				; Enable interrupts
	movei	t1,.FHSLF		; This fork
	movx	t2,1b0!1b1!1b2		; Activate channels 0,1 & 2
	AIC%
	move	t1,[.TICCA,,0]		; Assign CTRL/A to channel 0
	ATI%
	move	t1,[.TICCE,,1]		; Assign CTRL/E to channel 1
	ATI%
	move	t1,[.TICCC,,2]		; Assign CTRL/C to channel 2
	ATI%
	ret				; All done
	Subttl	Discta - To disable a no longer needed ^A

; This routine simply diables the CTRL/A interrupt since it won't
; be needed any more. It also disables the CTRL/E interrupt.

discta:	movei	t1,.FHSLF		; This fork
	DIR%				; Disable interrupts
	movx	t1,.TICCA		; DEassign channel 0
	DTI%
	movx	t1,.TICCE		; Deassign channel 1
	DTI%
	movx	t1,.TICCC		; Deassign channel 2
	DTI%
	CIS%				; Clear any stray interrupts
	ret				; As simple as that!
	Subttl	Chn0sv - Channel 0 server

; This routine handles the ^A (channel 0) interrupt service.

chn0sv:	movem	t1,lv3ac		; Save ACs of interrupted process
	move	t1,[t2,,lv3ac+1]	; in private area for level 3
	blt	t1,lv3ac-t1+p
	move	t1,tapjfn		; Get tapes JFN
	movei	t2,.MOINF		; We want tape information
	movei	t3,tapinf		; Return data here
	MTOPR%				; Get information
	 erjmp	[error]
	tmsg	<
MTVRFY: At record >
	movei	t1,.CTTRM		; Print on this terminal
	move	t2,tapinf+.MOIRC	; How many records
	movx	t3,<FLD(7,NO%COL)+FLD(12,NO%RDX)>
	NOUT%				; Tell us how many records
	 erjmp	[fatal]
	move	p,[lv3ac,,t1]		; Restore ACs of interrupted
	blt	p,p			; process
	DEBRK%				; Return to interrupted process
	Subttl	Back Routine

; This routine will back up a tape one record so that another attempt
; may be made to read/write from/to it. If there are more than 10 
; consecutive errors, the tape is assumed to be bogus. This routine
; will always return +2 EXCEPT when a bogus tape is found.

backup:	move	t1,tapjfn		; Get tape's JFN
	movei	t2,.MOBKR		; Back up one record
	MTOPR%
	 erjmp	[error]
	aos	tries			; Add one to number of tries
	move	t1,tries		; How many times have we done this?
	cail	t1,maxtry		; More than allowed?
	 jrst	[pop	p,		; Too many retries, pop twice so we can
		 pop	p,		; return to command level
		 jrst	bogus]		; Tape is no good
	retskp				; Return +2 when less than max. retries
	Subttl	Chn1sv - Channel 1 interrupt service routine

; This routine handles the ^E interrupt. The user wants to abort
; verification.

chn1sv:	movei	t1,.PRIOU		; Let's not wait.
	CFOBF%				; Clear output
	call	discta			; Can all interrupts
	tmsg	<
%Aborting verification...>
	call	rewind			; Rewind tape first
	move	p,[iowd pdlen,stack]	; Stack re-initialization
	tmsg	<
>
	jrst	toplev			; Back to top level
	Subttl	Chn2sv - Channel 2 service routine

; This routine prevents the user from ^C out of the verification
; process. ^E must be used for aborting.

chn2sv:	movem	t1,lv2ac		; Save ACs of interrupted process
	move	t1,[t2,,lv2ac+1]	; in private area for level 3
	blt	t1,lv2ac-t1+p
	tmsg	<
%Use ^E to abort verification.>
	move	p,[lv2ac,,t1]		; Restore ACs of interrupted
	blt	p,p			; process
	DEBRK%				; Return to interrupted process
	
	end	<evecl,,evec>