.MCALL	.MODULE
.MODULE	BUPDIR,VERSION=04,COMMENT=<>,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.
;  23-Feb-88	RHH	V5.5 Work
;  13-jan-1997  TDS	004	Fix for 4-digit years.
	.SBTTL	Macro References

	.MCALL	.ENTER, .SERR,	.HERR,	.WRITW,	.CLOSE, .GTLIN
	.MCALL	.PURGE, .PRINT,	.TTYOU,	.BR, .DATE, .GTIM

	.SBTTL	Macro Definitions

	.MACRO	.COUT
	CALL	DOPUTC
	.ENDM

	.MACRO	.PFILE	ARG
	MOV	ARG,R0
	CALL	DOLINE
	.ENDM

	.MACRO	......
	.ENDM


	YEAR4D = 1
	.SBTTL	Data specific to /L command

	.PSECT	DIRDAT,D
	.NLIST	BEX

NODATE:	.ASCII	/<No date>/<200>
DIRTOP:	.ASCIZ	/ RT-11 BACKUP/
DFREE:	.ASCII	/ Free block/<200>
FILS:	.ASCII	/ File/<200>
SAVS:	.ASCII	/ Saveset section/<200>
BLKS:	.ASCII	/ Block/<200>
COMBLN:	.ASCII	/, /<200>
.IF EQ YEAR4D
DATSTR:	.ASCII	/         /<200>
.IFF; EQ YEAR4D
DATSTR:	.ASCII	/           /<200>
.ENDC; EQ YEAR4D
	.EVEN

DDATE::	.WORD	0			; Store file date here
SIZE::	.WORD	0			; Size of file
VOLNO::	.WORD	0			; Volume number
V1:	.WORD	0
TOTALV::.WORD	0			; Total number of volumes
DSMALL::.WORD	0			; Smallest volume size stored here
DEVSIZ::.WORD	0			; Blocks from device
LPOINT::.WORD	0			; Location counter word
SAVSIZ::.WORD	0			; Saved size from device
SAVVOL::.WORD	0			; Saved volume number
SAVTOT::.WORD	0			; Saved total volumes

; FORTRAN-style arg block for CVTTIM

CVTBLK:	.WORD	5			; Arg block for CVTTIM
	.WORD	JTIME
	.WORD	HOURS
	.WORD	MINUT
	.WORD	SECND
	.WORD	TICKS

JTIME:	.BLKW	2			; place for RT-11 time
HOURS:	.WORD	0			; storage for hours value
MINUT:	.WORD	0			; storage for minutes value
SECND:	.WORD	0			; storage for seconds value
TICKS:	.WORD	0			; storage for ticks

DATBLK:	.WORD	2			; SYSLIB DATE4Y arg block
	.WORD	DATSTR
	.WORD	DDATE

; Directory Output File Data

DODFNM:	.RAD50	/BUPDIRDIR/		; Default output name
DOBLK:	.WORD	0			; Directory Output Block Number
DOBUF::	.WORD	0			; Directory Output Buffer Pointer
DOOFST:	.WORD	0			; Offset within block
LFOFLG:	.BYTE	0			; List file is open if nonzero
	.EVEN
	.SBTTL	INIT   - Initialize BUP-wide Global Variables
;+
; The buffer area of the command line (ASCII) and the programs flags 
; are cleared for proper functioning of the next command. The handlers
; which are in memory are released. The channels which are open are
; purged. 
;-

	.MCALL	.SRESET, .QSET
	.PSECT	INITCD,I

	.ENABL	LSB

INIT::	CALL	IFCLOT			;If tape chan open, close it.
	CALL	PURGTM			;If tmp file active, kill it.
	.SRESET				;Unload handlers
	CLR	INCHAN			;Assign channels for input
	MOV	#1,OUTCHA		; and output.

