.MCALL	.MODULE
.MODULE	BUPSUB,VERSION=15,IDENT=NO

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion of the above copyright notice.  This software,  or
; any other copies thereof, may not be provided  or  otherwise
; made available to any other person except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.

	DEBUG = 0
	DELAY = 0
	.SBTTL	Global (root) BUP Subroutines
	.ENABL LC,GBL
;
; Edit revision:
;
; 12-Jul-89	RHH	V5.5 work

	.SBTTL	Data and Macro definitions

	.MCALL	.FETCH,	.LOOKU,	.READW,	.DSTAT,	.CLOSE
	.MCALL	.PRINT,	.SPFUN,	.WRITW,	.HERR,	.SERR
	.MCALL	.WAIT,	.PURGE,	.TTYOUT,.ENTER, .EXIT
	.MCALL	.GTLIN,	.GVAL,	.BR,	SOB

	.MACRO	.DBTYP	MSG		; Type a debug message
	.IF NE	DEBUG
	.PRINT	MSG
	.IFF
	.ENDC
	.ENDM

	.MACRO	......
	.ENDM


	.SBTTL	Magtape Status bit definitions

TS.NAV	==:	000001		; Tape Drive Not Available
TS.SHT	==:	000002		; Short block read
TS.LNG	==:	000004		; Long block read
TS.LOS	==:	000010		; Tape Position Lost
TS.EOT	==:	000020		; Tape is past EOT foil
TS.EOF	==:	000040		; Last command encountered tape mark
TS.WPR	==:	000100		; Writing prohibited
TS.NXM	==:	000200		; Non-existent memory accessed
TS.SEL	==:	000400		; Select error on unit
TS.REW	==:	001000		; Unit is rewinding
TS.WLK	==:	002000		; Unit is write-locked
TS.BOT	==:	020000		; Tape is at load point
TS.ERR	==:	100000		; Read error
	.SBTTL	TSETB1 - Magtape error status tables

	.PSECT	MTSUB,D
	.NLIST	BEX

; Magtape error status tables for SPFUN read/write status

TSETB1:	.WORD	TS.ERR		; SPFUN EOF  error 0
	.WORD	TS.EOF		;            error 1
	.WORD	TS.EOT		;            error 2
	.WORD	TS.EOF+TS.EOT	;            error 3

TSETB2:	.WORD	TS.ERR		; SPFUN hard error 0
	.WORD	TS.NAV		;            error 1
	.WORD	TS.LOS		;            error 2
	.WORD	TS.NXM		;            error 3
	.WORD	TS.WLK		;            error 4
	.WORD	TS.LNG		;            error 5
	.WORD	TS.SHT		;            error 6

TPSTAT::.WORD	0		; tape unit status word
TPLOOK:	.BYTE	0		; tape looked up flag
	.EVEN

OPCODE:	.WORD	0		; used for magtape SPFUNS
COUNT:	.WORD	0
BUFF:	.WORD	0

NOTRDY::.ASCII	/?BUP-W-Tape unit not ready; Continue? /<200>
MSPFN:	.ASCIZ	/?BUP-F-Unexpected error in .SPFUN/

.IF NE	DEBUG
FSRMSG:	.ASCIZ	/Forwardspace Record/
BSRMSG:	.ASCIZ	/Backspace Record/
FSFMSG:	.ASCIZ	/Forwardspace File/
BSFMSG:	.ASCIZ	/Backspace File/
.ENDC
	.EVEN
	.SBTTL	WKAREA for IGTDIR and IGTENT

WASIZE	==:	64.			; work area size

; FORTRAN-style argument block for IGTDIR()

IGDBLK::.WORD	7			; IGTDIR arg block
	.WORD	WASIZV			; address of work area size variable
WKARED::.WORD	0			; address of work area
IGDCHN::.WORD	INCHAN			; address of channel
IGDBUF::.WORD	0			; address of buffer
	.WORD	DHEDR			; address of returned header
IGDDEV::.WORD	IG.DEV			; address of DBLK
	.WORD	ASCLST			; address of wildcard string 

; FORTRAN-style argument block for IGTENT()

IGEBLK::.WORD	5			; IGTENT arg block
WKAREA::.WORD	0			; address of work area
	.WORD	DIRENT			; address of dir entry
	.WORD	ENTOFS			; address of entry offset
	.WORD	FILBLK			; address of file block
	.WORD	ASCNAM			; address of filename string

DHEDR:	.BLKW	5			; returned header buffer
	.BLKW	5			; space for weird headers
IG.DEV::.WORD	0,6,0,0		; already open, dir block, return_match, 0
WASIZV:	.WORD	WASIZE			; work area size variable

DIRENT::.BLKW	7			; Returned directory entry
ENTOFS::.BLKW	1			; Returned Entry Offset
FILBLK::.BLKW	1			; Returned file block number
ASCNAM::.BLKB	12.			; Returned filename.ext
	.SBTTL	CHKVID - Check volume ID
	.PSECT	SUBROU,I
