;<MFEXEC>X3CMD.MAC;20208    28-JUN-79 15:22:17    EDIT BY WEISSMAN
; KILLED "LPT" SUBCOMMAND TO "DIRECTORY" FOR IAC OPERATION
;Added SRI's archive status and changes to DIRECTORY
;<MFEXEC>X3CMD.MAC;20101  27-DEC-77 16:13:34  EDIT BY B-SMITH
;<MFEXEC>X3CMD.MAC;20100   9-NOV-77 15:52:34  EDIT BY B-SMITH
;2.01 ARCHIVE NEEDS TO USE NEW EPHEMERAL ENTRY
;<MFEXEC>X3CMD.MAC;20000  19-JAN-77 18:41:42  EDIT BY B-SMITH
; Incorporate ARCHIVE EXPUNGE
; Added two subcommands to DIRECTORY:
;  BOTH - list both undeleted & deleted files
;  TOTAL - list file count and space used
; General clean up
;2.00

;1.53

;1.52
; SWITCH ARCHIVE LOOKUP PROGRAM TO <SYSTEM>
; MAKE DIFFERENCES IN AUTHOR AND EPHEMERALITY CAUSE PRINTING ON
;  SEPARATE LINES
; ALLOW FOR NEW DEC DECTAPE DATE FORMAT
; NEW "ARCHIVE" COMMANDS
; FLUSH EOL'S IN FAVOR OF CRLF'S SO FTP WORKS TO 360'S

;1.51
; FIX SORT OF 2-PART DIRECTORIES
; FIX "2ND ARCHIVE TAP #" TYPEOUT BUG
; ADD PRINTING OF ;S FOR SCRATCH FILES AND ;E FOR EPHEMERAL FILES
; FLUSH SPACES IN CRAM MODE FOR TIME FIELD OF UNREAD FILE
; INCLUDE "PGS" IN "DIR, EVERY"
; "AUTHOR" SUBBCOMMAND OF "DIRECTORY"
; SUPER CLEANUP
; ADD TAD TO DIR LIST ON OTHER THAN COJFN (SRI)

;1.50

;1.49

;1.48
; DIR PRINTS "NEVER READ"  INSTEAD OF NOV 18,1858

;1.47
; "ARCHIVE" COMMAND

;1.46
; QFD TYPES DIRECTORY UNLESS "NO (HEADING)" SUBCOM. LOST IN <*>X.Y;Z
; "DIRECTORY" ONLY PRINTS DIRECTORY AND HEADING WHEN IT CHANGES

PRINTX Entering X3CMD


;TENEX Multiple Fork EXECutive

;X3CMD.MAC -
;  ARCHIVE
;  QFD/QD/QR/QV/QW
;  DIRECTORY

;See XMAIN.MAC for further details

;ARCHIVE COMMAND
;USE OF F REG:
;	SINCE ONLY THE LEFT 18 BITS OF FDBBCK CAN BE CHANGED
;	(AND SINCE THE LEFT-MOST BIT IS NOT USED BY BSYS)
;	F IS DIVIDED INTO 2 PARTS, GIVING ALL INFO FOR CHFDB
;	LH - NEW VALUES FOR THE BITS IN LH OF FDBBCK
;	(BIT 0 IS USED AS A HACK FOR THE STATUS COMMAND)
;	RH - WHICH BITS TO CHANGE IN LH OF FDBBCK
;	LH AND RH USED BASICALLY AS IN GTFDB AFTER FULL
;	REGISTER EXTENSION

.ARCHI:	KEYWD $ARCHI
	 0			;NO DEFAULT KEYWORD
	 JRST CERR
	JRST 0(KWV)

$ARCHI:	TABLE
	T DELETE,,LPROK+LANOK,ARC.DL
	T EXPUNGE,,LPROK+LANOK,ARC.EX
	T FILE,,COMOK+LPROK+LANOK,ARC.FL
	T RESET,,LPROK+LANOK,ARC.RS
	TE STATUS,,LPROK+LANOK,ARC.ST
	T UNDELETE,,LPROK+LANOK,ARC.UN
	TEND

ARC.FL:	NOISE (file list)
	MOVE A,[2,,2]		;DEFAULT NAME AND EXT
	MOVE B,[-2,,B2+B8+B11+B15+B16]	;DEFAULT LOWEST VERSION
	CALL SPECFN		;GTJFN W/B FLAGS
	;IF SUBCOMMANDS START WITH DEFAULTS AND LET USER ALTER THEM
	 JRST [	MOVEI F,0	;Assume no function specified
		CONFIRM		;, TYPED
		SUBCOM $ARC
		JUMPE F,ARCH3	;NO SUBCOMMANDS AFTER ,
		TRNN F,FDBARC+FDBNAR ;Only no delete?
		IOR F,[FDBARC,,FDBARC+FDBNAR] ;Yes. request archive
		JRST ARCH1]
	CONFIRM
	;DEFAULT - ARCHIVE AND DELETE, RESET "DON'T DELETE"
ARCH3:	MOVE F,[FDBARC,,FDBARC+FDBADL+FDBNAR]
ARCH1:	HRRZ A,@INIFH1		;JFN
	DVCHR
	TLNN B,B4		;DSK (MULT DIR) CHECK
	ERROR <Cannot archive non-disk files>
	HRRZ A,@INIFH1		;GET CONTROL WORD BITS INTO C
	MOVE B,[1,,FDBCTL]
	MOVEI C,C
	CALL $GTFDB
	 SETO C,		;$GTFDB ERROR
	TLNE C,(FDBDEL)		;ERROR IF DELETED UNLESS DOING GROUP
	 JRST [	TLNN Z,GROUPF
		 ERROR <Cannot manipulate deleted file>
		JRST ARCH2]
	MOVE B,[1,,FDBBCK]	;GET BACKUP BITS
	MOVEI C,C
	CALL $GTFDB
	 SETO C,		;$GTFDB ERROR
	TLNE C,FDBAAR		;IF ARCHIVED, OK IF DOING GROUP
	 JRST [	TLNN Z,GROUPF
		ERROR <File %1S already archived>
		JRST ARCH2]
	CALL TYPIF		;TYPE FILENAME IF GROUP DESIG.
	HRLI A,FDBBCK		;A - DISP,JFN
	HRLZI B,0(F)		;B - BITS TO CHANGE
	HLLZ C,F		;C - VALUES TO CHANGE TO
	CHFDB

ARCH2:	CALL GNFIL		;GET NEXT FILE
	 JRST RLJFNS		;NO MORE - RELEASE AND EXIT
	JRST ARCH1		;MORE

; "ARCHIVE DELETE ..."

ARC.DL:	ALLOW TSPC+TALT
	HRROI B,[ASCIZ /<SYSTEM>ARCHIVE-LOOKUP.SAV/]
	CALL TRYGTJ
	 ERROR <No lookup program???>
	TLO KWV1,PROGX
	MOVEI B,4		;ENTRY VECTOR INDEX FOR DELETE
	JRST ERUNB		;RUN IT AS AN EPHEMERON


; "ARCHIVE UNDELETE ..."

ARC.UN:	ALLOW TSPC+TALT
	HRROI B,[ASCIZ /<SYSTEM>ARCHIVE-LOOKUP.SAV/]
	CALL TRYGTJ
	 ERROR <No lookup program???>
	TLO KWV1,PROGX
	MOVEI B,6		;ENTRY VECTOR INDEX FOR UNDELETE
	JRST ERUNB		;RUN IT AS AN EPEMERON


; "ARCHIVE EXPUNGE ..."

ARC.EX:	CONFIRM
	HRROI B,[ASCIZ/<SYSTEM>ARCHIVE-LOOKUP.SAV/]
	CALL TRYGTJ
	 ERROR <No lookup program???>
	TLO KWV1,PROGX
	MOVEI B,11
	JRST ERUNB


; "ARCHIVE RESET ..."

ARC.RS:	NOISE (files)
	MOVE A,[2,,2]
	MOVEI B,B2+B8+B11+B15+B16	;GTJFN FLAGS
	CALL SPECFN		;INPUT FILE GROUP
	 JRST CERR
	CONFIRM
	HRRZI F,FDBARC+FDBNAR+FDBADL
	JRST ARCH1		;GO DO IT


; "ARCHIVE STATUS ..."

ARC.ST:	HRLZI F,144000 
	JRST DIR00		;LET DIRECTORY COMMAND TAKE OVER HERE

$ARC:	TABLE
	T DEFERRED,,ONEWD,..ARDF
	T DELETE,,ONEWD,..ARDL
	T DON'T,,,..ARDN
	T IMMEDIATE,,ONEWD,..ARCIMMED
	TEND

..ARDF:	;DEFERRED DEFAULTS TO AND DELETE, FALL INTO IT

	;SET ARCHIVE, RESET DON'T DELETE AND DON'T ARCHIVE
..ARDL:	MOVE F,[FDBARC,,FDBARC+FDBNAR+FDBADL]
	RET

..ARDN:	KEYWD $DONT
	0			;NO DEFAULT
	JRST CERR		;NULL ILLEGAL
	CONFIRM
	JRST (KWV)

$DONT:	TABLE
	T ARCHIVE,,ONEWD,...DAR	;DON'T ARCHIVE
	T DELETE,,ONEWD,...DDL	;DON'T DELETE (IF ARCHIVED)
	TEND

	;RESET ARCHIVE, SET DON'T ARCHIVE
...DAR:	TLO F,FDBNAR		;GOING TO SET DON'T ARCHIVE
	TLZ F,FDBARC		;GOING TO RESET ARCHIVE REQUEST
	TRO F,FDBARC+FDBNAR	;YUP
	RET

	;DON'T DELETE MEANS SET ARCHIVE AND DON'T DEL, RESET DON'T ARCH.
...DDL:	TRO F,FDBADL		;DON'T DELETE AFTER ARCHIVING
	TLO F,FDBADL
	RET

..ARCIMMED:
	;WOULD MARK ARCHIVED BIT HERE ?? (UGH - NOT YET ON TAPE)
	JRST NIYE		;IMMEDIATE NOT IMPLEMENTED YET



;QFD
;QUICK FILE DESCRIPTION
;INTENDED TYPICAL USE IS "QFD <FILE NAME>" WHICH GIVES AN "EVERYTHING"
; DIRECTORY PRINTOUT FOR THE SINGLE FILE, WITHOUT EXCESS SPACES OR HEADG
;BUT IMPLEMENTATION IS LIKE "DIR" PLUS SUBCOMMANDS
; CRAM, EVERYTHING, AND NO (HEADING);
; THUS ADDITIONAL SUBCOMMANDS AND DIFFERENT ARGUMENTS (INCLUDING NONE)
; ARE POSSIBLE.

.QFD:	MOVE E,[001111177771]
	HRLZI F,B10	;SAY QFD MODE - ONLY DIR PART OF HEADING PRINTS
	JRST DIR0

;QD, QR, AND QW ARE QUICK DIRECTORY COMMANDS FOR:
;;QD - DELETED, SIZE, TIME OF READ/WRITE, AND LENGTH
;;QR - REVERSE, SIZE, LENGTH, TIME OF READ/WRITE, AND CHRON BY READ
;;QW - ...		...		...	, AND CHRON BY WRITE

.QV:	MOVE E,[001111,,166041]	;QUICK VERBOSE
	MOVSI F,B10
	JRST DIR0

.QD:	MOVSI F,000211
	JRST QW1

.QR:	SKIPA F,[000210,,000011]
.QW:	MOVE F,[000210,,000021]
QW1:	MOVE E,[001110,,021340]	;FILE.EXT;VER  AND PRINT OPTIONS
	HRRZ Z,F
	TRZ F,-1		;ORDERING OPTIONS
	JRST DIR0

;DIRECTORY.

;CAN TAKE AN ARGUMENT SPECIFYING DIRECTORY OR FILES TO LIST.
;CAN BE TERMINATED WITH COMMA TO INITIATE SUBCOMMAND INPUT.