; (.SRESET is supposed to take care of PURGing open channels)
;	.PURGE	INCHAN			;Purge channels...
;	.PURGE	OUTCHA			;For aborted operations
;	.PURGE	TMPCHA

	MOV	HDRADD,NHDRAD		;reset first handler fetch address

	.QSET	#ADDQUE,#6		;Allocate Queue Elements

	CLR	NOTBAK			;Clear this flag
	CLR	NOUTFL			;Clear flags
	CLR	OPTACT			;Clear option word
	CLR	NONAME			;Clear flag
	CLR	VOLCOP			;Clear volumes copied count
	CLR	INBLK			;Clear starting input block
	CLR	SEQPOS			;Clear flag magtape
	CLR	INPDEV			;Clear input device
	CLR	OUTDEV			;Clear output device
	CLR	OUTSIZ			;Clear storage size word
	CLR	RBLOCK			;Clear storage for tape
	CLR	VBAD			;Clear bad-verify counter
	CLR	BADTOT			;Clear bad-read counter
	CLR	SSSPEC			;Clear SAVESET spec/file number
	CLR	NFTRAN			; Reset files transferred count
	CLR	PONLY			;Number of savesets to show on tape
	CLRB	VONLY			;Clear VERIFY:ONLY flag
	CLRB	TPOPEN			;Clear TAPE OPEN flag
	CLRB	INPUT2			;Clear 2nd input spec flag

	MOV	#^RBUP,DEFNAM+6		; Default extension = .BUP
	MOVB	#333,DEV1		; Init to 333 (not a valid dstat code)
	MOVB	#333,DEV2		; Init to 333 (not a valid dstat code)

	CLR	FSASC			; Clear 1st bytes of ASCII string

	MOV	#CMDBUF,R2		; R2-> buffer
	MOV	#CMDLIN,R1		; R1-> buffer
	MOV	#FSPEC,R3		; R3-> CSISPC spec area
	MOV	#41.,R0			; Count
10$:	CLR	(R1)+			; Clear loc
	CLR	(R2)+			; Clear loc
	CLR	(R3)+			; Clear FSPEC area
	DEC	R0
	BNE	10$			; Repeat till finished

	MOV	#'*,ASCLST		; Let wildcard string = "*"<NULL>
	MOVB	#1,WILDFG		; Set wildcard flag = TRUE

	MOV	#IG.DEV,R0		; Point to IGTDIR's DBLK argument
	MOV	R0,IGDDEV		; Default DBLK for IGTDIR
	CLR	(R0)+			; DBLK(0) = 0
	MOV	#6,(R0)+		; DBLK(2) = starting block
	CLR	(R0)+			; DBLK(4) = 0 (return matches)
	CLR	(R0)+			; DBLK(6) = 0 (reserved)

	CLR	FNDBTS			; Initialize bitmask of files found

;	CALLR	CHKENV			; Check environment
	.BR	CHKENV
	......

	.DSABL	LSB
	.SBTTL	CHKENV	Check for XM Environment

	.MCALL	.CRRG,  .CRAW,  .MAP,   .RDBBK, .WDBBK, .ELRG
	.MCALL	.GVAL

; XM region data structures

PAR	=:	3			; 1st PAR to map through
PARS	=:	3			; No. of XM PARs to use
PARSIZ	=:	4096.			; 1 PAR's number of words
BUFSIZ	=:	<PARSIZ*PARS>		; XM buffer size (words)

CHUNKS	=:	BUFSIZ/32.
XMBUFA	==:	PAR*20000		; Corresponding virtual address
XMTOPA	==:	XMBUFA+<BUFSIZ*2-2>	; Top address of window

	.PSECT	INITDA,D
RDB:	.RDBBK	CHUNKS,RS.CGR,NAME=BUP	; Region Definition Block
WDB:	.WDBBK	PAR,CHUNKS,,,,WS.MAP	; Window Definition Block
WRNID	=:	<WDB+W.NRID>		; Address of Window ID
	.EVEN
	.PSECT	INITCD,I
	.ENABL	LSB

;+
; Check RT-11 Environment.  Is it XM?  If so, set a bit and try to
; create a region for buffers.
;
; Uses R0
;-