;+
; The homeblock of the device which has been opened NFS is read.
; It is determined if it is a backup volume by checking that the 
; word 'BUP' is stored at offset 252.  If the volume is not
; a backup volume a flag is set for the return to caller.
;
;   Calling sequence:
;	R1 = CHANNEL NO.
;	CALL	CHKVID
;
;   On return:
;	R1 is meaningless
;	R2 is meaningless
;	C-BIT	= 0 SUCCESS
;		= 1 ERROR  (IF BIT7 OF NOTBAK FLAG IS SET, THE ERROR IS
;			    BECAUSE THE VOLUME IS NOT A BACKUP VOLUME)
;
;-
	.ENABL	LSB

CHKVID::MOV	#LBLBUF,R2		; Point to label buffer
	.READW	#EMTARE,R1,R2,#256.,#HMBLK	; Read the home block
	BCC	10$			; Branch if no error
	CALL	ERR1			; <-E-Device I/O error dev:>
	BR	20$			; Bad exit
	......

10$:	CMP	DK.TAG(R2),#BU.TAG	; Contains "BU"
	BEQ	30$			; Yes return
	MOVB	#BIT7,NOTBAK		; Set bit flag
20$:	SEC				; Indicate NOT OK
30$:	RETURN
	......

	.DSABL	LSB
	.SBTTL	GSIZE - Get device size
;+
; Perform .DSTATUS to obtain the size of a device.
; If the device is a variable size type, issue an SPFUN 373 
; to obtain the actual size.
;
;	DEVSPC	-> DEVICE IN QUESTION
;
;	CALL	GSIZE
;
;	R1 = DEVICE SIZE IN BLOCKS
;
;	C-BIT	= 0 SUCCESS
;		= 1 ERROR
;-
	.ENABL	LSB

GSIZE1::MOV	OUTCHA,CHANEL		; OUTPUT Channel 
	BR	10$			; Skip next

GSIZE::	MOV	INCHAN,CHANEL		; INPUT Channel 
10$:	.DSTATU	#DEVBLK,#DEVSPC		; Get the status
	MOV	#DEVBLK,R2		; Get address of status
	BIT	#VARSZ$,(R2)		; Variable size device?
	BNE	15$			; yes, branch
	MOV	6(R2),R1		; Size is in dstatus block
	BR	50$			; Good exit
	......

; This is often the first real I/O operation to a device.  If
; it fails, it may be because a diskette is not properly mounted.
; Be charitible in certain instances so that we don't fatal-out
; on the 83rd floppy of a restore operation.

15$:	.SPFUN	#EMTARE,CHANEL,#SF.SIZ,#FUNBUF,#1,#0,#0	;Get size
	BCC	40$			; Branch if no error
	CALL	ERR1			; <-E-Device I/O error dev:>
	CMP	CHANEL,OUTCHA		; Is the channel an OUTPUT channel?
	BEQ	20$			; branch if so.
	BIT	#I$OPT,OPTACT		; Is it BACKUP/DEVICE?
	BNE	60$			; if so, don't prompt.
	CALL	MXPRMT			; Prompt for INPUT volume
	BR	30$
	......

20$:	CALL	PROM1			; Prompt for OUTPUT volume
30$:	BCC	15$			; Branch on YES
	JMP	START2			; No, so start BUP over.
	......

40$:	MOV	FUNBUF,R1		; Get size
50$:	TST	(PC)+			; Skip next, clear carry
60$:	SEC				; Set carry
	RETURN
	......

	.DSABL	LSB
	.SBTTL	DYNBUF - Dynamic memory calculations
;+
; This subroutine calculates the number of blocks that can be read
; at once given a range of addresses. The calling program provides
; the starting address and this is used with the top address available
; to the program to calculate the block chunks.  The equivalent 
; word count is also calculated.
;
;	TOPADD -> Highest address available to program
;
;	BUFADD -> Address to start buffer area
;
;	CALL DYNBUF
;
;	R3 = Blocks available
;
;	R5 = Equivalent wordcount
;
;-
	.GLOBL	TOPADD,BUFADD
	.ENABL	LSB

DYNBUF::	
	MOV	TOPADD,R2		;Save the highest address
	ADD	#2,R2			; adjust for subtract
	SUB	BUFADD,R2		;Calculate the amount of memory
	CLC				;Clear carry before rotate
	ROR	R2			;Make byte size word size
	SWAB	R2			;Divide by eight
	BIC	#177400,R2		;R2 contains number of blocks
	MOV	R2,R3			;Save it
	SWAB	R2			;Get wordcount
	MOV	R2,R5			;Save wordcount

.IF NE DEBUG
	MOV	R4,-(SP)		;*** Just for testing
	.PRINT	#BUFSPC
	MOV	R3,R2
	CALL	DECIMA
	.PRINT	#CRLF
	MOV	(SP)+,R4
	RETURN
BUFSPC: .ASCII	/The number of blocks for buffer space is /<200>
	.EVEN
.ENDC; NE DEBUG

	RETURN
	......

	.DSABL	LSB
	.SBTTL	CALBUF - Calculate the number of 2K word buffers
;+
; From the amount of free memory available it is calculated how many 2K
; word buffers can exist. This is done simply by dividing by 256 first
; and then dividing by eight, (remember 1/4K words is equal to 256 words).
; The number of buffers must be even, because equal amount is going to
; be used for the read and write buffer during the double buffering scheme.
;
;		BUFFERING MAP
;
;		  RMON
;		|----------|
;		|  2K	   |
;		|----------|
;		|  2K	   |  ---> TAPE SUBDIVIDED BUFFER
;		|----------|
;		|  2K	   |
;		|----------|
;		|	   |
;		|	   |
;		|  6K	   |   --->  DISK BUFFER 
;		|          |
;		|	   |
;		|----------|
;		| BUP TOP  |
;-

	.ENABL	LSB