;AC USE
;  E  FIELDS-TO-PRINT INFO A LA JFNS JSYS CALL.
;	ALSO: B26: PRINT LENGTH IN BYTES
;	      B27: CREATE TIME (IMPLIES CREATE DATE)
;	      B28: WRITE TIME (IMPLIES WRITE DATE)
;	      B29: READ DATE (IMPLIES READ TIME)
;	      B30: PRINT AUTHOR (WRITER)
;	      B31: PRINT LAST READER
;	      B32: SUPPRESS COLUMNATION (CRAM)
;  F  FLAGS FOR FORMAT, ETC:
;	B0:	DATE (AND TAPE NUMBER) OF DUMP
;	B1:	DATES (AND TAPE NUMBERS) OF ARCHIVES
;	B2:	NUMBER OF DUMP TAPE
;	B3:	NUMBERS OF ARCHIVE TAPES
;	B4:	TIME (AND DATE AND TAPE NUMBER) OF DUMP
;	B5:	TIMES (AND DATES AND TAPE NUMBERS) OF ARCHIVES
;	B6:	PRINT ARCHIVE STATUS BITS
;	B8	Print totals: file count, space used
;	B9	Both deleted & undeleted files (superceeds B17)
;	B10	QFD, ONLY DIR PART OF HEADING PRINTS
;	B11	USE 10/50 FORMAT FOR DECTAPE DIRS
;	B12	NOW PRINTING A DECTAPE, NOT DISK
;	B13	SUPPRESS HEADING
;	B14	SUPPRESS MULTIPLE VERSIONS ON SAME LINE
;	B15	SUPPRESS OMISSION OF NAME, EXT WHEN SAME AS ABOVE
;		(NOTHING SETS B15 (5/20/70/)).
;	B16	DOUBLE SPACE
;	B17     DELETED FILES ONLY
;  RH Z: FLAGS FOR ORDER OF PRINTOUT:
;	B31=20	CHRONOLOGICAL BY WRITE DATE
;	B32=10	CHRON READ
;	B33=4	CHRON CREATION
;	B34=2	ALPHABETIC
;	B35=1	INVERSE ALPHABETIC OR CHRONOLOGICAL
;  LH Z:
;	F1:	ON IF LIST ACCESS VIOLATION(S)
;	F2:	ON IF MORE FILES TO LIST FOR THIS IFH
;	F3:	ON IF MORE THAN ONE ARGUMENT IN LIST

.DIRECTORY:
..DIRE:	SETZ F,			;DEFAULT: NO SPECIAL FORMAT
;"ARCHIVE STATUS" JOINS HERE
DIR00:	MOVE E,[001110040001]	;DEFAULT FORMAT: NAME.EXT;VERS;T

;"QFD" JOINS HERE

DIR0:	MOVE A,COJFN		;DEFAULT OUTPUT TO PRI FILE
	MOVEM A,OUTDSG		;NB: RH OF Z IS 0

;DECODE ARGUMENT LIST WITH SUBROUTINE "DIRARG" IN SUBRS.MAC.
;THIS INPUTS A FILE GROUP (NAMES WITH "*" ALLOWED,
;MULTIPLE NAMES ALLOWED, -2 RETURNED FOR EACH EMPTY DIR).
;DEFAULTS NOTHING TO WHOLE CONNECTED DIRECTORY;
;INTERPRETS COMMA OR EOL TERMINATOR TO THE
;WORD "DIRECTORY".
	CALL DIRARG
	JRST [	CONFIRM		;R1: LIST ENDED WITH COMMA
		SUBCOM $DIR	;INPUT SUBCOMMANDS FROM TABLE $DIR
		JRST .+2]
	CONFIRM

;EXECUTE "DIRECTORY"

	MOVE A,OUTDSG		;OUTJFN
	MOVEI B,1B20		;WRITE.
	CALL $OPEN7		;OPEN, 7 BIT BYTES, MODE 0.

	MOVE A,INIFH1		;PTR TO FIRST JFN IN BUFFER
	CAMGE A,INIFH2		;PTR TO LAST
	TLO Z,F3		;SET FLAG IF MORE THAN 1 JFN
	SETOM OLDDIR		;IMPOSSIBLE DIRECTORY NUMBER

	SETOM DSKTTC		;Disk: number of JFNs displayed - 1
	SETZM DSKGCT		; global file count (zero)
	SETZM DSKGSP		; global page count (zero)
	SETOM DTATTC		;DECtape: number of JFNs displayed - 1
	SETZM DTAGCT		; global file count (zero)
	SETZM DTAGSP		; global block count (zero)

;COME BACK HERE TO PROCESS NEXT ARGUMENT IN LIST

DIRFL:	CALL UNMDIR		;UNMAP DIR'TORY BUF PAGES, THUS 0ING THEM
	TLZ Z,F2
	MOVE A,OUTDSG
	HRROI B,[ASCIZ /
/]
	SETZ C,
	TRNN E,1B32		;SKIP INITIAL CR IN CRAM FORMAT FOR QFD
	SOUT			;BLANK LINE ABOVE DIRECTORY
	HRRZ A,@INIFH1		;JFN
	CAIN A,-2		;TREAT EMPTY DIR AS DISK
	JRST DDIR
	DVCHR
	LDB B,[POINT 9,B,17]	;DEVICE TYPE
	JUMPE B,DDIR		;DISK
	CAIE B,3		;DECTAPE
	 ERROR <Illegal device>
	TLOA F,B12		;DECTAPE. DEV DESIGNATOR IN A.

;DISK
;E,F, AND Z STILL CONTAIN VARIOUS FLAGS (SEE ABOVE)

DDIR:	TLZ F,B12
	CALL DNAME		;TYPE DIRECTORY NAME IF APPROPRIATE
	CALL DSKDIR		;LIST IT