CHKENV:	.GVAL	#EMTARE,#$CNFG1		; Get $CNFG1 word
	BIT	#KT11$,R0 		; Running under XM?
	BEQ	10$			; Branch if not.
	BIS	#XM$ENV,OPTAC2		; Otherwise, set XM bit.
	BIT	#XM$REG,OPTAC2		; Window already mapped?
	BNE	10$			; If so, return now.
	BIT	#XM$RGF,OPTAC2		; Already failed trying to create
	BNE	10$			; XM region?  If so, don't try again.

; Create a region for buffers

	.CRRG	#EMTARE,#RDB		; Create XM region
	BCS	30$

; Create window and map to the region

	MOV	RDB,WRNID		; Move Region ID to Window Def Blk
	.CRAW	#EMTARE,#WDB
	BCS	20$
	BIS	#XM$REG,OPTAC2		; Set bit in option word 2
10$:	RETURN
	......

20$:	.ELRG	#EMTARE,#RDB		; Eliminate region
30$:	BIS	#XM$RGF,OPTAC2		; Signal no hope of XM region
	RETURN
	......

	.DSABL	LSB
	.SBTTL	BUPDIR - BUP directory common code

;+
; These entries are called by the root.  They serve to load this
; overlay before performing BUP directory functions.
;-

	.PSECT	DIRCOD,I

TDIR::	JMP	TDIRO			; Go to Tape Dir Code in Ovly 2
	......

DIREC::	JMP	DIRECO			; Go to Disk Dir Code in Ovly 2
	......

DOLSR::	JMP	MTLIST			; Finish Magtape /LIST/SAVESET
	......
	.SBTTL	SAVEOP - Save BUP switches
;+
; The switch table is initialized. The switch information in the
; stack is used to fill in the switch table. Checked here are
; the number of switches, repeated switches and invalid switches.
;-

OPTVAL:	.WORD	0

	.ENABL	LSB

SAVEOP::MOV	(SP)+,SAVEPC		; Pass program counter from call
	MOV	#OPTTBL,R0		; R0--> beginning of table
10$:	TST	@R0			; End of table?
	BEQ	20$			; Yes, branch
	CLR	2(R0)			; Option init to 'not given'
	ADD	#4,R0			; Point to next
	BR	10$			; Repeat

20$:	MOV	(SP)+,R1		; R1= number of options
	MOV	R1,NUMOPT		; Save it for later
30$:	TST	R1			; Finish with scan?
	BEQ	160$			; Yes, branch
	MOV	#OPTTBL,R0		; R0--> beginning of table
	MOV	(SP)+,R2		; Get option
	BPL	40$			; proceed if no option value
	MOV	(SP)+,OPTVAL		; save the option value.
40$:	CMPB	R2,#'A+40		; Greater than lower case a?
	BLT	50$			; No, branch
	CMPB	R2,#'Z+40		; Greater than lower case z?
	BGT	50$			; Yes, branch
	BICB	#40,R2			; Make lower case!	
50$:	TST	@R0			; End of table?
	BNE	70$	  		; No, branch
	MOV	#OPT,R1
60$:	JMP	FATAL			; <-F-Invalid option>

70$:	CMPB	R2,@R0			; Options match?
	BNE	150$			; No, branch
	TSTB	GIVEN(R0)		; Was it already given?
	BEQ	80$			; No, branch
	MOV	#DUP,R1			; <-F-Duplicate option>
	BR	60$			; Fatal out.

80$:	TST	R2			; Was a value given?
	BPL	120$			; No, branch; ok
	CMPB	R2,#'V			; Yes. Was it /V:ONL?
	BNE	100$			; Branch if not /V
	CMP	OPTVAL,#^RONL
	BEQ	110$			; Error if not RAD50 "ONL"
90$:	JMP	INVCMD			; <-F-Invalid command>

100$:	CMPB	R2,#'O			; Was option /O:n?
	BNE	90$			; Branch if not.
	MOV	OPTVAL,PONLY		; save "n"
	BR	140$

110$:	MOVB	#-1,VONLY		; Set the V:ONLY flag