CALBUF::CALL	DYNBUF			; Calculate memory available
	SWAB	R5			; Divide by 256
	BIC	#177400,R5		; Get right result
	ASR	R5			; Divide
	ASR	R5			;       eight
	ASR	R5			;             blocks per buf
	BIC	#BIT0,R5		; Make even
	BEQ	10$			; Branch if zero

.IF NE DEBUG
	MOVB	R5,R1			; To print it
	ADD	#60,R1			; for now make it ASCII
	MOVB	R1,PART1		; store it to print
	.PRINT	#MESS			; print message
.ENDC; NE DEBUG
	RETURN
	......

10$:	CALL	IFCLOT			; Close tape channel if open.
	MOV	#MEM,R1
	JMP	FATAL
	......

.IF NE DEBUG
MESS:	.ASCII	/The number of 2K buffers is /
PART1:	.BYTE	0,12,15,200
	.EVEN
.ENDC; NE DEBUG

	.DSABL	LSB 
	.SBTTL	XMBUFR - If XM, Set BUFADD to HIGH MEM

	.ENABL	LSB 

XMBUFR::BIT	#XM$REG,OPTAC2		; High-mem buffer in-place?
	BEQ	10$
	MOV	#XMBUFA,BUFADD		; If so, point to it,
	MOV	#XMTOPA,TOPADD		; and set new TOP address.
10$:	RETURN
	......

	.DSABL	LSB 

	.SBTTL	GTSPAD - Get address of spfuns buffer
;+
; Given the number of Spfuns to be issued (tape) you can calculate the size
; of the blocks to be read/write from/to disk (RBLOCK). The address where
; the second buffer is going to start is also calculated here and stored 
; in SPFBUF.
;
;-
	.ENABL	LSB

GTSFAD::MOV	NUMSPF,R1		; R1 = number of spfuns
	MOV	BUFADD,R2		; R2 = start addr of buffer
	MOV	RBLOCK,R3		; R3 = read blocks
10$:	ADD	#TREC,R2		; Past one buffer
	ADD	#TBLOCK,R3		; Count blocks
	SOB	R1,10$			; Loop till finish
	MOV	R3,RBLOCK		; Blocks for read
	MOV	R2,SPFBUF		; Address of spfun buffer
20$:	RETURN
	......

	.DSABL	LSB
	.SBTTL	ANSWER - Process response to question
;+
; This subroutine handles the answering of the questions issued by 
; backup to the user. The yes answer is taken any time the user
; types the letter 'y' first, anything that starts with 'n' is  no. The 
; routine also flushes any garbage entered until the line feed.
;
;	CALL	ANSWER
;
;	R0 =	1 --> YES
;		0 --> NO
;	       -1 --> ANYTHING ELSE
;
;-

	.ENABL	LSB

ANSWRP::
	BIS	#EDIT$,@#$JSW		;Don't allow SL editing
	.PRINT	R1			;So that prompts come out in IND
ANSWER::
	BIS	#GTLIN$,@#$JSW		;Set .GTLIN as non-terminating
	.GTLIN	#CMDLIN,,TERM		;Get the user's response
10$:	BIC	#<GTLIN$!EDIT$>,@#$JSW	;Reset .GTLIN and SLEDIT bits
	MOV	R1,-(SP)		; Save R1
	MOV	#-1,R0			;Default to ELSE
	MOVB	CMDLIN,R1		;Any response?
	BEQ	ELSE			;Nope, take ELSE return
	BIC	#40,R1			;make it UPPER case
	CMPB	R1,#'N			;is first character an 'N'?
	BEQ	NO			;Yes, take NO return
	CMPB	R1,#'Y			;Nope, was it a 'Y'?
	BNE	ELSE			;Nope, take ELSE return
YES:	INC	R0			;'Y' return bumps R0 twice (to 1)
NO:	INC	R0			;'N' return bumps R0 once (to 0)
ELSE:	MOV	(SP)+,R1		; Restore R1
	TST	R0			;Set status bits here
	RETURN				;'ELSE' return leavs R0 as -1
	......

	.DSABL	LSB
	.SBTTL	QABOR  - Query for abort of operation
;+
; The user is asked whether to exit BUP in the middle of a backup or 
; restore operation.
;-
	.ENABL	LSB

QABOR::	MOV	#ABOMSG,R1		; Let R1 point to prompt,
	CALL	ANSWRP			; Prompt and get YES/NO answer
	BMI	QABOR			; Neither, try again.
	BNE	ABOOP			; YES? Then ABORT BUP.
	RETURN				; Otherwise just return.
	......

; Abort BUP

ABOOP::	MOV	#ABO,R1			; <-F-Operation not completed>
	JMP	FATAL
	......

; Assemble a MOUNT prompt into one buffer so that GTLIN will work
; properly with SL.

MXPRMT::JSR	R5,STRNCP		; Copy 1st part of prompt to CMDBUF
	.WORD	CMDBUF
	.WORD	MXCOP
	.WORD	19.

	MOV	VOLNUM,R2		; Cvt/Copy volume number to CMDBUF
	MOV	#CMDBUF+19.,R1
	CALL	DECIMB
	MOV	R1,10$			; Use next avail char for mesend...

	JSR	R5,STRNCP		; Copy message end to CMDBUF,