;DONE A DEVICE OR DIRECTORY.
;F2 SET IF MORE FILES FOR THIS JFN.

	TLNE Z,F2
	JRST DIRFL		;DO NEXT ONE FOR THIS JFN (NOW GNJFN'D)

;NEXT ARGUMENT IN LIST
	AOS A,INIFH1		;STEP POINTER INTO JFN BUFFER
	CAMG A,INIFH2		;BEYOND END?
	JRST DIRFL		;NO
	CALL UNMDIR		;UNMAP BUFFERS
	MOVE A,OUTDSG
	SKIPG DSKTTC		;If more than one disk JFN displayed
	SKIPLE DTATTC		;Or more than one DECtape JFN displayed,
	CALL DIRTOT		;Print totals
	MOVEI B,CR
	BOUT			;BLANK LINE AFTER ALL
	MOVEI B,LF
	BOUT
	CALL RLJFNS		;RELEASE JFNS
	JRST CMDIN4		;GO GET NEXT COMMAND

;UNMDIR	- unmap pages from BUF1 thru EPBUF
; RET +1; always
;
;(Destroys: A,B,C)

UNMDIR:	SETO A,
	MOVE B,[.FHSLF,,<BUF1>B44]
	SETZ C,
	PMAP
	CAMGE B,[.FHSLF,,<EPBUF>B44]
	AOJA B,.-2
	RET

;DIRECTORY...

;SUBCOMMAND TABLE

$DIR:	TABLE
	T ACCOUNT,,ONEWD,...ACC
	T ALPHABETIC,,ONEWD
	T AUTHOR,,ONEWD
	T BEGIN,,ONEWD,0
	TE BOTH,,LPROK,..BOTH
	TE CHRONOLOGICAL,,LPROK
	T CRAM,,ONEWD
	TE DATES,,LPROK
	TE DELETED,,LPROK,..DELE
	T DOUBLESPACE,,ONEWD
	T EVERYTHING,,ONEWD
	TE LENGTH,,LPROK
NOIAC <	TE LPT >
	TE NO,,LPROK,..NO
	T OUTPUT,,CONMAN+LPROK
	T PROTECTION,,ONEWD,..PROT
	T READER,,ONEWD,..READ
	T REVERSE,,ONEWD
	TE SEPARATE,,LPROK
	T SIZE,,ONEWD,..SIZE
	T STATUS,,ONEWD,...STA
	TE TAPE,,LPROK,...TAP
	T TEN50,,ONEWD+INVIS,..TEN5
	TE TIMES,,LPROK
	TE TOTAL,,LPROK,..TOTAL
	T VERBOSE,,ONEWD
	TEND

;SUB-COMMAND ROUTINES FOR "DIRECTORY" COMMAND

...ACC:	TRO E,1B20
	RET

.ALPHA:	TRZ Z,36		;CLEAR ORDER OF PRINTOUT FLAGS
	TRO Z,1B34		;SAY ALPHABETIC
	RET

.AUTHO:	CONFIRM
	TRO E,1B30
	RET

..BOTH:	NOISE (deleted and undeleted files)
	CONFIRM
	TLO F,B9
	RET

.CHRON:	NOISE (by)
	KEYWD $CHRON
	TE WRITE,,LPROK,20	;NULL DEFAULTS TO THIS
	 JRST CERR		;NOT FOUND IN TABLE
	CONFIRM
	TRZ Z,36		;CLR FLAGS RELATED TO ORDER OF PRINTOUT
	ORI Z,(KWV)		;AND OR IN THOSE FROM RESPONSE DECODING
	RET

$CHRON:	TABLE
	TE CREATION,,LPROK,4
	TE READ,,LPROK,10
	TE WRITE,,LPROK,20
	TEND

;DIRECTORY SUB-COMMANDS...

.CRAM:	TRO E,1B32
	RET

.DATES:	NOISE (of)
	TLZ Z,F1
DATES1:	KEYWD $DATE		;"TIMES" JOINS HERE
	 TE WRITE,,,1B24
	 JRST CERR
	CONFIRM
	MOVEI KWV,(KWV)
	TRZE KWV,1		;ODD MEANS FOR F INSTEAD OF E
	JRST DATES2
	TLNE Z,F1
	LSH KWV,-4		;TIME ARE 4 BITS TO LEFT OF DATE BITS
	IORI E,(KWV)		;UPDATES JFNS OPTIONS FROM TABLE
	RET

DATES2:	TLNE Z,F1		;DATE OR TIME?
	LSH KWV,-4		;TIME
	TLO F,(KWV)
	RET

.TIMES:	NOISE (and dates of)
	TLO Z,F1
	JRST DATES1

$DATE:	TABLE
	TE ARCHIVE,,,200001	;
	TE CREATION,,,1B23
	TE DUMP,,,400001	;
	TE READ,,,1B25
	TE WRITE,,,1B24
	TEND

..DELE:	NOISE (files only)
	CONFIRM
	TLO F,B8+B17		;Deleted files only, and total
	RET

.DOUBL:	TLO F,2			;SAY DOUBLE SPACE
	RET

.EVERY:	IOR E,[00111137761]	;ALL FIELDS THAT CAN BE PRINTED
	TLO F,B8		;Total
	RET			;THIS IS TOO MUCH TO FIT ONE TTY LINE.

.LENGT:	NOISE (in bytes)
	CONFIRM
	TRO E,1B26		;SAY PRINT LENGTH IN BYTES
	RET

;DIRECTORY SUB-COMMANDS...

;"LPT" IS SHORT FOR "OUTPUT (TO) LPT:"

.LPT:	CONFIRM
;"LIST" CALLS "$LPT" AS A SUBROUTINE TO ASSIGN A JFN TO LPT.

$LPT:	MOVE B,[POINT 7,[ASCIZ /LPT:/],-1]
;"EDDT" CALLS $GTJFN WITH TEXT POINTER IN B.

$GTJFN:	HLRZ A,JBUFP		;CHECK FIRST FOR JFN STACK SPACE
	CAIN A,-1		;WOULD PDL OV OCCUR AT NEXT PUSH?
	 ERROR <Too many JFN's in command>;	YES.
	HRLZI A,B2+B17		;OLD FILES ONLY, SHORT GTJFN CALL.
	GTJFN
	 CALL JERR
	MOVE B,JBUFP
	PUSH B,A
	MOVEM B,JBUFP
LPT5:	MOVEM A,OUTDSG		;JFN.
	RET

.OUTPU:	NOISE (to file)
	MOVE A,[[ASCIZ /DIR/],,[ASCIZ /DIR/]] ;DEFAULT NAME & EXT
	CALL COUTFN
	 JRST CERR
	CONFIRM
	JRST LPT5

..NO:	NOISE (heading)
	CONFIRM
	TLO F,B13
	RET

..PROT:	TLO E,1			;SAY PRINT PROTECTION
	RET

..READ:	TRO E,1B31		;LAST READER
	RET

.REVER:	TRO Z,1			;SAY LIST IN REVERSE ORDER
	RET

.SEPAR:	NOISE (lines for each version);MAINLY A DEBUGGING CMD
	CONFIRM
	TLO F,B14
	TLO F,B8		;
	RET

..SIZE:	TRO E,1B22
	TLO F,B8
	RET

...STA:	TLO F,B6		;
	RET			;

...TAP:	NOISE <numbers of>
	KEYWD $TAPE
	 T ARCHIVE,,EOLOK,40000
	 JRST CERR
	CONFIRM
	TLO F,(KWV)
	RET

$TAPE:	TABLE
	T ARCHIVE,,EOLOK,40000
	T DUMP,,EOLOK,100000
	TEND

..TEN5:	TLO F,B11
	RET

;TIMES: SEE PREVIOUS PAGE

..TOTAL:
	NOISE (space used by files)
	CONFIRM
	TLO F,B8
	RET

.VERBO:	IOR E,[001111166061] 	;ALL BUT CREATION DATE, LEN. IN BYTES,
	TLO F,B8		;ASK FOR TOTALS ALSO
	RET			;TIMES.  FITS ON ONE TTY LINE.

;DHEAD
;TYPE HEADING, IF ANY, FOR DISK FILE DIRECTORY PRINTOUT.
;THIS ROUTINE MUST BE CHANGED WHENEVER DFILE'S FORMAT IS CHANGED!
;TAKES:	OUTDSG: OUTJFN
;	E: FIELDS TO PRINT BITS
;	F: B13 TO SUPPRESS HEADING

DHEAD:	PUSH P,A
	MOVE A,DIRNO
	CAMN A,OLDDIR
	JRST DHEADZ		;NO CHANGE, FORGET HEADING
	MOVEM A,OLDDIR
	TLNE F,B10+B12+B13	;"QFD","SUPP. HEAD." OR "DTA" FLAG ON?
	 JRST DHEADZ		;YES,NON-VERBOSE LISTINGS GET NO HEADING
	TLNN F,774000		;ARCHIVE OR DUMP DATA TO PRINT?
	TRNE E,1777B31		;SOMETHING TO LIST AFTER ACCT FIELD?
	 JRST DHEAD1		;YES, GO PRINT HEADING
	JRST DHEADZ		;NO, SKIP HEADING
DHEAD1:	PUSH P,B
	PUSH P,C
	MOVE A,OUTDSG
	CALL DINDNT		;INDENT RIGHT AMT. FOR FIELDS TO PRINT
;PRINT HEADERS FOR THE COLUMNS TO BE INCLUDED IN THIS LISTING
	MOVEI B,SPACE		;If undeleted & deleted
	TLNE F,B9
	BOUT			; extra space
	SETZ C,
	HRROI B,[ASCIZ /Pgs  /]
	TRNE E,1B22		;SIZE IN PAGES
	SOUT
	HRROI B,[ASCIZ /Bytes(SZ) /]
	TRNE E,1B26		;SIZE IN BYTES
	CALL DHSOUT
	HRROI B,[ASCIZ /Creation /]
	TRNE E,1B23+1B27	;CREATION DATE
	CALL DHSOUT
	HRROI B,[ASCIZ /        /]
	TRNE E,1B27		;CREATION TIME
	CALL DHSOUT
	HRROI B,[ASCIZ /Write    /]
	TRNE E,1B24+1B28
	CALL DHSOUT
	HRROI B,[ASCIZ /        /]
	TRNE E,1B28
	CALL DHSOUT
	HRROI B,[ASCIZ /Read     /]
	TRNE E,1B25+1B29
	CALL DHSOUT
	HRROI B,[ASCIZ /        /]
	TRNE E,1B29
	CALL DHSOUT
	HRROI B,[ASCIZ /Dump/]	;
	TLNE F,B0+B2+B4		;
	CALL DHSOUT		;
	HRROI B,[ASCIZ /         /] ;
	TLNE F,B0+B4		;
	CALL DHSOUT		;
	HRROI B,[ASCIZ /        /] ;
	TLNE F,B4		;
	CALL DHSOUT		;
	TLNN F,B1+B3+B5		;
	 JRST DHEAD3		;NO ARCHIVE
	TLNE F,B1+B5		;
	 JRST DHEAD2		;
	HRROI B,[ASCIZ /Archive  /] ;TAPE NUMBERS ONLY
	CALL DHSOUT		;
	JRST DHEAD3		;
DHEAD2:	HRROI B,[ASCIZ /First Archive /] ;
	CALL DHSOUT		;
	HRROI B,[ASCIZ /        /] ;
	TLNE F,B5		;
	CALL DHSOUT		;
	HRROI B,[ASCIZ /Second Archive/] ;
	CALL DHSOUT		;
	HRROI B,[ASCIZ /        /] ;
	TLNE F,B5		;
	CALL DHSOUT		;
DHEAD3:	HRROI B,[ASCIZ /Author/]
	TRNE E,1B30
	CALL DHSOUT
	HRROI B,[ASCIZ /Reader/] ;
	TRNE E,1B31		;DO READER IF ASKED
	CALL DHSOUT		;
	HRROI B,[ASCIZ /Status/]
	TLNE F,B6
	SOUT
	HRROI B,[ASCIZ /

/]
	SOUT
DHEADX:	POP P,C
	POP P,B
DHEADZ:	POP P,A
	RET

;DINDNT: SUBR TO INDENT THE RIGHT AMOUNT BEFORE HEADING,
; AS A FUNCTION OF FIELDS TO BE PRINTED.
;ALSO USED BY DFREST WHEN GOING TO A NEW LINE.

DINDNT:	MOVEI B,TAB
	BOUT			;NAME, EXT, VERSION CROSS FIRST TAB STOP
	TLNE E,<3B17>B53	;PROTECTION, IF REQUESTED IN PRINTOUT,
	BOUT			;CROSSES ANOTHER TAB STOP.
	TRNE E,3B20		;ACCT CROSSES ANOTHER.
	BOUT
	TRNN E,1B32		;UNLESS COLUMNATION SUPPRESSED,
	BOUT			;FOLLOWING FIELDS BEGIN AT NEXT TAB STOP
	RET

;DHSOUT: SOUT AND APPEND SPACE UNLESS COLUMNATION SUPPPRESSED (E B32 ON)
;FOR "DHEAD". CLOBBERS B.

DHSOUT:	SOUT
	MOVEI B,SPACE
	TRNN E,1B32
	BOUT
	RET

;DNAME
;SUBROUTINE TO TYPE DIRECTORY NAME IF "*" GIVEN
;FOR DIRECTORY OR IF MORE THAN ONE ARGUMENT
;IN LIST OR IF OUTPUT NOT TO TERMINAL.

DNAME:	TLNE F,B13
	RET			;HEADING SUPPRESSED
	PUSH P,A
	PUSH P,B
	PUSH P,C
	MOVE A,OUTDSG		;DESTINATION
	MOVE C,@INIFH1		;JFN OF CURRENT ARG
	CAMN C,[-2]		;FOR EMPTY DIR TYPE NOTHING
	JRST DNAMEX		;RETURN
	MOVE A,CSBUFP		;JFNS TO STRING BUFFER
	MOVE B,OUTDSG		;OUTPUT JFN
	CAME B,COJFN		;GOING TO OTHER THAN PRIMARY?
	 CALL SITEO		;OUTPUT SITE
	MOVEI B,(C)
	MOVE C,[2B2+1B5+1B35]	;DEFAULT DEV, PRINT DIR
	TLNE F,B12
	MOVE C,[2B2+1B35]	;DECTAPE: DEVICE ONLY
	MOVE D,A		;SAVE BEG OF DIRECTORY NAME FOR BELOW
	JFNS
	CAMN A,CSBUFP
	JRST DNAMEX		;NULL STRING, PRINT NOTHING
DNAME4:	MOVE 2,OUTDSG
	CAMN 2,COJFN		;GOING TO PRIMARY OUTJFN ?
	 JRST DNAME5		;YES, NO DATE AND TIME
	PUSH P,A		;SAVE PTR INTO CSBUF
	HRROI 2,[ASCIZ / #(/]	;LEADER FOR NUMBER OF DIRECTORY
	SETZM 3
	SOUT
	PUSH P,A		; SAVE CURRENT POINTER
	MOVE A,-1(P)		; GET POINTER TO DIRECTORY NAME STRING
	CALL DNAME7		; GET DIRNUM (DIRNO)
	MOVE B,A
	POP P,A
	MOVEI C,10		; OCTAL
	NOUT
	 JFCL
	HRROI B,[ASCIZ /) /]
	SETZ C,
	SOUT
	SETOM 2
	ODTIM			;AND THE TIME
	POP P,A			;RESTORE PTR TO END OF DIR NAME
DNAME5:	TLNE F,B12
	 JRST [	SETOM OLDDIR	;DTA:  BESURE HEADING, ETC WILL PRINT
		JRST DNAME8]
DNAME6:	CALL DNAME7		; GET DIRECTORY NUMBER
	MOVEM A,DIRNO		;REMEMBER DIRECTORY NUMBER
	CAMN A,OLDDIR
	JRST DNAMEX		;NO CHANGE, DON'T PRINT AGAIN
DNAME8:	MOVE A,OUTDSG
	SETZ C,
	HRROI B,[ASCIZ /   /]
	SOUT			;INDENT FOR DIR NAME
	MOVE B,CSBUFP
	SOUT
	HRROI B,[ASCIZ /
/]
	SOUT
DNAMEX:	POP P,C
	POP P,B
	POP P,A
	RET


DNAME7:	SETZM B
	DPB B,A			;FLUSH THE CLOSING LESS THAN SIGN
	PUSH P,A
	SETZM A
	MOVE B,D		;PTR TO BEGINNING OF DIRECTORY
	IBP B			;PASS THE OPENING GREATER THAN SIGN
	STDIR
	 JFCL			;NO MATCH (CAN'T HAPPEN)
	 JFCL			;AMBIGUOUS (CAN'T HAPPEN)
	POP P,B
	MOVEI C,">"
	DPB C,B			;PUT IT BACK
	HRRZS A
	RET

;$GTFDB
;SUBROUTINE TO DO GTFDB JSYS AND SKIP UNLESS
;AN INSTRUCTION TRAP WITH "LIST ACCESS NOT ALLOWED"
;ERROR OCCURED.
;USED IN DIRECTORY, UNDELETE, DSKSTAT, COPY/APPEND, LIST/TYPE.
;SHOULD BE IN SAME PAGE AS DSKDIR CAUSE ITS IN A LOOP THERE.

$GTFDB:	GTFDB
	 ERJMP FDBILI
	AOS (P)
	RET

;TRAP OCCURRED, CHECK ERROR CODE

FDBILI:	PUSH P,A
	CALL LSTERR
	CAIE A,GFDBX3		;"LIST ACCESS NOT ALLOWED"?
	JRST [	POP P,A
		JRST ILITRP##]	;NO,TREAT AS OTHER ILL INST TRAPS.
	POP P,A
	RET

;DSKDIR
;SUBROUTINE TO LIST DISK OR DECTAPE DIRECTORY
;READS (WITH GNJFN),SORTS,PRINTS ONE DIRECTORY
;TAKES:	A: SOURCE DEVICE DESIGNATOR FOR DECTAPE
;	OUTDSG: DESTINATION JFN
;	INIFH1:	POINTER TO INDEXABLE FILE HANDLE
;	Z,E,F:	VARIOUS FLAGS, SEE COMMENTS AT
;		BEGINNING OF "DIRECTORY", INCL F B12 FOR DECTAPE.
;RETURNS F2 SET IF ADDITIONAL FILES ARE TO BE LISTED
;	FOR CURRENT INDEXABLE FILE HANDLE.
;CLOBBERS A-D,G-GG.

;BUFFER DEFINITIONS

DTADRC==BUF1			;WHERE DECTAPE DIRECTORY IS READ
DTATBL==BUF1+200		;TABLE FOR DECTAPE FILE LENGTHS
TABLE=BUF2			;WHERE SYMBOL TABLE IS BUILT
TABLEN==777			;LENGTH OF TABLE. CANNOT
				;BE GREATER THAN 511.
DIRBUF=TABLE+TABLEN		;BOTTOM OF STRING AND FDB STORAGE

;SUCCESSIVE PAGES UPWARD FROM BUF1 ARE USED.
;THERE ARE ENOUGH PAGES BELOW DDT AS LONG
;AS DIRECTORY LENGTH REMAINS LIMITED TO 4K.

DSKDIR:	SETZM DSKCT		;Initialize file and space counts to zero
	SETZM DSKSP		; for disk and DECtape
	SETZM DTACT		; in preperation to display this JFN..
	SETZM DTASP
	TLNN F,B12		;DECTAPE?
	JRST DSKD2		;NO
	TLNE F,B11		;TEN50 FORMAT REQUESTED?
	JRST OLDTAD		;YES, USE OLD ROUTINE.
	TRNN Z,36		;ORDERING SPECIFIED?
	TRO Z,1B34		;NO, DEFAULT TO ALPHABETIC

;DSKDIR...
;DECTAPE SPECIFIC PROCESSING.

;FORMAT OF THE DIRECTORY BLOCK ON DECTAPE:
; WORDS 0-82: 5-BIT "SLOTS", 1 PER BLOCK: 0 FREE,
;					  1-22 FILE NUMBER
;					  27 DIRECTORY & TENDUMP BLOCKS
; WORDS 83-104: NAMES OF FILES 1-22
; WORDS 105-126: LH: EXT. B24-35: WRITE DATE.
; WORD 127: SIXBIT TAPE ID

;READ DIRECTORY
	MOVEI B,DTADRC		;WHERE TO READ IT. DEV DESIG STILL IN A.
	RDDIR			;READ IT
	 CALL [	CAIN A,RDDIX1
		 ERROR <Trouble reading directory, maybe DECtape not "remote">
		JRST JERR]

;SCAN "SLOTS" PORTION OF DIRECTORY, COUNTING BLOCKS IN FILES
	MOVE B,[POINT 5,DTADRC,-1]	;5 BITS PER BLOCK ON TAPE
	MOVEI C,^D578		;# BLOCKS ON TAPE
	ILDB D,B		;FETCH A SLOT BYTE
	AOS DTATBL(D)		;INDEX APPROPRIATE TABLE WORD
	SOJG C,.-2

;TYPE # FREE BLOCKS
;SUPPRESS IF NOT LISTING WHOLE DIRECTORY ??
	TRNE E,1B32
	JRST DSKD2		;OMIT IN CRAM FORMAT (QFD)
	MOVE A,OUTDSG
	HRROI B,[ASCIZ /
/]
	SETZ C,
	TLNE F,B16
	SOUT			;EXTRA CRLF IF DOUBLE-SPACING
	MOVEI B,SPACE
	BOUT
	MOVE B,DTATBL+0
	MOVEI C,^D10
	NOUT
	 CALL JERRC
	HRROI B,[ASCIZ / Free blocks/]
	SETZ C,
	SOUT
	MOVE C,DTADRC+^D127
	CALL TAPID
DSKD2:	CALL DHEAD		;PRINT COLUMN HEADS IF APPROPRIATE
	MOVE A,OUTDSG
	HRROI B,[ASCIZ /
/]
	SETZ C,
	TLNE F,B16
	SOUT			;EXTRA CRLF IF DOUBLE-SPACING

;DSKDIR ...
;READ FDB, NAME, EXT OF EACH FILE TO LIST,
;LOOPING OVER FILES WITH GNJFN, STOPPING IF DEVICE OR
;DIRECTORY CHANGES.
;IN FDB PUT POINTERS TO NAME, EXT, AND ACCT STRINGS.
;FOR DECTAPE FILES A DUMMY FDB CONTAINING NAME, EXT, WRITE DATE,
;  # BLOCKS, AND THE REST 0 IS BUILT
;FORM TABLE OF POINTERS TO FDB'S STARTING AT "TABLE".
;LH OF EACH POINTER WORDS HAS 9-BIT REVERSE AND
;FORWARD LIST POINTERS TO PERMIT SORTING IN PLACE
;AND LISTING IN FORWARD OR REVERSE ORDER.
;WORD TABLE +0 IS A DUMMY, WITH FORWARD POINTER
;TO HEAD OF LIST, REVERSE POINTER TO END, AND
;0 RH TO TERMINATE SORT AND PRINT OPERATIONS.
;FIRST ENTRY IN LIST HAS 0 REV PTR, LAST HAS 0 FWD PTR.

	MOVEI GG,0		;INITIALIZE TABLE INDEX
	MOVEI C,DIRBUF		;INITIALIZE BUFFER SPACE POINTER
	MOVE A,@INIFH1
	CAMN A,[-2]		;IS IT A COMPLETELY EMPTY DIRECTORY ?
	JRST DSKR9		;YES.
	HRRI F,16		;USE R.H. OF F FOR FDB SIZE
	TLNE F,774000		;ANY ARCHIVE STUFF?
	HRRI F,25		;YES -- READ ENTIRE FDB
;TOP OF LOOP

;CHECK FOR TABLE FULL, IF SO PRINT MULTIPLE PARTIAL DIRECTORIES

DSKR1:	CAIG C,EPBUF-60
	CAIL GG,TABLEN-2	;BOTH ENDS MUST HAVE 0'S
	JRST [	UTYPE [ASCIZ / Storage full,
 Directory will be printed in two sections
/]
		JRST DSKR8]	;GO SET F2, LIST THIS MUCH.

;DSKDIR... READ...
;READ AND STORE FDB AND STRINGS FOR A FILE
	TLNE F,B12
	JRST DSKR2		;FOR DTA LEAVE A 0 BLOCK FOR "FDB"
	HRRZ A,@INIFH1		;JFN
	HRLZ B,F		;FDB -- NUMBER OF WORDS TO READ
				;C ALREADY SET RIGHT
	CALL $GTFDB		;DO GTFDB JSYS AND SKIP UNLESS...
	JRST [	TLO Z,F1	;LIST ACCESS NOT ALLOWED
		JRST DSKR7]	;FLAG INVOKES MSG LATER
	TLNE F,B9		;Undeleted & deleted?
	JRST DSKR2		; Yes
	MOVE A,FDBCTL(C)	;CONTROL BITS WORD OF FDB
	TLNE F,B17		;"DELETED FILES ONLY" REQUESTED?
	TLC A,<FDBDEL>B53	;YES,COMPLEMENT "DELETED" BIT
	TLNE A,<FDBDEL>B53	;THIS FILE DELETED OR NOT AS REQUESTED?
	JRST DSKR7		;NO SKIP IT.
DSKR2:	MOVE D,C		;WHERE THIS FDB IS
	HRRO A,F		;CREATE STRING POINTER PAST FDB
	ADDI A,0(D)		;
	HRRM A,FDBCTL(D)	;NAME POINTER TO FDB
	HRRZ B,@INIFH1		;JFN
	HRLZI C,B8		;FORMAT
	JFNS			;GET NAME STRING
	HRROI A,2(A)		;STRING PTR TO BEG OF NEXT WORD TO USE
				;LEAVES A 0 WORD TO TERMINATE
				;STRING FOR SORT.
	HRLM A,FDBEXT(D)	;EXT PTR TO FDB
	HRLZI C,B11
	JFNS			;EXTENSION STRING
	MOVE B,FDBACT(D)	;ACCOUNT
	JUMPLE B,DSKR2A		;NUMERIC OR MISSING
	HRROI A,2(A)
	HRRZM A,FDBACT(D)
	HRRZ B,@INIFH1
	MOVEI C,1B20
	JFNS			;GET ACCOUNT STRING
DSKR2A:	TLNN F,B12		;Disk?
	TLNN F,B8		;Total wanted?
	JRST DSKR4		; no
	AOS DSKCT		;Update total files
	AOS DSKGCT
	HRRZ C,FDBBYV(D)	;Update total space
	ADDM C,DSKSP
	ADDM C,DSKGSP

DSKR4:	MOVEI C,2(A)		;WHERE TO STORE NEXT FDB
				;AGAIN LEAVING A 0 WORD POINTER
	TLNN F,B12
	JRST DSKR5
;FOR DTA PICK UP DATE AND SIZE
;SEARCH DIRECTORY TO GET DATE (IN SAME WORD AS EXT)
;AND SIZE (AT SAME INDEX INTO DTATBL).
	HRLZI AA,-^D22

;CONVERT NAME AND EXT FROM "FDB" TO SIXBIT IN BB, CC.
;CLOBBERS BB-FF.
	HRLI EE,<POINT 7,0,-1>B53	;NAME
	HRR EE,FDBCTL(D)
	MOVEI FF,6
DTADRN:	ILDB CC,EE		;NAME CHAR LOOP
	JUMPE CC,.+2
	SUBI CC,40
	LSH CC,36
	LSHC BB,6
	SOJG FF,DTADRN
	HRLI EE,<POINT 7,0,-1>B53	;EXTENSION
	HLR EE,FDBEXT(D)
	MOVEI FF,3
DTADRE:	ILDB DD,EE		;EXT CHAR LOOP
	JUMPE DD,.+2
	SUBI DD,40
	LSH DD,36
	LSHC CC,6		;EXT ENDS UP IN RH CC, GARBAGE IN LH.
	SOJG FF,DTADRE
DTADR1:	CAME BB,DTADRC+^D83(AA)
	JRST DTADR9		;WRONG NAME
	HRLZ B,CC		;EXT,,0 FROM "FDB"
	XOR B,DTADRC+^D105(AA)	;COMPARE EXT, PICK UP DATE FROM DTADRC
	TLNE B,-1
	JRST DTADR9		;WRONG EXT
	PUSH P,C		;NEED AC
	MOVEI C,1B35		;TO TEST FOR OTHER DATE BITS
	TRZ B,7B23		;AND MASK THEM INTO DATE FIELD
	TDNE C,DTADRC+0(AA)
	TRO B,1B23
	TDNE C,DTADRC+^D22(AA)
	TRO B,1B22
	TDNE C,DTADRC+^D44(AA)
	TRO B,1B21
	POP P,C
	DPB B,[POINT 15,FDBWRT(D),35]	;DATE TO "FDB"
	MOVE B,DTATBL+1(AA)
	HRRM B,FDBBYV(D)	;SIZE IN BLOCKS
	TLNN F,B8		;Totals wanted?
	JRST DSKR5		; no
	AOS DTACT		;Update file count
	AOS DTAGCT
	ADDM B,DTASP		;Update total space
	ADDM B,DTAGSP
	JRST DSKR5
DTADR9:	AOBJN AA,DTADR1		;IF NOT FOUND LEAVE THINGS 0

;DSKDIR... READ...
;MAKE TABLE ENTRY

DSKR5:	DPB GG,[POINT 9,TABLE+1(GG),8]	;REVERSE POINTER
					;TO ENTRY WE ARE ABOUT TO USE
	MOVEI GG,1(GG)			;INCREMENT TABLE INDEX
	DPB GG,[POINT 9,TABLE-1(GG),17]	;FORWARD POINTER
					;TO PREVIOUS ENTRY
					;LEAVES 0 IN LAST ENTRY.
	HRRM D,TABLE(GG)		;PTR TO FDB TO THIS TABLE ENTRY

;STEP TO NEXT FILE, STOP IF ANOTHER DEVICE OR DIRECTORY

DSKR7:	MOVE A,@INIFH1
	TLNE A,<77B5>B53	;IF NO *-FLAGS SKIP GNJFN
	GNJFN
	 JRST DSKR9		;NO MORE,DONE READING
	TLNN A,70		;DEVICE OR DIRECTORY CHANGED?
	JRST DSKR1		;NO,DO THIS FILE.
DSKR8:	TLO Z,F2		;YES,SAY THERE'S MORE FOR THIS JFN,
				;SORT AND PRINT WHAT WE HAVE
DSKR9:	DPB GG,[POINT 9,TABLE,8];PUT "REVERSE" POINTER
				;TO LAST ENTRY IN DUMMY ENTRY 0.
				;USED FOR REVERSE UNSORTED LISTING.
	TRNN Z,36		;ANY ORDER-OF-PRINTOUT FLAGS ON?
	JRST DSKP		;NO, NO SORT REQUIRED, GO PRINT

;DSKDIR...

;SORT DISK DIRECTORY
;FOR EACH SUCCESSIVE WORD OF UNSORTED TABLE, FIND
;PLACE TO PUT IT IN LIST-STRUCTURED TABLE, STARTING
;FROM LAST INSERTED ENTRY TO MAKE MAXIMUM
;USE OF PARTIAL ORDERING.
;ENDS OF LIST ARE INDICATED BY 0 RH OF TABLE WORD.
;START WITH ZEROED WORD 0; THIS PUTS POINTERS TO IT
;(AS TERMINATING ENTRY) AT EACH END OF LIST.

	SETZM TABLE		;INITIALIZE SORTED TABLE:
				;MAKES LAST FIND AND FIRST REV
				;PTR POINT TO A WORD (NAMELY THIS WORD) 
				;WITH 0 RH.
	MOVEI GG,0		;INDEX OF CURRENT (LAST INSERTED)
				;SORTED TABLE ENTRY
	MOVEI AA,1		;INDEX INTO UNSORTED TABLE

;TOP OF LOOP

DSKS1:	SKIPN TABLE(AA)
	JRST DSKP		;NO MORE TO SORT, GO PRINT
	CALL FDBSC		;COMPARE ENTRY (GG) TO (AA),3 RETURNS
	 JRST LESS		;UNSORTED ENTRY (GG) LESS
	 JRST HERE		;EQUAL

;UNSORTED ENTRY GREATER, SEARCH FORWARD

GRATR:	LDB GG,[POINT 9,TABLE(GG),17]	;GET FWD PTR
	CALL FDBSC		;COMPARE AGAIN
	 JRST .+3		;LESS
	 JRST .+2		;EQUAL OR AT END OF TABLE
	JRST GRATR		;GREATER, KEEP SEARCHING

;LESS OR EQUAL, PUT IT BEFORE THIS ONE

	LDB GG,[POINT 9,TABLE(GG),8]	;BACK UP 1
	JRST HERE		;PUT IT AFTER THIS ONE

;UNSORTED ENTRY LESS, SEARCH BACKWARD

LESS:	LDB GG,[POINT 9,TABLE(GG),8]	;GET REVERSE PTR
	CALL FDBSC
	 JRST LESS		;KEEP SEARCHING
	 JRST HERE		;EQUAL OR BEGINNING OF TABLE

;INSERT ENTRY AFTER CURRENT ENTRY BY UPDATING LIST POINTERS

HERE:	LDB A,[POINT 9,TABLE(GG),17]	;SORTED ENTRY'S FWD PTR
	DPB A,[POINT 9,TABLE(AA),17]	;TO ENTRY BEING INSERTED
	DPB AA,[POINT 9,TABLE(GG),17]	;SET FWD PTR OF
			;SORTED ENTRY TO POINT AT NEW ENTRY
	DPB AA,[POINT 9,TABLE(A),8]	;SET REV PTR OF ENTRY
			;FOLLOWING SORTED ENTRY TO POINT AT NEW ENTRY
	DPB GG,[POINT 9,TABLE(AA),8]	;SET NEW ENTRY'S REV
			;PTR TO POINT PREVIOUS SORTED ENTRY
	MOVE GG,AA	;ENTRY JUST INSERTED IS CURRENT
	AOJA AA,DSKS1	;BOTTOM OF LOOP: NEXT UNSORTED ONE

;DSKDIR...
;SUBROUTINE FDBSC FOR SORT
;COMPARE FDB'S THAT TABLE ENTRIES SPECIFIED BY INDICES
;IN GG AND AA POINT TO.
;RETURN+1 IF GG LESS, +2 =, +3 GREATER
;ACCORDING TO SORT KEY SPECIFIED BY FLAGS IN RHZ
;RET +2 IF GG POINTS TO NULL TABLE ENTRY.
;CLOBBERS A - D, G, BB.

FDBSC:	HRRZ BB,TABLE(GG)	;BB POINTS TO FIRST FDB
	HRRZ G,TABLE(AA)	;G TO SECOND
	JUMPE BB,FDBEQ		;NULL, RETURN AS THOUGH EQUAL.
	TRNN Z,1B34
	JRST FDBSC2

;ALPHABETIC COMPARISON.

	HRRZ A,FDBCTL(BB)	;NAME PTRS
	HRRZ B,FDBCTL(G)
	CALL FDBSTC		;STRING COMPARE RETURNS HERE
				;ONLY IF EQUAL.

;NAMES =, COMPARE EXTENSIONS

	HLRZ A,FDBEXT(BB)
	HLRZ B,FDBEXT(G)
	CALL FDBSTC

;=, COMPARE VERSIONS

	HLRZ A,FDBVER(BB)
	HLRZ B,FDBVER(G)
	JRST FDBSC3		;JOIN CHRONOLOGICAL CASE FOR COMPARE

;DSKDIR SORT SUBR FDBSC...
;FOR EACH CHRONOLOGICAL COMPARISON FETCH THE DATES AND TIMES
;TO COMPARE THEN CONVERGE ON COMPARE

FDBSC2:	TRNN Z,1B31
	JRST .+4
	MOVE A,FDBWRT(BB)	;WRITE
	MOVE B,FDBWRT(G)
	JRST FDBSC3
	TRNN Z,1B32
	JRST .+4
	MOVE A,FDBREF(BB)	;READ
	MOVE B,FDBREF(G)
	JRST FDBSC3
	TRNN Z,1B33
	JRST FDBGR		;NO SORTING SPEC. (IE DIRECTORY ORDER)
				;TREAT AS THO GREATER.  NOTE THAT
				;"REVERSE" STILL WORKS

;THIS IS WHERE TO ADD CASES

	MOVE A,FDBCRV(BB)	;CREATE
	MOVE B,FDBCRV(G)
FDBSC3:	CAMN A,B
	JRST FDBEQ
	CAML A,B		;RETURN "GREATER" IF DATE LESS
	JRST FDBLS		;BECAUSE DEFAULT ORDER IS
	JRST FDBGR		;REVERSE CHRONOLOGICAL
FDBGR:	AOS (P)
FDBEQ:	AOS (P)
FDBLS:	RET

;DSKDIR... SORT...
;FDBSTC: STRING COMPARE FOR FDBSC.
;A AND B POINT TO STRING BLOCKS WITH
;HEADER WORD AND 0 WORD AFTER.
;RETURNS IF =, ELSE GOES TO FDBLS OR FDBGR.
;CLOBBERS A-D.

FDBST1:	SKIPN (A)		;WORDS =. END OF STRINGS?
	RET			;YES, STRINGS =.
	MOVEI A,1(A)
	MOVEI B,1(B)

;ENTER HERE

FDBSTC:	JCRY0 .+1
	MOVE C,(A)		;FETCH WORD OF FIRST STRING 
				;PASSING HEADER WORD.
	SUB C,(B)		;SUBTRACT WORD OF 2ND STRING
	JUMPE C,FDBST1		;WORDS =?
	JCRY0 [	SUB P,[1,,1]	;FORGET RETURN
		JRST FDBLS]
	SUB P,[1,,1]
	JRST FDBGR

;DSKDIR...
;PRINT DISK DIRECTORY

DSKP:	SETZM LPNAME
	SETZM LPEXT
	SETZM LPFDB

;COPY FLAGS APPROPRIATE TO DEVICE FORM E TO BB
	MOVE BB,E		;ALL FOR DISK
	TLNE F,B12
	AND BB,[7B8+7B11+1B22+1B24+1B28];DECTAPE
	MOVEI GG,0		;GG IS TABLE POINTER
				;WORD TABLE+0 IS A DUMMY,
				;NOT TO BE LISTED
DSKP1:	TRNN Z,1			;SKIP IF REVERSE ORDER
	LDB GG,[POINT 9,TABLE(GG),17]	;FWD POINTER
	TRNE Z,1			;SKIP IF NORMAL ORDER
	LDB GG,[POINT 9,TABLE(GG),8]	;REVERSE PTR
	HRRZ G,TABLE(GG)	;FDB PTR FROM TABLE ENTRY
	JUMPE G,DSKP4		;0 MEANS END
	CALL DFILE		;LIST THIS ENTRY
	JRST DSKP1

DSKP4:	CALL DFREST		;PRINT REST OF LAST LINE
	TLZN Z,F1		;ANY LIST ACCESS ERRORS?
	JRST DSKP5
	TLNN Z,GROUPF
	TYPE < List protect violation
>;			FOR A SINGLE FILE
	TLNE Z,GROUPF
	TYPE < Plus file(s) that are list protected from you
>;
DSKP5:	TLNN F,B8		;Totals wanted?
	RET
	MOVE A,OUTDSG		;Yes, blank line
	MOVEI B,CR
	BOUT
	MOVEI B,LF
	BOUT
	MOVE D,DSKSP		; then tell about the disk files
	SKIPE B,DSKCT
	CALL DSKTOT
	MOVE D,DTASP		; or the DECtape files
	SKIPE B,DTACT
	CALL DTATOT
	RET			; found thru this JFN.

;DFILE
;LIST ONE FILE
;TAKES: OUTDSG: OUTPUT JFN
;	BB: WHAT FIELDS TO PRINT BITS -- SAME AS JFNS'S EXCEPT
;	   COMBINATIONS NOT PRODUCED BY "DIRECTORY" COMMAND AREN'T
;	   NECESSARILY HANDLED.
;	   AND ALSO: B26: PRINT LENGTH IN BYTES.
;		     B27-30: CREATE, WRITE, READ TIMES (IMPLYING DATES)
;		     B32: SUPPRESS COLUMNATION
;	F: B14: DON'T PUT MULTIPLE VERSIONS OF SAME NAME.EXT
;		ON SAME LINE
;	   B15: SUPPRESS THE NORMAL OMISSION OF NAME OR NAME.EXT
;	        WHEN SAME AS THOSE LAST PRINTED
;	   B16: ON FOR DOUBLE-SPACING
;	   B17: ON TO LIST DELETED FILES ONLY
;	G: POINTER TO FDB
;AC USE
;	D: # COLS MIN TO USE FOR CURRENT FIELD / RUNNING NEGATIVE
;	   TOTAL OF PREVIOUS FIELD OVERFLOW COLUMNS (SEE "DFILL").

;CLOBBERS A, B, C, D.

;DFILE

DFILE:	MOVE A,OUTDSG
	SETZ D,			;NO FIELDS HAVE EXCEEDED MIN WIDTH YET

;NAME, EXTENSION, VERSION

	HRRZ B,FDBCTL(G)	;NAME
; IF NAME IS SAME AS THAT LAST PRINTED, JUST PRINT 3 SPACES.
	TLNE F,B15
	JRST DFL03A		;FLAG SUPPRESSES COMPACT FORMAT
	SKIPE C,LPNAME		;LAST NAME PRNTD. NONE MEANS "DIFFERENT"
	CALL DCMPR		;COMPARE CURRENT NAME TO LAST PRINTED
	 JRST DFL03A		;DIFFERENT, PRINT IT.
	HLRZ B,FDBEXT(G)
	SKIPE C,LPEXT
	CALL DCMPR		;NAME IS SAME, IS EXT SAME ALSO?
	 JRST [	CALL DFREST	;FINISH PREVIOUS LINE, IF ANY.
		CALL DFLDEL	;If both, prints prefix
		MOVE B,[POINT 7,[ASCIZ / /],-1]   ;NAME SAME, EXT DIFF
		AOJA D,DFL03B]	;PRINT SPACES AND PROCEED TO EXTENSION

;NAME AND EXTENSION ARE THE SAME AS THOSE LAST PRINTED.
;NORMALLY PUT COMMA AND ADDITIONAL VERSION ON SAME LINE UNLESS
; SOME OTHER FIELD TO BE PRINTED IS DIFFERENT,
; BUT IF THAT IS SUPPRESSED OR A FIELD IS DIFFERENT,
; START NEW LINE WITH TAB INSTEAD OF NAME.EXT.

	TLNE F,B14
	JRST DFL02B		;MULTIPLE VERSIONS PER LINE SUPPRESSED

;COMPARE CURRENT FDB TO PREVIOUS, COMPARING ONLY THOSE
; FIELDS WHICH ARE TO BE PRINTED.

	CALL DFDBCM
	 JRST DFL02B		;DIFFERENT, NEW LINE.
	MOVE D,LFPOS		;SAME, RETRIEVE "POSITION" ON THIS LINE
	MOVEI B,","		;USE A COMMA,
	SOJA D,DFL05A		;ACCOUNT COLUMN USED BY COMMA,
				;AND GO PRINT VERSION ON SAME LINE.

;FINISH OLD LINE AND START NEW FOR SAME NAME.EXT

DFL02B:	CALL DFREST		;PRINT REST OF LAST FILE'S INFO, IF ANY
	CALL DFLDEL		;If both, prints prefix
	MOVEI D,^D8		;8 COLS IF COLUMNATION NOT SUPPRESSED,
	HRROI B,[ASCIZ / /]	;ONE SPACE IF IT IS SUPPRESSED.
	CALL DFILL		;SPACES(S) IN PLACE OF NAME.EXT
	JRST DFL05		;GO PRINT VERSION

;DFILE...
;PRINT NAME

DFL03A:	CALL DFREST		;PRINT REST OF PREVIOUS LINE, IF ANY
	CALL DFLDEL		;If both, prints prefix
	MOVEI B,SPACE
	BOUT			;SPACE AT BEGINNING OF EACH LINE
	HRRO B,FDBCTL(G)	;NAME BLOCK RELATIVE LOCATION
	HRROM B,LPNAME		;REMEMBER LAST PRINTED NAME
DFL03B:	ADDI D,3		;USE 3 COLUMNS MINIMUM
	CALL DFILL		;PRINT NAME OR SPACES

;PRINT EXTENSION

	HLRO B,FDBEXT(G)	;EXT
	HRROM B,LPEXT		;REMEMBER LAST PRINTED EXTENSION
	PUSH P,B
	MOVEI B,"."		;"." IS NORMAL SEPARATOR
	BOUT
	POP P,B			;EXT PTR AGAIN
	ADDI D,3		;# COLS TO USE: 3 - EXTRAS USED FOR NAME
	CALL DFILL		;OUTPUT EXTENSION

;PRINT FIRST VERSION ON LINE

DFL05:	MOVEI B,";"
DFL05A:	TLNE BB,<1B14>B53	;SUPPRESS FOR DTA
	BOUT			;ADDIT'L VERSION ON SAME LINE JOINS HERE
	HLRZ B,FDBVER(G)	;VERSION
	MOVEI C,^D10
	TLNE BB,<1B14>B53
	CALL DFNOUT		;NOUT AND KEEP TRACK OF COLS USED.
	MOVEM G,LPFDB		;SAVE FDB ADDRESS FOR "DFREST"
	MOVEM D,LFPOS		;LINE "POSITION" (- # COLS OV) ALSO
	RET

DFLDEL:	TLNN F,B9		;Both deleted & undeleted files?
	RET
	MOVE B,FDBCTL(G)	;Yes, decide which prefix character
	TLNE B,(FDBDEL)		; should preceed the name..
	SKIPA B,["*"]		; * for deleted
	MOVEI B,SPACE		; space for undeleted
	BOUT
	RET

;PRINTING OF ADDITIONAL FIELDS FOR THIS NAME.EXT;VERSION IS DEFERRED
; SO THAT ADDITIONAL VERSION NUMBERS MAY BE PRINTED HERE, 
; SEPARATED BY COMMAS.

;DFREST
;LIST REST OF FIELDS AFTER VERSION NUMBER
;CALLED FROM DFILE WHEN A DIFFERENT VERSION NUMBER IS DETECTED,
; AND AT END OF LISTING.
;TAKES:	LPFDB:	ZERO OR POINTER TO FDB FOR WHICH TO FINISH PRINTOUT
;	LFPOS:	- # COLS LINE OVERFLOW, AS REQUIRED FOR "DFILL"
;	OUTDSG,E,F:	AS FOR "DFILE" ABOVE.
;RETURNS: LPFDB 0, B,C CLOBBERED, D-G PRESERVED.

DFREST:	SKIPN LPFDB
	RET			;NOTHING TO PRINT REST OF, RETURN.
	PUSH P,D
	PUSH P,G
	MOVE A,OUTDSG
	MOVE G,LPFDB		;LOCATION OF FDB
	MOVE D,LFPOS		;LINE OVERFLOW SITUATION
	SETZM LPFDB		;MAKE SURE IT ISN'T LISTED AGAIN

;PROTECTION

	TLNN BB,<3B17>B53
	JRST DFR07		;PRINTING PROTECTION NOT REQUESTED
	HRROI B,[ASCIZ /;P/]
	SETZ C,
	SOUT
	HLRZ B,FDBPRT(G)	;LEFT HALF OF PROTECTION WORD
	CAIE B,500000		;500000 MEANS 18-BIT OCTAL IN RH
	JRST DFR06A		;0 MEANS STRING PTR
	HRRZ B,FDBPRT(G)
	MOVEI C,10
	CALL DFNOUT		;NOUT AND KEEP TRACK OF COLUMNS USED
	JRST DFR07
DFR06A:	HRROI B,[ASCIZ /Fancy protection/]
	CALL DFILL		;DFILE WILL HAVE TO BE MODIFIED WHEN
				;HAIRY PROTECTION IS IMPLEMENTED. _____

;DFREST...
;ACCOUNT

DFR07:	TRNN BB,3B20
	JRST DFR08
	HRROI B,[ASCIZ /;A/]
	SETZ C,
	SOUT
	MOVE B,FDBACT(G)
	JUMPL B,DFR07A

;STRING ACCOUNT

	SKIPN FDBACT(G)		;"NONE" FOR NO BLOCK # OR PTR FOUND
	HRROI B,[ASCIZ /None/]
	HRROI B,0(B)		;MAKE PROPER LH
	CALL DFILL		;PRINT THE STRING
	JRST DFR08

;NUMERIC ACCOUNT

DFR07A:	TLZ B,700000		;CLEAR HI BITS.
	MOVEI C,^D10		;DECIMAL
	CALL DFNOUT		;NOUT AND KEEP TRACK OF CHRS OUTPUT

; ;T: ALWAYS PRINTED IF FILE IS TEMPORARY.
; ;S: ALWAYS PRINTED IF FILE IS SCRATCH

DFR08:	MOVE B,FDBCTL(G)	;CONTROL BITS
	TLNN B,<FDBTMP>B53	;IS FILE TEMP?
	JRST DFR85
	HLRZ C,FDBVER(G)
	CAIGE C,^D100000	;SCRATCH?
	HRROI B,[ASCIZ /;S/]
	CAIL C,^D100000
	HRROI B,[ASCIZ /;T/]
	CALL DFILL		;SOUT AND KEEP TRACK OF COLUMNS


; ;E: ALWAYS PRINTED IF FILE IS EPHEMERAL

DFR85:	MOVE B,FDBCTL(G)
SCRC <
	TLNN B,(FDBKEP)
	 JRST DFR86
	HRROI B,[ASCIZ /;K/]
	CALL DFILL
DFR86:
>;SCRC
	TLNN B,(FDBEPH)
	 JRST DFR09
	HRROI B,[ASCIZ /;E/]
	CALL DFILL		;SOUT AND KEEP TRACK OF COLUMNS IN D

;DFREST...

DFR09:	TRNN BB,1777B31		;ANY TIMES, ETC. TO PRINT?
	TLNE F,774000		;ANY ARCHIVE STUFF TO PRINT?
	JRST DFR091		;YES
	JRST DFRXIT		;NO

;BEFORE PRINTING THE REST SPACE OVER TO THE APPROPRIATE TAB STOP,
;OR PRINT ONE SPACE IF BEYOND IT, OR USE A NEW LINE IF TOO FAR BEYOND.

DFR091:	TRNN BB,1B32		;NEVER AN EOL IF COLUMNATION SUPPRESSED
	CAML D,[-35]		;TO MUCH LINE OVERFLOW?
;-35 WAS CHOSEN BECUASE IT IS ONE CHARACTER SHORT OF PUSHING
;DATES CLEAR INTO NEXT COLUMN WHEN ;A AND ;P ARE PRESENT.
	JRST DFR09A		;OK
	MOVEI B,CR
	BOUT
	MOVEI B,LF
	BOUT
	CALL DINDNT		;INDENT THE RIGHT AMOUNT ON NEW LINE
	SETZ D,			;NO LINE OVERFLOW NOW
	JRST DFR09C
DFR09A:	HRROI B,[ASCIZ / /]	;THE ONE SPACE
	ADDI D,7		;RIGHT # COLS BEYOND MIN FOR NAM.EXT;VER
	TLNE F,B12
	SUBI D,2		;2 COLS NARROWER FOR DECTAPE
	TLNE BB,<3B17>B53
	ADDI D,6		;ANOTHER TAB STOP FOR PROT
	TRNE BB,3B20
	ADDI D,6		;";A" AND ";P NOT COUNTED IND
	CALL DFILL		;SOUT AND ADD SPACES

;SIZE IN PAGES OR DECTAPE BLOCKS

DFR09C:	TRNN BB,1B22
	JRST DFR09D
	HRRZ B,FDBBYV(G)	;SIZE IN PAGES
	MOVEI C,^D10		;DECIMAL
	CAIGE B,^D1000		;WILL FIT IN 3 COLS?
	HRLI C,(1B2+3B17)	;YES, RIGHT JUSTIFY IT
	ADDI D,3		;3 COLS MIN WIDTH, LESS PRECEDING OVFLO
	CALL DFNOUT		;NOUT WITH FANCY COLUMNATION
	MOVEI B,SPACE
	BOUT
	BOUT
;LENGTH IN BYTES: PRINT "LENGTH(SIZE)"

DFR09D:	TRNN BB,1B26
	JRST DFR10
	MOVE B,FDBSIZ(G)
	MOVEI C,^D10		;DECIMAL
	CALL DFNOUT		;NO COLUMNATION YET
	MOVEI B,"("
	BOUT
	LDB B,[POINT 6,FDBBYV(G),11]	;BYTE SIZE
	MOVEI C,^D10
	CALL DFNOUT
	MOVEI B,")"
	BOUT
	HRROI B,[ASCIZ / /] ;NOW A SEPARATING SPACE, PLUS ENOUGH MORE
	ADDI D,^D9		;SO "SIZE(LENGTH)" TAKES UP 10 COLS,
	CALL DFILL		;( 10 - ()'s + space = 9)
				;LESS EXCESS USED BY NAME.

;DFREST...
;THE VARIOUS DATES AND TIMES

DFR10:	SETZ C,			;FORMAT: DD-MMM-YY HH:MM:SS
	TRNE BB,1B32		;SUPPRESS COLUMNATION?
	TLO C,B17		;SUPPRESS COLUMNATION.
	TRNN BB,1B23+1B27
	JRST DFR11
	TRNN BB,1B27		;TIME TO BE INCLUDED?
	TLO C,B9		;NO, EXCLUDE IT
	MOVE B,FDBCRV(G)	;VERSION CREATION DATE & TIME
	ODTIM			;PRINT DATE AND MAYBE TIME.
	MOVEI B,SPACE
	BOUT
DFR11:	TRNN BB,1B24+1B28
	JRST DFR12
	TLZ C,B9
	TRNN BB,1B28
	TLO C,B9
	MOVE B,FDBWRT(G)	;WRITE DATE
	TLNE F,B12
	JRST [	CALL DTADAT	;PRINT DECTAPE FORMAT DATE
		JRST DFR12]
	ODTIM
	MOVEI B,SPACE
	BOUT
DFR12:	TRNN BB,1B25+1B29
	JRST DFR12A
	SKIPN B,FDBREF(G)
	 JRST [	HRROI B,[ASCIZ / Not read /]
		MOVEI C,0
		SOUT
		TRNE BB,1B29	;TIMES BEING PRINTED...
		TRNE E,1B32	;AND NOT IN CRAM MODE?
		 JRST DFR12A	;NOT SO.
		HRROI B,[ASCIZ /         /]
		SOUT		;YES
		JRST DFR12A]
	TLZ C,B9
	TRNN BB,1B29
	TLO C,B9
	ODTIM
	MOVEI B," "
	BOUT
DFR12A:	TLNN F,B0+B2+B4		;GOING TO PRINT DUMP TAPE
	 JRST DFR12C		;NO
	HRRZ B,FDBBCK(G)	;DUMP TAPE NO.
	JUMPE B,[HRROI B,[ASCIZ /None /]
		SETZ C,
		SOUT
		TLNN F,B0+B4	;DATE?
		JRST DFR12C	;NO
		HRROI B,[ASCIZ /          /]
		SOUT
		HRROI B,[ASCIZ /         /]
		TLNE F,B4	;TIME?
		SOUT
		JRST DFR12C]
	MOVE C,[120004,,12]	;DECIMAL
	NOUT
	 JFCL
	MOVEI B," "
	BOUT
	TLNN F,B0+B4		;PRINT DATE?
	 JRST DFR12C		;NO
	SETZ C,
	TRNE BB,1B32		;SUPPRESS COLUMNATION?
	TLO C,B17		;YES
	TLNN F,B4		;INCLUDE TIME?
	TLO C,B9		;NO, EXCLUDE IT
	MOVE B,21(G)		;TIME AND DATE OF MOST RECENT DUMP
	ODTIM
	MOVEI B," "
	BOUT
DFR12C:	TLNN F,B1+B3+B5		;GOING TO PRINT ARCHIVE TAPE
	 JRST DFR129		;NO
	HLRZ B,20(G)		;FIRST ARCHIVE TAPE NO.
	JUMPE B,[HRROI B,[ASCIZ /None /]
		SETZ C,
		SOUT
		TLNN F,B1+B5	;DATE?
		JRST DFR12D	;NO
		HRROI B,[ASCIZ /          /]
		SOUT
		HRROI B,[ASCIZ /         /]
		TLNE F,B5	;TIME?
		SOUT
		JRST DFR12D]
	MOVE C,[120004,,12]	;DECIMAL
	NOUT
	 JFCL
	MOVEI B," "
	BOUT
	TLNN F,B1+B5		;PRINT DATE?
	 JRST DFR12D		;NO
	SETZ C,
	TRNE BB,1B32		;SUPPRESS COLUMNATION?
	TLO C,B17		;YES
	TLNN F,B5		;INCLUDE TIME?
	TLO C,B9		;NO, EXCLUDE IT
	MOVE B,22(G)		;TIME AND DATE OF FIRST ARCHIVE
	ODTIM
	MOVEI B," "
	BOUT

DFR12D:	HRRZ B,20(G)		;SECOND ARCHIVE TAPE NO.
	JUMPE B,[HRROI B,[ASCIZ /None /]
		SETZ C,
		SOUT
		TLNN F,B1+B5	;DATE?
		JRST DFR129	;NO
		HRROI B,[ASCIZ /          /]
		SOUT
		HRROI B,[ASCIZ /         /]
		TLNE F,B5	;TIME?
		SOUT
		JRST DFR129]
	MOVE C,[120004,,12]	;DECIMAL
	NOUT
	 JFCL
	MOVEI B," "
	BOUT
	TLNN F,B1+B5		;PRINT DATE?
	 JRST DFR129		;NO
	SETZ C,
	TRNE BB,1B32		;SUPPRESS COLUMNATION?
	TLO C,B17		;YES
	TLNN F,B5		;INCLUDE TIME?
	TLO C,B9		;NO, EXCLUDE IT
	MOVE B,23(G)		;TIME AND DATE OF SECOND ARCHIVE
	ODTIM
	MOVEI B," "
	BOUT
DFR129:	TRNE E,1B30		;GOING TO PRINT AUTHOR?
	TLNE F,(1B12)		;AND NOT DECTAPE
	 JRST DFR13		;NO.
	HLRZ B,FDBUSE(G)	;DIR NUM OF WRITER
	MOVEI C,10
	CALL $DIRST
	 NOUT
	  JFCL
	MOVEI B,SPACE
	BOUT
DFR13:	TRNE E,1B31		;GOING TO PRINT LAST READER?
	TLNE F,(1B12)		;AND NOT DECTAPE
	 JRST DFR14		;NO.
	HRRZ B,FDBUSE(G)	;DIR NUM OF READER
	MOVEI C,10		;OCTAL NOUT IF NEEDED
	CALL $DIRST
	 NOUT
	  JFCL
	MOVEI B,SPACE
	BOUT

DFR14:	TLNN F,B6		;PRINT STATUS?
	 JRST DFRXIT
	MOVE D,FDBBCK(G)
	SETZ C,
	HRRI F,0		;NULL BYTE-- USE RH OF F FOR NULL OR COMMA
	TLNN D,200000
	 JRST DFR15
	HRROI B,[ASCIZ /Archive pending/]
	SOUT
	HRRI F,-1		;INDICATE SOMETHING ALREADY PRINTED
DFR15:	TLNN D,4000
	 JRST DFR16
	HRROI B,[ASCIZ /, /]
	TRNE F,-1
	SOUT
	HRROI B,[ASCIZ /Archived/]
	SOUT
	HRRI F,-1
DFR16:	TLNN D,100000
	 JRST DFR17
	HRROI B,[ASCIZ /, /]
	TRNE F,-1
	SOUT
	HRROI B,[ASCIZ /Don't archive/]
	SOUT
	HRRI F,-1
DFR17:	TLNN D,10000
	 JRST DFR18
	HRROI B,[ASCIZ /, /]
	TRNE F,-1
	SOUT
	HRROI B,[ASCIZ /Don't delete/]
	SOUT
	HRRI F,-1
DFR18:	MOVE D,FDBCTL(G)
	TLNN D,B9
	 JRST DFR19
	HRROI B,[ASCIZ /, /]
	TRNE F,-1
	SOUT
	HRROI B,[ASCIZ /Perpetual/]
	SOUT
	HRRI F,-1
DFR19:	TLNN D,B1
	 JRST DFRXIT
	HRROI B,[ASCIZ /, /]
	TRNE F,-1
	SOUT
	HRROI B,[ASCIZ /Permanent/]
	SOUT
	 NOUT
	  JFCL

;CRLF AND EXIT

DFRXIT:	HRROI B,[ASCIZ /
/]
	SETZ C,
	SOUT
	HRROI B,[ASCIZ /
/]
	TLNE F,2		;DOUBLE-SPACE?
	SOUT			;YES, ANOTHER EOL.
	POP P,G
	POP P,D
	RET

;SUBROUTINE DTADAT: PRINTS DECTAPE FORMAT DATE FROM B.
;USED IN DFREST, OLDTAD.
;TAKES: A: DESTINATION, B: DATE. CLOBBERS C,D.

DTADAT:	PUSH P,E
	MOVE D,B
	IDIVI D,^D31
	HRLZ C,E		;DAY OF MONTH
	IDIVI D,^D12
	HRR B,E			;MONTH
	HRLI B,^D1964(D) 	;YEAR
	HRLZI E,B9		;SUPPRESS TIME
	ODTNC		;OUTPUT DATE WITHOUT CONVERSION FROM INTERNAL
	POP P,E
	RET

;DCMPR: SUBOUTINE FOR DFILE.
;COMPARE STRING C POINTS TO TO STRING B POINTS TO.
;SKIP IF EITHER POINTER IS ZERO OR IF STRINGS ARE SAME.

DCMPR:	JUMPE C,[AOS (P)
		RET]
	JUMPE B,[AOS (P)
		RET]
	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSH P,E
	HRLI B,<POINT 7,0,-1>B53
	HRLI C,<POINT 7,0,-1>B53
DCMPR1:	ILDB E,C
	ILDB D,B
	CAME E,D
	JRST DCMPR9		;DIFFERENT
	JUMPN E,DCMPR1		;TERMINATE ON NULL
	AOS -4(P)
DCMPR9:	JRST [	POP P,E
		POP P,D
		POP P,C
		POP P,B
		RET]

;DFDBCM: COMPARE FDB'S POINTED TO BY G AND LPFDB
;COMPARE ONLY FIELDS TO BE PRINTED, PER DFILE FORMAT WORD IN E.
;SKIPS IF SAME. CLOBBERS B,C,D. ONE CALL IN "DFILE".

DFDBCM:	SKIPN B,LPFDB
	 RET			;NO PREVIOUS FDB, GIVE "DIFFERENT" RET.
	MOVE C,FDBCTL(B)	;CONTROL BITS
	XOR C,FDBCTL(G)
	TLNE F,B9		;Undeleted & deleted?
	TLNN C,(FDBDEL)		; Yes, deletion status same?
	TLNE C,(FDBEPH)		;CHECK BITS WHICH MATTER
	 RET			; different
	TRNN E,1B30		;GOING TO PRINT AUTHOR?
	 JRST .+5		;NO, SKIP CHECK
	HLRZ C,FDBUSE(B)	;AUTHOR
	HLRZ D,FDBUSE(G)
	CAIE C,0(D)		;SAME?
	 RET			;NO, GIVE "DIFF" RET
	TRNN E,1B31		;Want last reader?
	 JRST .+5		;No, skip check
	HRRZ C,FDBUSE(B)
	HRRZ D,FDBUSE(G)
	CAIE C,0(D)		;Are they the same?
	 RET			;No, give "Different" return
	TLNN BB,<3B17>B53 	;PROTECTION: IS IT TO BE LISTED?
	JRST .+4		;NO, CONTINUE COMPARING FIELDS
	MOVE C,FDBPRT(B)
	CAME C,FDBPRT(G) 	;IS IT SAME?
	RET			;NO, DIFFERENT
	TRNN BB,3B20		;ACCOUNT
	JRST .+4
	MOVE C,FDBACT(B)
	CAME C,FDBACT(G)
	RET
	TRNN BB,1B22		;SIZE IN PAGES
	JRST .+5
	HRRZ C,FDBBYV(B)
	HRRZ D,FDBBYV(G)
	CAME C,D
	RET
	TRNN BB,1B26		;BYTES
	JRST DFDC10
	MOVE C,FDBSIZ(B)
	CAME C,FDBSIZ(G)
	RET

;ALSO MAKE SURE BYTES ARE SAME SIZE:
	LDB C,[POINT 6,FDBBYV(B),11]
	LDB D,[POINT 6,FDBBYV(G),11]
	CAME C,D
	RET

;DATES AND TIMES
DFDC10:	MOVE C,FDBCRV(B)
	XOR C,FDBCRV(G)
	TRNN BB,1B27
	TRZ C,-1		;NOT TIME, MASK IT OUT.
	TRNE BB,1B23+1B27 	;CREATE DATE OR TIME TO BE PRINTED?
	JUMPN C,[RET]		;YES, TEST FOR SAME
	MOVE C,FDBWRT(B)
	XOR C,FDBWRT(G)
	TRNN BB,1B28
	TRZ C,-1
	TRNE BB,1B24+1B28
	JUMPN C,[RET]
	MOVE C,FDBREF(B)
	XOR C,FDBREF(G)
	TRNN BB,1B29
	TRZ C,-1
	TRNE BB,1B25+1B29
	JUMPN C,[RET]
	TLNN F,774000		;ARCHIVE STUFF ALSO?
	 JRST DFDC11		;NO
	MOVE C,FDBBCK(B)
	XOR C,FDBBCK(G)
	TLNN F,B6		;STATUS
	 TLZ C,-1
	TLNN F,B2		;DUMP TAPE NOS
	 TRZ C,-1
	JUMPN C,[RET]
	TLNN F,B6		;STATUS
	 JRST DFDCAA
	MOVE C,FDBCTL(B)
	XOR C,FDBCTL(G)
	TLNE C,200400		;PERMANENT AND UNDELETABLE BITS
	 RET
DFDCAA:	MOVE C,20(B)		;ARCHIVE TAPE NUMBERS
	XOR C,20(G)
	TLNE F,B3
	JUMPN C,[RET]
	TLNN F,B0+B4
	 JRST DFDCBB
	MOVE C,21(B)		;DATE/TIME OF DUMP
	XOR C,21(G)
	TLNN F,B4
	 TRZ C,-1
	JUMPN C,[RET]
DFDCBB:	TLNN F,B1+B5
	 JRST DFDC11
	MOVE C,22(B)		;DATE/TIME OF FIRST ARCHIVE
	XOR C,22(G)
	TLNN F,B5
	 TRZ C,-1
	JUMPN C,[RET]
	MOVE C,23(B)		;DATE/TIME OF SECOND ARCHIVE 
	XOR C,23(G)
	TLNN F,B5
	 TRZ C,-1
	JUMPN C,[RET]
DFDC11:	AOS (P)			;SAME!
	RET

;DFNOUT: SUBROUTINE FOR DFILE.
;LIKE NOUT EXCEPT ADDS TRAILING SPACES, LIKE "DFILL" (NEXT),
;USING D IN SAME MANNER.
;REQUIRES A, B, C SET UP FOR NOUT, D FOR DFILL.
;CLOBBERS B, C.

DFNOUT:	PUSH P,A
	MOVE A,CSBUFP		;STRING BUFFER PTR
	NOUT			;CONVERT NUMBER TO STRING IN CORE
	 CALL JERRC		;JSYS ERROR ROUTINE FOR ERR # IN C
	SETZ C,
	IDPB C,A		;APPEND NULL (NOUT REALLY DOESN'T !)
	POP P,A
	MOVE B,CSBUFP

;DFILL: SUBROUTINE FOR DFILE.
;OUTPUT STRING B POINTS TO, THEN TYPE SPACES IF NECESSARY TO
;MAKE IT TAKE UP NUMBER OF COLUMNS SPECIFIED IN D.
;DESTINATION IN A; CLOBBERS B,C; RETURNS - # COLS OVERFLOW IN D.

DFILL:	HLRZ C,B
	CAIN C,-1
	HRLI B,<POINT 7,0,-1>B53	;FILL IN LH BYTE PTR FOR -1
	PUSH P,B
	SETZ C,
	SOUT
	POP P,B
	ILDB C,B
	SOJL D,DFILL9
	JUMPN C,.-2
	MOVEI B,SPACE		;SPACES NEEDED
	TRNN E,1B32		;E B32 SUPPRESS COLUMNATION
	BOUT
	SOJGE D,.-2
DFILL9:	JUMPE C,[AOJA D,[RET]]	;REMOVE THE NULL TERMINATOR FROM COUNT
	ILDB C,B		;COUNT CHARS OVER SPECIFIED MINIMUM
	SOJA D,.-2

;OLDTAD
;LIST DECTAPE DIRECTORY IN 10/50 FORMAT
;TAKES: OUTDSG: OUTPUT JFN
;	A: DEVICE DESIGNATOR (UNIT # IN RH)
;AC USE: A: OUTJFN
;	F: POINTER TO BLOCK COUNT BUFFER IN PUSHDOWN
;	G: AOBJN POINTER DURING PRINTING

OLDTAD:	PUSH P,E
	PUSH P,F
				;DEVICE DESIGNATOR IS IN A

	MOVEI B,DIRBUF		;WHERE TO READ DIR TO
	RDDIR			;GET DEVICE DIRECTORY
	 CALL [	CAIN A,RDDIX1
		 ERROR <Trouble reading directory, maybe DECtape not "remote">
		JRST JERR]

;SCAN "SLOTS" PORTION OF DIRECTORY, COUNTING BLOCKS ASSIGNED TO EACH
;FILE, AND FREE BLOCKS (THESE HAVE 0 FILE # BYTE).

	HRRZI F,1(P)		;WHERE BLOCK COUNT BLOCK WILL BE
	MOVEI B,^D22
	PUSH P,[0]		;ALLOCATE AND CLR 23 WRDS FOR BLK COUNTS
	SOJGE B,.-1
	MOVE B,[POINT 5,DIRBUF]	;THERE IS ONE 5-BIT BYTE PER BLOCK
	MOVEI C,^D578		;NUMBER OF BLOCKS
OLDTA2:	ILDB D,B		;GET FILE # FOR THIS BLOCK
	MOVE E,F
	ADD E,D
	CAIG D,^D22		;IS IT A FILE # OR 0?

;NOTE: DIRECTORY BLOCK (100) AND TENDMP BLOCKS (0, 1, 2)
;  HAVE 36 IN THEIR SLOTS.
	AOS (E)			;INDEX BLOCK COUNT
	SOJG C,OLDTA2

;OLDTAD...
;TYPE # FREE BLOCKS
	MOVE A,OUTDSG
	MOVE B,(F)
	MOVEI C,^D10		;FREE FORMAT, DECIMAL
	NOUT
	 CALL JERRC
	HRROI B,[ASCIZ /. Free blocks left/]
	SETZ C,
	SOUT
	MOVE C,DIRBUF+^D127
	CALL TAPID

;TYPE EACH FILE IN THE FORM NNNNNN.EXT  BB  DD-MMM-YY
	HRLZI G,-^D22		;NUMBER OF POSSIBLE FILES
OLDTA4:	ADDI F,1		;STEP TO NEXT COUNT WORD IN BLOCK IN PD
	SKIPN C,DIRBUF+^D83(G)	;NAME
	JRST OLDTA7		;NONE, NO FILE FOR THIS FILE #
	MOVEI D,6
	SETZ B,
	LSHC B,6
	ADDI B,40		;CONVERT CHAR TO ASCII
	BOUT			;PRINT A CHARACTER OF NAME
	SOJG D,.-4
	HLLZ C,DIRBUF+^D105(G)	;EXTENSION
	MOVEI B,"."		;SEPARATING CHARACTER: PERIOD,
	JUMPN C,.+2
	MOVEI B,SPACE		;EXCEPT SPACE IF NO EXTENSION
	BOUT
	MOVEI D,5		;3 CHARS OF EXT AND 2 TRAILING SPACES
	SETZ B,
	LSHC B,6
	ADDI B,40
	BOUT			;PRINT A CHAR OF EXTENSION
	SOJG D,.-4

;NUMBER OF BLOCKS IN FILE: USE 3 COLUMNS, LEADING 0 IF <10,
;TRAILING SPACE IF <100, A LA DEC 10/50 SYSTEM.
	MOVE B,(F)		;# BLOCKS
	CAIL B,^D10
	JRST .+3
	MOVEI B,"0"
	BOUT
	MOVE B,(F)		;# BLOCKS IN THIS FILE
	MOVEI C,^D10
	NOUT
	 CALL JERRC
	MOVE C,(F)		;# BLOCKS ONCE MORE
	MOVEI B,SPACE
	CAIGE C,^D100
	BOUT			;FILL TO 3 COLS WITH A SPACE
	BOUT			;SEPARATING SPACE

;OLDTAD...
	LDB B,[POINT 12,DIRBUF+^D105(G),35]		;DATE
	MOVEI C,1B35		;OR IN 3 MORE DATE BITS
	TDNE C,DIRBUF+0(G)	;NEW DEC DATE STANDARD
	TRO B,1B23
	TDNE C,DIRBUF+^D22(G)
	TRO B,1B22
	TDNE C,DIRBUF+^D44(G)
	TRO B,1B21
	CALL DTADAT		;TYPE DATE IN DECTAPE FORMAT
	MOVEI B,CR
	BOUT
	MOVEI B,LF
	BOUT
OLDTA7:	AOBJN G,OLDTA4
	SUB P,[^D23,,^D23]
;STEP PAST ALL JFNS THIS DECTAPE. ADDED 1/71
	TLZ Z,F2
	HRRZ A,@INIFH1
	GNJFN
	JRST OLDTA9
	TLNN A,70		;DEV OR DIR CHANGED ?
	JRST .-4
	TLO Z,F2
OLDTA9:	POP P,F
	POP P,E
	RET


;TAPID
;A/ OUTDESG
;C/ SIXBIT TAPE ID

TAPID:	JUMPE C,TAPID4
	PUSH P,C
	HRROI B,[ASCIZ " on "]
	SETZ C,
	SOUT
	POP P,C
	SETZ B,
	LSHC B,6
	ADDI B,40
	BOUT
	JUMPN C,.-4
TAPID4:	HRROI B,[ASCIZ /
/]
	SOUT
	RET

DIRTOT:	HRROI B,[ASCIZ /
 Totals:
/]
	SETZ C,
	SOUT
	MOVE D,DSKGSP		;Tell about disk files
	SKIPE B,DSKGCT
	CALL DSKTOT
	MOVE D,DTAGSP		;Tell about DECtape files
	SKIPE B,DTAGCT
	CALL DTATOT
	RET

DSKTOT:	PRINT SPACE		;Print number of files,
	MOVEI C,^D10
	NOUT
	 JFCL
	CAIN B,1
	SKIPA B,[-1,,[ASCIZ / disk file, /]]
	HRROI B,[ASCIZ / disk files, /]
	SETZ C,
	SOUT
	MOVE B,D		; and the space they account for.
	MOVEI C,^D10
	NOUT
	 JFCL
	CAIN B,1
	SKIPA B,[-1,,[ASCIZ / page
/]]
	HRROI B,[ASCIZ / pages
/]
	SETZ C,
	SOUT
	AOS DSKTTC		;Count one JFN displayed as disk
	RET

DTATOT:	PRINT SPACE		;Print number of files,
	MOVEI C,^D10
	NOUT
	 JFCL
	CAIN B,1
	SKIPA B,[-1,,[ASCIZ / DECtape file, /]]
	HRROI B,[ASCIZ / DECtape files, /]
	SETZ C,
	SOUT
	MOVE B,D		; and the space they account for.
	MOVEI C,^D10
	NOUT
	 JFCL
	CAIN B,1
	SKIPA B,[-1,,[ASCIZ / block
/]]
	HRROI B,[ASCIZ / blocks
/]
	SETZ C,
	SOUT
	AOS DTATTC		;Count one JFN displayed as DECtape
	RET

LIT3C:	LIT