120$:	CMPB	R2,#'R			; /SUBSET?
	BEQ	130$			; If so, pretend it's a SAVESET
	CMPB	R2,#'S			; /SAVESET?
	BNE	140$
130$:	MOV	R2,SSSPEC		; store whole switch word away
140$:	MOVB	#-1,GIVEN(R0)		; Indicate option given
	DEC	R1			; Count option
	BR	30$			; Check if more options

150$:	ADD	#4,R0			; Point to next option
	BR	50$			; Check next entry

160$:	MOV	SAVEPC,-(SP)		; Restore return address
	RETURN

	.DSABL	LSB
	.SBTTL	GETCMD - Intercept command line
;+
; The user command line is intercepted by a .GTLIN request before being
; send to CSI. If the output specification is missing a filename an * is
; placed to eliminate the CSI error.  The input buffer is CMDLIN
; and the output buffer which contains the actual line send to CSI is
; CMDBUF.
;
;-
	.ENABL	LSB

GETCMD::
	BIC	#EDIT$,@#$JSW		; Enable SL
	.GTLIN	#CMDLIN,#ASTERP		; Get command line
	BIS	#EDIT$,@#$JSW		; Disable SL
	MOV	#CMDLIN,R2		; R2-->ascii command line
	MOV	#CMDBUF,R4		; R4-->output buffer

10$:	TSTB	@R2			; EOL?
	BEQ	50$			; Yes, done.
	CMPB	@R2,#':			; colon?
	BEQ	20$			; Yes, branch
	MOVB	(R2)+,(R4)+		; Store character
	BR	10$			; Repeat

20$:	MOVB	(R2)+,(R4)+		; Store the character
	TSTB	@R2			; EOL?
	BEQ	50$			; Yes, done.
	CMPB	@R2,#'=			; EQUAL follows colon?
	BEQ	30$
	CMPB	@R2,#'/			; SLASH follows colon?
	BNE	40$			; No, branch
30$:	MOVB	#'*,(R4)+		; insert asterisk
40$:	MOVB	(R2)+,(R4)+		; Store character
	TSTB	@R2			; Eoln?
	BNE	40$

50$:	BR	60$			; NOP this for display of command

; The following line if executed will print on the terminal the 
; command line which will be input to CSI

PRICMD::.PRINT	#CMDBUF			; Test the buffer line

60$:	RETURN

	.DSABL 	LSB
	.SBTTL	DOLINE - Output one line to list file

; Directory Output Code

	.ENABL	LSB

; Output a line to the list file

DOLINE::TSTB	LFOFLG			; Output to terminal?
	BNE	10$			; Branch if not.
	.PRINT	R0
	RETURN

10$:	TSTB	@R0			; Is char a NULL?
	BEQ	DOCRLF			; Branch if so
	CMPB	@R0,#200		; Is it a 200?
	BEQ	DONE			; Branch if so
	MOV	R0,-(SP)		; Save char pointer
	MOVB	(R0),R0			; Put char in R0
	CALL	DOPUTC			; Output it
	MOV	(SP)+,R0		; Restore its address
	INC	R0			; Point to next character
	BR	10$			; Loop

; Output <CR><LF> to list file

DOCRLF:	MOV	#15,R0			; Print <CR>
	CALL	DOPUTC
	MOV	#12,R0			; Print <LF>
	.BR	DOPUTC
	.SBTTL	DOPUTC - Output one character to list file

; Output a character (in R0) to the list file

DOPUTC::TSTB	LFOFLG			; Output CHAR to terminal?
	BNE	20$			; Branch if not
	.TTYOUT				; Output it to terminal
	RETURN
20$:	CMP	DOOFST,#512.		; At end of buffer?
	BLT	30$			; Branch if not.
	CALL	DOWRIT			; Otherwise, dump the buffer.
30$:	MOV	R1,-(SP)
	MOV	DOBUF,R1		; Point to buffer,
	ADD	DOOFST,R1		; Point to next available byte
	MOVB	R0,@R1			; Put character there
	INC	DOOFST			; Inc buffer offset 
	MOV	(SP)+,R1