10$:	.WORD	0.
	.WORD	MESEND
	.WORD	20.

20$:	MOV	#CMDBUF,R1		; Do prompt with answer...
	CALL	ANSWRP
	BMI	20$			; Not a good answer?  Ask again.
	BR	PRRETN			; return below
	......

	.DSABL	LSB
	.SBTTL	PROM1  - Prompt for output volume
;+
; Prompt user "Mount output volume".  User answers YES or NO.
; Return with carry clear if YES and carry set if NO.
;-
	.ENABL	LSB

PROM1::
10$:	MOV	#MESCOP,R1		; Point to question...
	CALL	ANSWRP			; Do prompt, get answer
	BMI	10$			; Not Y or N - re-ask.
PRRETN:	BNE	20$			; Branch if YES
	SEC				; Otherwise it's NO
20$:	RETURN
	......

; Prompt for output volume, and offer 2nd chance.

PROM2::	CALL	PROM1			; Prompt for output vol
	BCC	20$			; return on YES
	CALL	QABOR			; NO.  Ask "Are you sure?"
	BR	PROM2			; if "NO", ask again.
	......

	.DSABL	LSB
	.SBTTL	SETNAM  - Setup device name for message
;+
; The ASCII input device is loaded into the message pointed to
; by R4.  If the last character of the device is a blank it is 
; substituted by a zero.
;
;	MOV	#ascnam,R1		; R1 -> adr where device name is
;	MOV	#msgare,R4		; R4 -> adr to store device name
;	CALL	SETNAM
;
;	MOV	#msgare,R4		; R4 -> adr to store device name
;	CALL	SETINA			; uses INASC as source string
;
; and 	CALL	SETRES			; for RESTORE code
;-
	.ENABL	LSB

SETRES::MOV	#XDEV,R4		; R4 -> adr to store device
SETINA::MOV	#INASC,R1		; R1 -> adr where device is
SETNAM::MOV	#3,-(SP)		; count 3 characters
10$:	MOVB	(R1)+,@R4		; load a character
	CMPB	@R4,#40			; blank?
	BNE	20$			; branch if not.
	MOVB	'0,@R4			; otherwise, substitute zero.
20$:	INC	R4			; point to next output char
	DEC	@SP			; count chars
	BGT	10$			; loop if more to do.
	TST	(SP)+			; give back local counter
	RETURN
	......

	.DSABL	LSB
	.SBTTL	STRNCP - String copy with maximum length
;+
; Copy a fixed-length string from one location to another.
;
;	JSR	R5,STRNCP
;	.WORD	<dest_ptr>
;	.WORD	<src_ptr>
;	.WORD	<max_len>
;-

	.ENABL	LSB

STRNCP::MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	(R5)+,R1		; get destination address
	MOV	(R5)+,R2		; get source address
	MOV	(R5)+,R0		; get length
10$:	MOVB	(R2)+,(R1)+		; loop through
	BEQ	20$			; until NULL
	DEC	R0			;  or count exhausted.
	BGT	10$
20$:	MOV	(SP)+,R2
	MOV	(SP)+,R1
	RTS	R5
	......

; Check strings for equality;
;
;	R0 -> string 1
;	R1 -> string 2
;	R3 -> length limit
;	CALL STRNCM
;
; Returns Carry SET if match, CLEAR if nomatch

STRNCM::
30$:	CMPB	@R0,(R1)+		; Compare the characters...
	BNE	60$			; If not, go ahead and keep searching
	TSTB	(R0)+
	BEQ	50$			; NULL on string 1?
	DEC	R3
	BGT	30$
40$:	SEC
	RETURN				; Return with name match
	......

50$:	TSTB	-(R1)			; NULL on string 1 must be matched
	BEQ	40$
60$:	CLC				; Return with NO name match
	RETURN
	......

	.DSABL	LSB
	.SBTTL	PURGTM - Purge temporary file
;+
; Purge temporary file.  If it was made by MAKDIR (in BUPCMD), then
; invalidate the directory by zeroing the first word in block 6.
;-

	.ENABL	LSB

PURGTM::
	TSTB	TMPOPN			; Is temporary BOOT/HOME/DIR file open
	BEQ	10$
	CLR	LBLBUF			; Set D.TOTA = 0
	.WRITW	#EMTARE,TMPCHA,#LBLBUF,#256.,#6	; invalidate the directory
10$:	.PURGE	TMPCHA			; Purge out the temporary file
	CLRB	TMPOPN
	RETURN
	......

	.DSABL	LSB
	.SBTTL	SELECT - RAD50 to ASCII conversion routine
;+
;
;  SELECT - CONVERT a specified number of RAD50 words to ASCII
;
;	R2 -> address of RAD50 word(s)
;	R1 -> address of where to store ASCII 
;	R5  = number of words to be converted
;
;	CALL	SELECT
;
;	R0,R2,R3,R4 - are PRESERVED
;	R1 is INCREMENTED to the next available output position
;	R5 is DESTROYED
;-

	.ENABL	LSB

SELECT::MOV	R0,-(SP)
	MOV	R2,-(SP)
10$:	MOV	(R2)+,R0		; Get RAD50 word
	CALL	$R50ASC			; use ULB routine
	DEC	R5			; loop until done.
	BGT	10$
	MOV	(SP)+,R2
	MOV	(SP)+,R0
	RETURN
	......

	.DSABL	LSB
	.SBTTL	CNVRT  - ASCII-to-RAD50 routine 
;+
; This routine is used to convert ASCII to RAD50.
; The two entry points allow conversion of either 9 or 21 characters.
;
; R1 -> ASCII source string
; R3 -> RAD50 destination
;-
	.ENABL	LSB

CNVRT7::MOV	#7,-(SP)		; Do 7 words of RAD50
	BR	10$
	......

CNVRT3::MOV	#3,-(SP)		; Do 3 words of RAD50

10$:	CALL	$ASCR5			; convert 3 chars ASCII to RAD50
	MOV	R0,(R3)+		; store result
	DEC	@SP			; count down
	BGT	10$
	TST	(SP)+			; Fix stack
	RETURN
	......

	.DSABL	LSB
	.SBTTL	DECIMA - Binary to Decimal conversion routine
;+
; This routine converts a binary number stored in R2 to a decimal
; ASCII representation and prints it.
;
;	R2 = Binary number to be printed
;	CALL	DECIMA	; to send output to TT:
;
;   or  CALL	DECIMF 	; to send output to the list file
;
;   on return,
;
;	R4 = Number of characters printed
;-
	.ENABL	LSB

DECIMA::MOV	R1,-(SP)		; Output decimal value to console
	CALL	DECRDY			; convert and let R0 point to result
	.PRINT				; display result
	BR	10$			; return.
	......

DECIMF::MOV	R1,-(SP)		; Same, except output to file.
	CALL	DECRDY
	CALL	DOLINE			; Call Line output routine
10$:	MOV	(SP)+,R1		; return.
	RETURN
	......

DECRDY:	MOV	#CMDLIN,R1		; Use CMDLIN as temp buffer
	CALL	DECIMB			; do conversion,
	MOVB	#200,@R1		; plant terminator
	MOV	#CMDLIN,R0		; point to the number
	RETURN
	......

; Decimal-to-ASCII, R2=num, R1->buf

DECIMB::CLR	R4			; Clear register four	
DECIM1:	MOV	R2,-(SP)		; Store the value
	CLR	R2			; Serve as counter
20$:	INC	R2			; Count one
	SUB	#10.,(SP)		; Divide by repetive subtract
	BHIS	20$			; Branch if not minus
	ADD	#10.+60,(SP)		; Restore the remaining number
	INC	R4			; Count character
	DEC	R2			; Decrement counter
	BEQ	30$			; If = 0 finish
	CALL	DECIM1			; Repeat if not

30$:	MOV	(SP)+,R0
	MOVB	R0,(R1)+
	RETURN				; Keep printing till return address
	......

	.DSABL	LSB
	.SBTTL	ASCBIN - Convert unsigned ASCII digit string to binary
;
;	R2 - points to character string
;	R3 - no. of chars in field
;	CALL ASCBIN
;	(R2 and R3 are modified)
;	R0 - returned product
;	R1 - scratchpad (saved)
;
	.ENABL	LSB

ASCBIN::MOV	R1,-(SP)
	CLR	R0			; Init product.
	BR	20$
	......

10$:	MOV	R0,R1			; multiply value by 10.
	ASL	R0			; * 2,
	ASL	R0			; * 4,
	ADD	R1,R0			; * 5
	ASL	R0			; * 10.

20$:	MOVB	(R2)+,R1		; Get digit
	CMPB	R1,#40			; BLANK? ignore it.
	BLT	40$			; NULL or other CTRL-char?
	BGT	30$			; ignore BLANKs
	DEC	R3
	BGT	20$
	BR	40$
	......

30$:	CMPB	R1,#'9			; Not a digit?
	BHI	40$			; terminate if so.
	SUB	#'0,R1			; Otherwise, get digit value
	ADD	R1,R0			; Accumulate in product
	DEC	R3
	BGT	10$			; more to do.
40$:	MOV	(SP)+,R1
	RETURN
	......

	.DSABL	LSB
	.SBTTL	SEGVAL - Check for valid RT-11 directory segment
;+
; Check an RT-11 directory header for validity.  Return CARRY_CLEAR
; to indicate VALID or CARRY_SET to indicate NOT_VALID.
;
;	MOV	address of header,R1
;	CALL	SEGVAL
;-
	.ENABL	LSB

SEGVAL::MOV	R0,-(SP)
	MOV	R1,-(SP)		; save the pointer
	MOV	R2,-(SP)

	MOV	(R1)+,R0		; get D.TOTA
	CMP	R0,#1			; compare low limit
	BLO	90$			; bad if less than 1
	CMP	R0,#31.			; compare high limit
	BHI	90$			; bad if higher than 31
	MOV	(R1)+,R2		; get D.NEXT
	BLT	90$			; can't be less than zero
	CMP	R2,R0			; can't be more than D.TOTA
	BHI	90$
	MOV	(R1)+,R2		; get D.HIGH
	CMP	R2,R0			; can't be more than D.TOTA
	BHI	90$
	TST	R2			; check D.HIGH again
	BLT	90$			; D.HIGH can't be less than 0
	MOV	@R1,R0			; get D.EXTR
	CMP	R0,#128.		; check against reasonable limit
	BHI	90$			; Branch if bad
	ROR	R0			; check its evenness
	BR	100$			; C-bit has final status.