DONE:	RETURN

	.SBTTL	DOOPEN - Open list file

;+
; Open the list file.  If output is going to the terminal, then
; don't open it as a file - it will be done with .PRINT requests.
; If output goes to a device other than TT, use .ENTER to make
; a file whose name is the same as the saveset name.
;-

DOOPEN::CLRB	LFOFLG			; Assume TT output.
	CMPB	DEV1,#DEV.TT		; Opening TT?
	BEQ	70$			; Branch if so.
	TSTB	NONAME			; Name supplied?
	BPL	40$			; Branch if a filename is supplied.
	MOV	#<OUTFIL+2>,R0		; Point to supplied output name
	MOV	#DODFNM,R1		; point to default name
	MOV	(R1)+,(R0)+		; Move it in...
	MOV	(R1)+,(R0)+		;  name...
	MOV	(R1)+,(R0)+		;   extention...

	MOVB	GIV.S,R0		; /S ?
	BISB	GIV.R,R0		; or /R ?
	BEQ	40$			; branch if not.
	MOV	#<INFIL+2>,R1		; was a saveset name provided?
	TST	@R1
	BEQ	40$			; branch if not.
	MOV	#<OUTFIL+2>,R0		; Point to supplied output name
	MOV	(R1)+,(R0)+		; Use that name for output.
	MOV	(R1)+,(R0)+

40$:	.SERR
	.ENTER	#EMTARE,DSKCHA,#OUTFIL,#0
	BCS	90$			; Branch on open errors
	.HERR
	CLR	DOBLK			; Set block number to zero,
	MOVB	#1,LFOFLG		; Mark list file open
	BR	80$			; Finish init and return.

	.SBTTL	DOCLOS - Close list file

; Close the list file

DOCLOS::TSTB	LFOFLG			; Closing TT?
	BEQ	70$			; nothing special.
	MOV	DOOFST,R1		; anything in buffer?
	BEQ	60$			; Branch if not.
	MOV	DOBUF,R0
	ADD	R0,R1			; Point to bytes needing nulls
	ADD	#512.,R0		; Let R0 point to end of buffer
50$:	CLRB	(R1)+
	CMP	R1,R0			; At the end yet?
	BLO	50$			; Branch up if not.
	CALL	DOWRIT			; Otherwise write final block,
60$:	.CLOSE	DSKCHA			; close the channel,
	CLRB	LFOFLG			; Indicate file is closed.
70$:	RETURN				; and return.
	.SBTTL	DOWRIT - Write one block to list file

; Write a block to the list file

DOWRIT:	MOV	R0,-(SP)		; Save R0
	MOV	R1,-(SP)		;  and R1
	MOV	DOOFST,R1		; Get buffer offset
	INC	R1			; Make word count
	ASR	R1
	.WRITW	#EMTARE,DSKCHA,DOBUF,R1,DOBLK	; Write a block
	BCS	90$
	MOV	(SP)+,R1		; Restore R1
	MOV	(SP)+,R0		;  and R0
	INC	DOBLK			; Bump block counter
80$:	CLR	DOOFST			; Reset buffer offset
	RETURN

90$:	MOV	#WR2,R1			; -F-Output error dev:file.ext
	JMP	FATALO

	.DSABL	LSB
	.SBTTL	DATE1/DATE2 - Display date 
;+
; The date requested or the system date is formatted and printed 
; to the output stream.  The entry point determines which date 
; is displayed.
;
; CALL DATE1 - For printing the SYSTEM date
;             
;      R0 = Date to print in RT11 format
;
; CALL DATE2 - For printing desired date stored in R0
;	 
;-
	.ENABL	LSB

DATE1:	.DATE				; Get system date in R0 via .DATE 

DATE2::	MOV	R0,R2			; Move a copy to r2
	BIC	#^C<DA.MON>,R2		; Isolate month value
	BEQ	10$			; If zero, no system or file date
	CMP	R2,#<12.*2000>		; month invalid?
	BLE	20$