90$:	SEC
100$:	MOV	(SP)+,R2		; restore used registers
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN
	......

	.DSABL	LSB
	.SBTTL	FETHAN - Fetch handler
;+
; The handler for the device stored at DEVSPC is loaded at address 
; supplied. On return the next free address above the handler loaded
; is returned in R0.
;-
;
;	MOV	<addr>,R1		; address to load handler
;	MOV	<dev>,DEVSPC		; device name
;	CALL	FETHAN
;
;	R0 = first free address above handler
;
	.ENABLE	LSB

FETHAN::.FETCH	R1,#DEVSPC		; load handler
	BCC	RTN1			; return on no error
	MOV	#FET,R1			; <-F-Fetch error <dev>>
	.BR	FATALD

	.SBTTL	FATAL - Fatal error exits

; Global error routines, FATAL and NON-FATAL
;
; R1 = Error Code Mneumonic
; R3 = Address of Device/File Spec (FATAL3)

FATALD::MOV	#DEVSPC,R3		; Fatal with DEV: name
	BR	FATAL3

FATALI::MOV	#INFIL,R3		; Fatal with input file name
	BR	FATAL3

FATALO::MOV	#OUTFIL,R3		; Fatal with output file name
	BR	FATAL3

FATAL::	CLR	R3			; Fatal with no file or dev name
FATAL3::.ERR	#ERRARE,R1,LEVEL=FATAL,RETURN=NO,FILE=R3
	......

; Display an E-level error message and return to the caller

ERR1::	MOV	#RE1,R1			; <-E-Device I/O error dev:>
ERRR::	.ERR	#ERRARE,R1,LEVEL=ERROR,RETURN=YES,FILE=#DEVSPC
RTN1:	RETURN
	......

; Display an informational message and return to the caller

INFORM::.ERR	#ERRARE,R1,LEVEL=INFORM,RETURN=YES
	RETURN
	......

	.DSABL	LSB
	.SBTTL	TLOOK - LOOKUP routine
;+
; The routine does a non-file structured lookup NFS on the disk 
; or tape depending on the entry point.
;
;	R1 -> File/device specification
;	R2 -> channel
;
;	CALL	LOOK     OR 	CALL 	TLOOK
;-
	.ENABL	LSB

LOOK::	CLRB	TPLOOK			; Record entry through LOOK
	.SERR
10$:	CALL	LOOKU			; Do DISK lookup 
	BCC	100$			; Branch if no error
	BR	30$			; Branch if error
	......

TLOOK::	MOVB	#1,TPLOOK		; Record entry through TLOOK
	.SERR
	CLR	LKBLK
20$:	CALL	LOOKU			; Do TAPE lookup
	BCC	90$			; Branch if no error

30$:	MOVB	@#$ERRBY,R0		; let R0 = $ERRBY
	BMI	60$			; Branch if .SERR in effect.
	BGT	40$			; Branch if NOT (Channel in use)
	MOV	#LO2,R1			; <-F-Channel in use>
	BR	FATAL
	......

40$:	MOV	R1,R3			; Get ready for FATAL errmsg
	CMPB	R0,#2			; File not found?
	BNE	50$			; Yes, branch
	MOV	#LO3,R1			; <-F-Device in use <dev>>
	BR	FATAL3
	......

50$:	MOV	#LO1,R1			; <-F-File not found>
	BR	FATAL3
	......

; This is a "forgiving" LOOKUP; the mounted volume could be the
; umpteenth output volume of a long backup.  We wouldn't want to
; coldly EXIT if the volume was inadvertently left off-line.

60$:	.PURGE	@R2
	MOV	R1,-(SP)		; Save pointer to DBLK
	CALL	ERR1			; <-E-Device I/O error dev:>
	MOV	@(SP),R0		; Word to convert (pushed R1)
	MOV	#DEVICE,R1		; R1->BUFFER
	CALL	$R50ASC			; convert to ASCII
70$:	CALL	PROM1			; Prompt MOUNT... and get answer
	BCC	80$			; If YES, continue.
	JMP	START2			; Otherwise, get out now.
	......

80$:	MOV	(SP)+,R1		; R1-> RAD50 filespec
	TSTB	TPLOOK			; Was this a TAPE lookup?
	BNE	20$			; if so go start there again.
	BR	10$			; otherwise, do DISK LOOKUP again.
	......

90$:	MOVB	#1,TPOPEN		; Declare TAPE OPEN
	MOV	@R1,TAPDEV		; Save its name
100$:	MOV	R0,-(SP)		; save size across .HERR
	.HERR
	MOV	(SP)+,R0		; restore size
	RETURN
	......

LOOKU:	.LOOKUP	#EMTARE,@R2,R1,#-1	; The LOOKUP request
	RETURN
	......

; CLOSE tape channel

IFCLOT::TSTB	TPOPEN			; Tape channel open?
	BEQ	110$			; If not, just return
CLOTAP::.CLOSE	TAPCHA			; Close the tape channel.
	CLRB	TPOPEN			; Clear the OPEN flag byte
110$:	RETURN				; Return.
	......

	.DSABL	LSB
	.SBTTL	MAGTAPE ROUTINES
	.SBTTL	READMT - Read a magtape record
;+
; This routine is called to read 256-word magtape records.
; .SPFUN is used so that the extra information can be obtained.
;	
;	R1 -> buffer 
;	TAPCHA = channel used for tape operation
;
;	CALL READMT
;-

	.ENABL	LSB

READMT::MOV	#SF.MRD,R0		; Get code for read 
	MOV	#256.,COUNT		; load word count variable,
	BR	MTRW			; Do common code below
	......

	.SBTTL	MTWR80 - Write 80-character label record
;+
; Write ANSI label to magtape
;-

MTWR80::				; write 80-char block
	MOV	#SF.MWR,R0		; opcode
	MOV	#40.,COUNT		; (80 chars = 40 words)
MTRW:	MOV	R1,BUFF
10$:	CALL	MTOP			; Issue the .SPFUN to write block
	BCC	20$			; return on success.
	CALL	CHKWRL			; Error.  Write locked?
	BCS	30$			; If so, handle it.
	SEC				; No.  Some other kind of error.
20$:	RETURN
	......

; We're here only if WRITE_PROTECT was discovered writing a VOL1 label,
; and the user was queried to correct the problem.

30$:	CALL	REWIND			; re-init controller 
	.WAIT	TAPCHA			; wait for rewind
	BR	MTWR80			; and retry label write.
	......

	.DSABL	LSB
	.SBTTL	RWVMT - Read/Write variable size magtape records
;+
; Read or write the variable size records that BUP uses on magtapes. 
; This size is 2K word records instead of the usual 256word/record.
; R5 indicates the function, and R2 contains the address of the buffer.
;
; A read/write-WITHOUT-WAIT is performed.  The application should use
; .WAIT before using the data.
;
;	JSR	R5,RWVMT
;	.WORD	CODE			; the SPFUN code
;-
	.ENABL	LSB

RWVMT::	CLR	TPSTAT			; Reset status word
	.SPFUN	#EMTARE,TAPCHA,@R5,R2,#TWNCT,#LKBLK,#1
	BCC	10$
	CALL	CHKWRL			; Write lock error?
	BCS	RWVMT			; If so, try again.
	SEC				; re-set SPFUN's carry
10$:	BITB	(R5)+,(R5)+		; Fix R5
	RTS	R5			; return.
	......

	.DSABL	LSB

	.SBTTL	TEOF   - Test for tapemark
;+
; Check magtape for having just passed a tapemark.
;-
	.ENABL	LSB

TEOF::	CLC
	BIT	#TS.EOF,TPSTAT
	BEQ	10$
	SEC
10$:	RETURN
	......

	.DSABL	LSB
	.SBTTL	GMTSTA - Get magtape status
;+
; Get Magtape Status
;-
	.ENABL	LSB

GMTSTA::ROR	R0			; Save carry bit
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	TST	R0
	BPL	50$			; No carry bit?
	MOV	LKBLK,R0		; Get magtape status
	TSTB	@#$ERRBY		; Is it zero?
	BNE	10$			; No, branch
	MOV	#TSETB1,R1		; Yes.  Use EOF code table
	BR	20$
	
10$:	MOV	#TSETB2,R1		; Use Hard error table
20$:	TST	R0			; Enter here from above
	BLT	30$			; Invalid error value?
	CMP	R0,#6
	BLE	40$			; Invalid error value?
30$:	CLR	R0
40$:	ASL	R0
	ADD	R0,R1			; Add word offset to table
	BIS	@R1,TPSTAT		; Set appropriate status bits
50$:
.IF NE DELAY
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	MOV	R5,-(SP)
	MOV	#ZARG,R5
	CALL	ISLEEP
	MOV	(SP)+,R5
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	BR	60$

ZRO:	.WORD	0
TICKS:	.WORD	6.

ZARG:	.WORD	4			; FORTRAN-style arg list
	.WORD	ZRO
	.WORD	ZRO
	.WORD	ZRO
	.WORD	TICKS
60$:
.ENDC;	NE	DELAY

	MOV	(SP)+,R1
	MOV	(SP)+,R0
	ROL	R0			; Retrieve SPFUN's carry bit
	MOV	TPSTAT,R0		; return status word
	BIT	R0,#<TS.ERR!TS.NAV!TS.WLK>	;Error?
	BEQ	90$
	MOV	TAPDEV,DEVSPC		; be ready for error msg
	BIT	R0,#TS.NAV		; Was unit available?
	BEQ	90$
	MOV	#DNA,R1			; -F-Device not available <dev>
70$:	JMP	FATALD			; Fatal exit with device name.
	......

80$:	CLC
90$:	RETURN
	......
	.SBTTL	CHKWRL - Check for Tape Write-Locked

;+
; Check tape unit for Write-Locked condition
;_