10$:	.PFILE	#NODATE			; <No Date>
	RETURN
	......

20$:	MOV	R0,DDATE		; store RT-11 date word in variable
	MOV	#DATBLK,R5		; point to arg block
.IF EQ YEAR4D
	MOV	#DATE,R0		; 2-digit year date
.IFF; EQ YEAR4D
	MOV	#DATE4Y,R0		; 4-digit year date
.ENDC; EQ YEAR4D
	CALL	CALL$F			; get date string
	MOV	#DATSTR,R2
	BISB	#40,4(R2)		; convert 2nd and 3rd characters
	BISB	#40,5(R2)		;  of month to lower case.
	.PFILE	R2
	RETURN
	......

	.SBTTL	NUM2   - Convert 2-digit value

; Convert value in R2 to 2-digit number, with leading zeroes

NUM2::	CMP	R2,#10.			;Is it 10 or larger?
	BGE	30$
	MOV	#'0,R0			; If not, print a leading zero.
	.COUT
30$:	CALL	DECIMF			;Print day
	RETURN
	......

	.DSABL	LSB
	.SBTTL	PSPACE - Format routine
;+
; The following subroutine is used to assist in formatting the directory
; output.  It takes an input location (LPOINT) and a desired location in
; R2 where a parameter is to be printed.  It calculates the number of 
; blanks needed to reach the desired location, and prints those blanks.
;
;	R2   	=  Location where parameter is to be printed.
;       LPOINT  =  Current location
;
;	CALL	PSPACE
;
;	LPOINT is updated to reflect the blanks output.
;-
	.ENABL	LSB

PSPACE::MOV	LPOINT,R3		; Get current location
	SUB	R3,R2			; Calculate needed spaces
	BEQ	20$
10$:	CALL	BLANKO			; Output a blank
	DEC	R2			; Are we finish
	BNE	10$			; No, repeat
20$:	RETURN
	......


; BLANKO - Output one blank character to the listing file.

BLANKO::MOV	#40,R0			; Output a blank to list file.
	.COUT
	INC	LPOINT
	RETURN
	......

	.DSABL	LSB
	.SBTTL	RTNICE - Print universal header

; Print the header that appears atop ALL BUP directory listings

RTNICE::.PFILE	#CRLF			; Initial blank line
	.PFILE	#DIRTOP			; Print INTRO message
	CALL	BLANKO			; one blank char,
	CALL	DATE1			; Print system DATE
	CALL	BLANKO			; one blank char,
	CALL	TIME1			; print the TIME
	.PFILE	#CRLF
	RETURN
	......

	.SBTTL	TIMED  - Time routines
;+
;  Time formatting subroutines
;
;  TIMED prints the creation time of the disk saveset
;
;  TIME1 prints the current time
;-
	.ENABL	LSB

TIMED::	MOV	DHOURS,R2		; Get disk hours
	MOV	DMINUT,V1		; Get disk minutes
	BR	10$
	......

TIME1::	.GTIM	#EMTARE,#JTIME		; Get the time of day
	MOV	#CVTTIM,R0		; Point to SYSLIB routine
	MOV	#CVTBLK,R5		; Point to arg block,
	CALL	CALL$F			; Convert time to hrs, min, sec
	MOV	HOURS,R2		; Get current hours
	MOV	MINUT,V1		; Get current minutes

10$:	CALL	NUM2			; print hours value
	MOVB	#':,R0
	.COUT				; print colon
	INC	LPOINT
	MOV	V1,R2			; get minutes value
	CALLR	NUM2			; print minutes value
	......

	.DSABL	LSB
	.SBTTL	ENDMES - End message

; Display a summary line at the end of a directory listing.
; It typically looks like
;
;		NNN Files, MMM Blocks,
;		FFFF Free blocks

	.ENABL	LSB

ENDMES::.PFILE	#CRLF			; make blank line
	CALL	BLANKO			; indent one space

; Display " NNN Files (or Savesets)"

	MOV	NFTRAN,R2		; number of files or savesets
	CLR	R3			; high-order = 0
	MOV	#FILS,R0		; " NNN Files,"
	TSTB	GIV.S			; if not doing /SAVESET list,
	BMI	10$
	MOV	#SAVS,R0		; print " NNN Savesets," instead.
10$:	CALL	LVALUE
	.PFILE	#COMBLN			; print comma and blank,

; Display "BBB Blocks"

	MOV	SAVINB,R2		; Total blocks
	MOV	BLKVER,R3		; high-order block value
	MOV	#BLKS,R0
	CALL	LVALUE			; print "BBB Blocks"
	.PFILE	#CRLF			; terminate the line.

	TSTB	GIV.S			; doing /SAVESET list?
	BMI	20$			; if so, quit here.
	BIT	#T$OPT,OPTACT		; or, if TAPE operation,
	BNE	20$			;  quit.

; Display "FFFF Free Blocks"

	CALL	BLANKO			; indent one space
	MOV	RETCOD,R2
	CLR	R3			; high-order = 0
	MOV	#DFREE,R0
	CALL	LVALUE			; print "FFFF Free Blocks"
	.PFILE	#CRLF			; terminate the line.

; Do final blank line and close listing file.

20$:	.PFILE	#CRLF			; Final blank line
	CALL	DOCLOS			; Close printout file
	RETURN
	......

	.DSABL	LSB
	.SBTTL	LVALUE - Display label and value

;+
; Display a word like "block(s)" or "file(s)" with a subsequent
; value.  Eliminate the "s" in the word if value = 1.
;
;	MOV	lowval,R2		; the low-order value,
;	MOV	higval,R3		; high-order value
;	MOV	#string,R0		; the word address
;	CALL	LVALUE
;-
	.ENABL	LSB

LVALUE:	MOV	R2,-(SP)		; save the value
	MOV	R0,-(SP)		; save string pointer
	CALL	DEC2MA			; display the value
	MOV	(SP)+,R0		; get string pointer
	CALL	DOLINE			; display the string
	CMP	(SP)+,#1		; is the value one?
	BNE	10$			; print 's' if not.
	TST	R3			; high order value zero?
	BEQ	20$			; skip the 's'
10$:	MOVB	#'s,R0			; display 's'
	.COUT
20$:	RETURN
	......

	.DSABL	LSB
	.SBTTL	DEC2MA - Double Precision Binary to Decimal Conversion

; DEC2MA - Double Precision Unsigned Binary to Decimal Conversion
; The number to convert is passed in R2 and R3.

	.ENABL	LSB

DEC2MA::
	JSR	R5,$SAVR1		; save registers
	MOV	#POWER,R4		; point to power table
	CLR	R1			; zero suppression flag

10$:	MOV	#'0,R0			; Set digit = '0'
20$:	SUB	@R4,R2			; subtract low order
	SBC	R3
	SUB	2(R4),R3		; subtract high order
	BLT	30$			; branch if subtract borrowed
	INC	R0			; next digit
	INC	R1			; no more zero suppression
	BR	20$
	......

30$:	ADD	@R4,R2			; Add back low order
	ADC	R3
	ADD	2(R4),R3		; Add high order
	TST	R1			; Zero suppression?
	BNE	40$			; print it if not.
	TST	4(R4)			; was this the last entry?
	BNE	50$			; branch if not.
	
40$:	.COUT				; output char in R0
	INC	LPOINT

50$:	CMP	(R4)+,(R4)+		; point to next power entry
	TST	@R4			; end of table?
	BNE	10$			; branch if not.
	RETURN
	......

	.DSABL	LSB

	.PSECT	DIRDAT,D

POWER:	.WORD	145000,35632		; 1000000000.
	.WORD	160400,2765		; 100000000.
	.WORD	113200,230		; 10000000.
	.WORD	41100,17		; 1000000.
	.WORD	103240,1		; 100000.
	.WORD	23420,0			; 10000.
	.WORD	1750,0			; 1000.
	.WORD	144,0			; 100.
	.WORD	12,0			; 10.
	.WORD	1,0			; 1.
	.WORD	0

	.END