CHKWRL:	BIT	#TS.WLK,TPSTAT		; Was tape write locked?
	BEQ	80$			; Return if not.
	MOV	R0,-(SP)		; save tape operation code
	MOV	R1,-(SP)
	MOV	#DWL,R1			; "Device write-locked"
	CMP	BUFF,#LBLBUF		; writing label?
	BNE	70$			; (don't worry about stack)
	CMP	LBLBUF,#"VO		; writing VOL label?
	BNE	70$			; If not, FATAL exit with error.
	CALL	ERRR			; display -E- error, and then
	CALL	PROM2			; prompt for new output volume.
	MOV	(SP)+,R1
	MOV	(SP)+,R0		; Recover, but
	SEC				;  indicate need to RE-DO the WRITE
	RETURN
	......

	.DSABL	LSB
	.SBTTL	REWCHK and other Primitive Magtape Operations
;+
; Rewind the magtape, checking for success afterwards.
;-
	.ENABL	LSB

REWCHK::CALL	REWIND			; Rewind magtape
	.WAIT	TAPCHA			; wait until done,
	BCC	10$			; If no error continue.
	CALL	TPNOTR			; Issue Tape Not Ready prompt
	BNE	REWCHK			; YES. go ahead and try again.
	SEC				; NO. 'Wants to quit.
10$:	RETURN
	......

;+
; REWIND magtape
;
; The #1 at the end of the SPFUN causes an immediate return to
; the calling routine.  A .WAIT should be performed before attempting
; subsequent operations.
;-

REWOFL::MOV	#SF.MOR,OPCODE		; REWIND_OFFLINE
	BR	RWSPF
	......

REWIND::MOV	#SF.MRE,OPCODE		; REWIND_ONLINE

RWSPF:	.SPFUN	#EMTARE,TAPCHA,OPCODE,#0,#0,#LKBLK,#RWCMPL
	BIS	#TS.REW,TPSTAT		; Set "REWINDING" flag
	RETURN
	......

; Completion routine for REWIND...

RWCMPL:	BIC	#TS.REW,TPSTAT		; Clear "REWINDING" flag
	RETURN
	......

; Tape unit not ready; Continue?

TPNOTR:	MOV	#NOTRDY,R1
	CALL	ANSWRP			; Prompt NOT READY, wait for response
	BMI	TPNOTR			; Y or N? Neither?
	RETURN
	......
	.SBTTL	SETSTR - CLESTR -- SET AND CLEAR STREAMING MODE
;+
; The streaming bit on the TS05 controller is set via an SPFUN for
; 100ips operation. The other tape devices should ignore this operation.
;
;	**********************************************************
;       ****** Streaming mode is enabled only in SJ and FB. ******
;	**********************************************************
;-

	.ENABL	LSB

SETSTR::
	BIT	#XM$ENV,OPTAC2		; Running under XM?
	BNE	20$			; If so, don't stream 

SETST1::MOV	#1,STRBUF		; Set streaming bit
	BR	10$			; go merge

CLESTR::CLR	STRBUF			; Clear streaming bit

10$:	MOV	#STRBUF,BUFF		; Streaming data
	MOV	#SF.MST,R0		; Streaming code
	CALL	MTOP			; Go do SPFUN
	BCC	20$			; Branch if no error
	.PRINT	#MSPFN			; for now, print error message
20$:	RETURN
	......

	.DSABL	LSB
	.SBTTL	WTMRK  - Write_Tape_Mark, Space FWD/BKW

;+
; Write TAPEMARK
;-
	.ENABL	LSB

WTMRK::	MOV	#SF.MTM,R0		; Get tapemark code
	CLR	COUNT
	BR	MTFUNC
	......

;+
; FORWARD-space magtape one record
;-

FORWSP::.DBTYP	#FSRMSG
	MOV	#SF.MFS,R0
	BR	SPREC
	......

;+
; FORWARD-space magtape N records, where N is set in R3
;-

FORWSN::MOV	#SF.MFS,R0
	BR	BACKN
	......

;+
; BACKSPACE magtape N records, where N is set in R3
;-

BACKSN::MOV	#SF.MBS,R0
BACKN:	MOV	R3,COUNT
	CALL	MTFUNC
	CLR	R3			; Assume job done.
	TST	LKBLK			; EOF and/or EOT encounterred?
	BEQ	30$
20$:	MOV	LKBLK+2,R3		; return no. of records NOT spaced
30$:	RETURN
	......

;+
; BACKSPACE magtape one record
;-

BACKSP::.DBTYP	#BSRMSG
	MOV	#SF.MBS,R0
SPREC:	MOV	#1,COUNT
	BR	MTFUNC
	......
;+
; BACKSPACE magtape one tapemark
;-

BSPFIL::.DBTYP	#BSFMSG
	MOV	#SF.MBS,R0
	BR	SPFIL			; Join common code below.
	......

;+
; FORWARD-SPACE magtape one tapemark
;-

FSPFIL::.DBTYP	#FSFMSG
	CALL	SETST1			; Turn ON streaming of TS05
	MOV	#SF.MFS,R0		; Get FORWARDSPACE code
SPFIL:	MOV	#-1,COUNT
	CALL	MTFUNC
	CALLR	CLESTR			; Turn OFF streaming
	......

MTFUNC:	CLR	BUFF			; Clear buffer variable
	.BR	MTOP			; and do tape operation.

; Do Magtape operation specified above (operation code in R0), and return

MTOP:	CLR	TPSTAT			; Clear status word,
	CLR	LKBLK			; Clear error block word,
	MOV	R0,OPCODE		; get the operation code,
	.SPFUN	#EMTARE,TAPCHA,OPCODE,BUFF,COUNT,#LKBLK,#0
	CALLR	GMTSTA			; Get magtape status
	......				;  and return to caller.

	.DSABL	LSB

	.END