Google
 

Trailing-Edge - PDP-10 Archives - bb-m081w-sm_t20_v7_0_02_exec_src_mod - exec/exec3.mac
There are 47 other files named exec3.mac in the archive. Click here to see a list.
; UPD ID= 4109, RIP:<7.EXEC>EXEC3.MAC.4,   7-Mar-88 18:21:02 by GSCOTT
;TCO 7.1255 - Update copyright notice.
; UPD ID= 4087, RIP:<7.EXEC>EXEC3.MAC.3,  15-Jan-88 15:11:50 by EVANS
; TCO 7.1184 - Answer Grump 142 by not allowing user to try to FIND
;		a negative number of generations
; UPD ID= 4085, RIP:<7.EXEC>EXEC3.MAC.2,   6-Jan-88 09:17:22 by MCCOLLUM
;TCO 7.1170 - Check for STRX10 in DSKDIR and call CJERRE when found
; UPD ID= 219, SNARK:<6.1.EXEC>EXEC3.MAC.4,  10-Jun-85 08:42:37 by DMCDANIEL
; UPD ID= 163, SNARK:<6.1.EXEC>EXEC3.MAC.3,   3-May-85 08:29:35 by DMCDANIEL
;Update copyrights for 6.1.
; UPD ID= 154, SNARK:<6.1.EXEC>EXEC3.MAC.2,   2-May-85 11:15:54 by PRATT
;TCO 6.1.1353 - Make GNJFN's handle error better
; UPD ID= 335, SNARK:<6.EXEC>EXEC3.MAC.22,  20-Nov-83 19:40:27 by PRATT
;TCO 6.1870 - Get rid of code which is under NONEWF. Remove NEWF's.
; UPD ID= 323, SNARK:<6.EXEC>EXEC3.MAC.19,  10-Nov-83 14:11:43 by TSANG
;TCO 6.1837 - Set flag bit for DIR0
; UPD ID= 311, SNARK:<6.EXEC>EXEC3.MAC.18,  23-Sep-83 13:32:58 by TSANG
;TCO 6.1801 - INSERT A CONFIRM ROUTINE IN GETLPT: IF GTJFN FAILS.
; UPD ID= 298, SNARK:<6.EXEC>EXEC3.MAC.17,  15-Jul-83 11:33:04 by TSANG
;TCO 6.1720 - USE THE CORRECT SUBROUTINE .NDATE IN $$NO TABLE.
; UPD ID= 236, SNARK:<6.EXEC>EXEC3.MAC.16,  15-Jan-83 19:23:56 by CHALL
;TCO 6.1464 - UPDATE COPYRIGHT NOTICE
; UPD ID= 214, SNARK:<6.EXEC>EXEC3.MAC.15,   7-Jan-83 11:44:03 by LOMARTIRE
;TCO 6.1121 - Reinsert edit 642
; UPD ID= 183, SNARK:<6.EXEC>EXEC3.MAC.14,  14-Oct-82 10:03:30 by WEETON
;TCO 6.1313 - Add new subcommand to DIRECTORY class commands to print entire file name
; UPD ID= 134, SNARK:<6.EXEC>EXEC3.MAC.13,   4-Aug-82 17:13:38 by LEACHE
;TCO 6.1209 Fix invocations of ETYPE
; UPD ID= 114, SNARK:<6.EXEC>EXEC3.MAC.12,  20-Apr-82 07:53:16 by CHALL
;TCO 6.1090 $$NO- "DIR, NO SEP" SHOULD DISPATCH TO .NSEPA, NOT .SEPAR
; UPD ID= 108, SNARK:<6.EXEC>EXEC3.MAC.11,  12-Mar-82 13:17:08 by CHALL
;TCO 6.1068 DSKR7- MAKE GNJFN LOOK FOR INV FILES FOR ARCHIVE OPTION, TOO
; UPD ID= 87, SNARK:<6.EXEC>EXEC3.MAC.8,   8-Jan-82 15:47:09 by CHALL
;TCO 6.1052 - UPDATE COPYRIGHT NOTICE AND DELETE PRE-V4.1 EDIT HISTORY
; UPD ID= 53, SNARK:<5.EXEC>EXEC3.MAC.9,  26-Aug-81 10:35:11 by CHALL
;TCO 5.1476 - MAKE THE NOISE FOR EACH DIR COMMAND BE DISTINCT
; UPD ID= 34, SNARK:<5.EXEC>EXEC3.MAC.8,  14-Aug-81 19:12:33 by CHALL
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
; UPD ID= 13, SNARK:<5.EXEC>EXEC3.MAC.6,  16-Jul-81 09:02:54 by CHALL
;TCO 5.1414 ..SIZE- CHANGE (IN PAGES OR BLOCKS) TO (IN PAGES)
; UPD ID= 2236, SNARK:<5.EXEC>EXEC3.MAC.5,  22-Jun-81 15:23:31 by GROUT
;TCO 5.1377 - Make sequential checksumming on disk faster
;<HELLIWELL.EXEC.5>EXEC3.MAC.6, 18-May-81 10:02:38, EDIT BY HELLIWELL
;MAKE DECTAPE DIRECTORY SUPPORT NOT UNDER NOSHIP
; UPD ID= 2191, SNARK:<5.EXEC>EXEC3.MAC.3,  11-Jun-81 16:08:58 by MOSER
;TCO 5.1368 FIX A BUG IN TCO 5.1307.
; UPD ID= 1937, SNARK:<5.EXEC>EXEC3.MAC.2,   5-May-81 13:35:18 by GROUT
;tco 5.1307 - Fix DFILL so CTRL/V isn't counted on output
;REMOVE MFRK CONDITIONALS
; UPD ID= 1428, SNARK:<5.EXEC>EXEC3.MAC.9,   9-Jan-81 14:22:30 by OSMAN
;tco 5.1231 - Add RESIST-MIGRATION and PROHIBIT-MIGRATION subcommands
; UPD ID= 982, SNARK:<5.EXEC>EXEC3.MAC.8,   3-Sep-80 12:22:28 by HESS
; Use of DPGF flag incorrect for DECtapes
; UPD ID= 715, SNARK:<5.EXEC>EXEC3.MAC.7,   1-Jul-80 08:46:27 by OSMAN
;tco 5.1080 - Make TIMES (AND DATES OF) ON[OFF]LINE-EXPIRATION work right
; UPD ID= 682, SNARK:<5.EXEC>EXEC3.MAC.6,  20-Jun-80 13:41:04 by OSMAN
; UPD ID= 681, SNARK:<5.EXEC>EXEC3.MAC.5,  20-Jun-80 13:25:16 by OSMAN
;tco 5.1072 - Add ONLINE subcommand
; UPD ID= 533, SNARK:<5.EXEC>EXEC3.MAC.4,  20-May-80 14:55:38 by MURPHY
;CHANGE SOME XTND TO NEWF OR MFRK
; UPD ID= 487, SNARK:<4.1.EXEC>EXEC3.MAC.9,  28-Apr-80 15:59:38 by TOMCZAK
;TCO#4.1.1151 - Fix CRAM subcommand
;<4.1.EXEC>EXEC3.MAC.8, 29-Feb-80 14:06:33, EDIT BY OSMAN
;tco 4.1.1097 - Don't say "string space exhausted" after many DELETE commands
;<4.1.EXEC>EXEC3.MAC.7,  5-Nov-79 09:41:39, EDIT BY OSMAN
;tco 4.1.1007 - Prevent ill trap when XTND turned on and doing DIR EVERYTHING
;<4.1.EXEC>EXEC3.MAC.6,  2-Nov-79 17:02:14, EDIT BY OSMAN
;CHANGE $USER TO $USERS
;CHANGE $DATE TO $DATES TO AVOID CONFLICT
;<4.1.EXEC>EXEC3.MAC.2,  2-Nov-79 16:42:21, EDIT BY OSMAN
;CHANGE $DIR TO $DIRS TO AVOID CONFLICT WITH SOMETHING

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  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.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE

	SEARCH EXECDE
	TTITLE EXEC3

;THIS FILE CONTAINS THE 'DIRECTORY' COMMAND

;DEFINITIONS REQUIRED FOR DIRECTORY LISTER

FDBHGH==.FBFET			;HIGHEST FDB ENTRY WE'LL READ
				;USED FOR $GTFDB AND WHERE TO START
				;SPACE AFTERWARDS (.FBHDR THRU .FBREF
PHASE 1+FDBHGH			;OTHER INFO STARTS BEYOND GTFDB INFO
FDBCHK:!	0		;CHECKSUM CONTROL WORD
FDBSUM:!	0		;CHECKSUM
FDBRLN:!	0		;REAL LENGTH STORED HERE, INCLUDING STRINGS

FDBLEN==FDBRLN+1		;LENGTH OF FILE INFO BLOCK, NOT COUNTING STRINGS
DEPHASE
;FDIRECTORY
;FULL FILE DESCRIPTION
;INTENDED TYPICAL USE IS "FDIRECTORY <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.

.FDIRE::MOVX Q1,PPF!ACCF!SIZPF!PCTF!PWTF!PRTF!PLBF!DCREF!DWRF!DRDF!SCF+XARC <POEF+POETF+PONETF+PONEF+>PTWF
	MOVX Q2,SHF!SNEF!UCREF!UWRF!RETF ;GET WRITE AND CREATE DIRS ALSO
	NOISE <FULL, OF FILES>
	JRST DIR0

.VDIRE::MOVX Q1,PPF!SIZPF!PWTF!PLBF!DWRF
	MOVX Q2,VDIRF!UWRF
	NOISE <VERBOSE, OF FILES>
	JRST DIR0

XTND,<
.QD::	MOVX Q2,DFOF!VDIRF!UWRF		;DELETED FILES ONLY
	MOVX Q1,PPF!SIZPF!PWTF!PLBF!DWRF
	NOISE <OF DELETED FILES>
	JRST DIR0

.RDIRE::SETZ Q2,
	MOVX Q1,SIZPF!DRDF!PRTF
	TXO Z,CHRDF!REVF
	NOISE <OF FILES BY CREATION DATE>
	JRST DIR0

.WDIRE::MOVX Q2,UCREF!UWRF
	MOVX Q1,SIZPF!DWRF!PWTF
	TXO Z,CHWRF!REVF
	NOISE <OF FILES BY WRITE DATE>
 	JRST DIR0
>
;DIRECTORY.

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

;AC USE

;  Q1  FIELDS-TO-PRINT INFO A LA JFNS JSYS CALL. (SEE ALSO RH Q2)

PONEF==1B33			;B33: ONLINE EXPIRATION DATE/INTERVAL
SCF==1B32			;B32: SUPPRESS COLUMNATION (CRAM)
POEF==1B31			;B31: OFFLINE EXPIRATION DATE/INTERVAL
PTDF==1B30			;B30: TAPE-WRITE DATE
DRDF==1B29			;B29: READ DATE
DWRF==1B28			;B28: WRITE DATE
DCREF==1B27			;B27: CREATE DATE
PLBF==1B26			;B26: PRINT LENGTH IN BYTES
PTWF==1B25			;B25: TAPE-WRITE TIMES (AND DATES)
PRTF==1B24			;B24: READ TIME (AND DATE)
PWTF==1B23			;B23: WRITE TIME (AND DATE)
PCTF==1B22			;B22: CREATION TIME (AND DATE)
SIZPF==1B21			;B21: SIZE IN PAGES OR BLOCKS
ACCF==1B20			;B20: ACCOUNT
PPF==1B17			;B17: PROTECTION
POETF==1B16			;B16: OFFLINE EXPIRATION TIME
PONETF==1B15			;B15: ONLINE EXPIRATION TIME
DPGF==1B14			;B14: DON'T PRINT GENERATION NUMBERS (FOR DECTAPE)

Q1NTAP==PPF!ACCF!SIZPF!PCTF!PWTF!PRTF!PLBF!DCREF!DWRF!DRDF!PTDF!POEF!PONEF!PTWF!POETF!PONETF	;INVALID Q1 SUBCOMMANDS FOR MAGTAPE
Q1NDTA==PONEF!POEF!PTDF!DRDF!DCREF!PLBF!PTWF!PRTF!PCTF!ACCF!PPF!POETF!PONETF	;INVALID Q1 SUBCOMMANDS FOR DECTAPE
;  Q2 LH FLAGS FOR FORMAT, ETC:

RESTO==1B5	;	B5	RESISTED-MIGRATION FILES ONLY
PROHBO==1B6	;	B6	PROHIBITED-MIGRATION FILES ONLY
OFFO==1B7	;	B7	OFFLINE FILES ONLY
ONOF==1B8	;	B8	ONLINE FILES ONLY
INVFO==1B9	;	B9	INVISIBLE FILES ONLY
ARFO==1B10	;	B10	ARCHIVED FILES ONLY
VDIRF==1B11	;	B11	VDIRECTORY, ONLY DIR PART OF HEADING PRINTS
FHF==1B12	;	B12	FORCE HEADING
SHF==1B13	;	B13	SUPPRESS HEADING
SMVF==1B14	;	B14	SUPPRESS MULTIPLE VERSIONS ON SAME LINE
SNEF==1B15	;	B15	SUPPRESS OMISSION OF NAME, EXT WHEN SAME AS ABOVE
DSF==1B16	;	B16	DOUBLE SPACE
DFOF==1B17	;	B17     DELETED FILES ONLY

;  Q2 RH MORE "WHAT TO PRINT" FLAGS:

CHKF==1B18	;	B18	CHECKSUM FILES
UCREF==1B19	;	B19	LIST CREATE DIRECTORY
UWRF==1B20	;	B20	LIST WRITE DIRECTORY
SOF==1B21	;	B21	SUMMARY ONLY
SSF==1B22	;	B22	SUPPRESS SUMMARY
FSCF==1B23	;	B23	FORCE SEQUENTIAL CHECKSUM
RETF==1B24	;	B24	PRINT VERSION RETENTION COUNT
BEFORF==1B25	;	B25	"BEFORE" SWITCH GIVEN
SINCEF==1B26	;	B26	"SINCE" SWITCH GIVEN
SMALLF==1B27	;	B27	"SMALLER" SUBCOMMAND GIVEN
LARGEF==1B28	;	B28	"LARGER" SUBCOMMAND GIVEN
COMPLN==1B29	;	B29	"COMPLETE" SUBCOMMAND GIVEN
Q2NTAP==OFFO!RESTO!PROHBO!ONOF!INVFO!ARFO!DFOF!CHKF!UCREF!UWRF!RETF!BEFORF!SINCEF!SMALLF!LARGEF	;SUBCOMMANDS DENOTED IN Q2 THAT AREN'T ALLOWED FOR MAGTAPE
Q2NDTA==RESTO!PROHBO!OFFO!ONOF!INVFO!ARFO!DFOF!UCREF!UWRF!RETF	;INVALID Q2 SUBCOMMANDS FOR DECTAPE
;FLAGS IN Z:

DSKF==1B26			;DEVICE IS A DSK
MTAF==1B27			;DEVICE IS A MAGTAPE
DECF==1B28			;DEVICE IS A DECTAPE
PDNF==1B29			;DIRECTORY CHANGED
				;   FLAGS FOR ORDER OF PRINTOUT:
CHTPF==1B30			;B30=40	CHRONOLOGICAL BY TAPE WRITE
CHWRF==1B31			;B31=20	CHRONOLOGICAL BY WRITE DATE
CHRDF==1B32			;B32=10	CHRON READ
CHCRF==1B33			;B33=4	CHRON CREATION
ALPHAF==1B34			;B34=2	ALPHABETIC
REVF==1B35			;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

SORTF==CHWRF!CHRDF!CHTPF!CHCRF!ALPHAF	;SOME SORT OF SORTING NEEDED
.TDIRE::TXO Z,CHWRF!REVF	;CHRON BY WRITE DATE, REVERSE
	MOVX Q1,PWTF!DWRF	;WRITE TIME, DATE
	NOISE <OF FILES BY WRITE DATE>
	SETZ Q2,		;NO SPECIAL FORMAT
	JRST DIR0

.DIREC::SETZB Q1,Q2		;NOTHING SPECIAL AT ALL
	NOISE <OF FILES>

;ALL DIRECTORY'S JOIN HERE

DIR0:	TRVAR <ONMESL,OFMESL,TFORMT,TABLNX,NOFLG,SAVPTR,REALP2,SAVQ3,SVDCNT,DIRJFN,DCNT,NEWPTR,CELADR,TPWRNF,DTWRNF,REALQ2,GRANDF,TAPJFN,<DSBUF,FILWDS>,DIRCN1,DIRCN2,DIRFL1,DIRFL2,DIRNO,BEFDAT,BATCN1,BATCN2,BLKCN1,BLKCN2,CHKCN0,CHKCN1,CHKCN2,CHKPSV,ERRCN1,ERRCN2,FILCN1,FILCN2,FNDPTR,LFPOS,LPEXT,LPFDB,LPNAME,LRGSIZ,LSTPAG,NAMDIR,PNTCNT,SINDAT,SMLSIZ,KEPDNM,SEQPGC,SEQSWC,TIMCVT>
	TRO Z,F3
	SETZM KEPDNM		;INITIALIZE TO NO "FIND"
	SETZM LPFDB
	SETZM DIRJFN		;NO SPECIAL JFN YET
	SETZM GRANDF		;NO REQUESTING GRAND TOTAL YET
	SETOM TYPING		;TYPEOUT HAPPENING
	MOVX A,.SFTMZ		;GET TIME ZONE FOR DATE COMPARISONS
	TMON
	MOVN A,B		;CHANGE SIGN TO USE ADD, NOT SUB
	HRLZS A			;PUT TIME ZONE IN LH
	IDIVI A,^D24		;COMPUTE TIME ZONE CORRECTION TO UDT
	MOVEM A,TIMCVT		;STORE FOR DFDBCM
;DECODE ARGUMENT LIST WITH SUBROUTINE "DIRARG" IN SUBRS.MAC.
;THIS INPUTS A FILE GROUP (NAMES WITH "*" ALLOWED,
;MULTIPLE NAMES ALLOWED, -2 RETURNED FOR NO SUCH FILE, ETC.)
;DEFAULTS NOTHING TO WHOLE CONNECTED DIRECTORY;
;INTERPRETS COMMA OR EOL TERMINATOR TO THE
;WORD "DIRECTORY".

	PUSH P,Z		;SAVE FLAGS
	TXO Z,IGINV		;FIND INVISIBLE FILES
	CALL DIRARG
	JRST [	POP P,A		;GET FLAGS BACK
		TXZ Z,IGINV	;SET IGINV AS BEFORE
		TXNE A,IGINV
		 TXO Z,IGINV
		SUBCOM $DIRS	;INPUT SUBCOMMANDS FROM TABLE $DIRS
		JRST DIRSB1]
	POP P,A
	TXZ Z,IGINV
	TXNE A,IGINV
	 TXO Z,IGINV
DIRSB1:	SKIPE KEPDNM		;DOING "FIND"?
	TXNN Q2,CHKF		;YES, ALSO CHECKSUM?
	CAIA			;NO
	TYPE <%Can't summarize checksums during "FIND"
>
;EXECUTE "DIRECTORY"

				;OPEN OUTPUT FILE, IF ANY.
	SKIPN A,DIRJFN		;OUTJFN
	JRST DIRREG		;NO SPECIAL JFN
	MOVX B,OF%WR		;WRITE.
	CALL $OPEN7		;OPEN, 7 BIT BYTES, MODE 0.
	MOVE A,DIRJFN
	MOVEM A,COJFN		;SET UP STANDARD OUTPUT STREAM TO BE FILE
DIRREG:	SETZM TPWRNF		;HAVEN'T WARNED ABOUT BAD MAGTAPE SUBCOMMANDS YET
	SETZM DTWRNF		;HAVEN'T WARNED ABOUT BAD DECTAPE SUBCOMMANDS YET
	MOVE A,INIFH1		;PTR TO FIRST JFN IN BUFFER
	CAMGE A,INIFH2		;PTR TO LAST
	TLO Z,F3		;SET FLAG IF MORE THAN 1JFN
	HRROI A,OFMES		;MEASURE LENGTHS OF HEADER STRINGS
	CALL BCOUNT
	AOJ B,			;LEAVE SPACE BETWEEN FIELDS
	MOVEM B,OFMESL
	HRROI A,ONMES
	CALL BCOUNT
	AOJ B,			;LEAVE SPACE BETWEEN FIELDS
	MOVEM B,ONMESL
	SETZM NAMDIR		;NAME OF PREVIOUS DIRECTORY PRINTED (0 IS ILLEGAL)
	SETOM DIRCN1
	SETOM DIRCN2
	SETOM BLKCN1
	SETOM BLKCN2
	SETZM CHKCN1
	SETZM CHKCN2
	SETZM FILCN1
	SETZM FILCN2
	SETZM BATCN1
	SETZM BATCN2
	SETZM ERRCN1
	SETZM ERRCN2
	SETZM DIRFL1
	SETZM DIRFL2
	SETOM PNTCNT
	TLZ Z,F1!F2		;NO LIST ERRORS YET, NO OLD JFN
	MOVEM Q2,REALQ2		;REMEMBER WHAT USER REQUESTED
	MOVEM Q1,REALP2		;REMEMBER OTHER ITEMS USER REQUESTED
;COME BACK HERE TO PROCESS NEXT ARGUMENT IN LIST

DIRFL:	CALL UNMDR1		;UNMAP DIRECTORY BUFFER PAGES, THUS 0ING THEM
	TLNN Z,F2		;DON'T PRINT HEADING IF FINISHING OLD JFN
	TXO Z,PDNF		;SAY DIRECTORY CHANGED
	HRRZ A,@INIFH1		;SEE IF REAL JFN NEXT
	CAIE A,FI%ERR		;IS THIS AN ERRONEOUS JFN?
	JRST DI3		;NO
	CALL DFREST		;FINISH PREVIOUS FILESPEC BEFORE HANDLING ERROR
	HLRZ A,@INIFH1		;YES, GET ADDRESS OF ERROR BLOCK
	MOVE B,.FIJFN(A)	;GET JFN
	MOVE A,CSBUFP		;SOME BUFFER SPACE
	MOVX C,FLD(.JSAOF,JS%DEV)!JS%PAF ;GET PUNCTUATED DEVICE FIELD
	JFNS			;GET IT (I CAN'T IMAGINE THIS JFNS CAN FAIL)
	MOVE B,CSBUFP		;POINT TO THE DEVICE
	MOVX A,GJ%SHT		;REGULAR GTJFN
	CALL GTJFS		;GET HANDLE ON THE TAPE FOR REWINDING IT
	 JRST DI3		;IF THIS FAILS, GIVE ORIGINAL ERROR
	MOVEM A,TAPJFN		;SAVE HANDLE ON TAPE
	DVCHR			;SEE IF THIS IS A MAGTAPE
	LOAD A,DV%TYP,B
	CAIE A,.DVMTA		;MAGTAPE?
	JRST DI3		;NO, GIVE ORIGINAL ERROR
	MOVE A,TAPJFN		;GET JFN TO REWIND THE TAPE
	CALL REWIND		;REWIND THE TAPE
	MOVE A,[.NULIO,,.NULIO]	;DON'T LET GTJFN READ FROM REAL TERMINAL!
	MOVEM A,.GJSRC+CJFNBK
	MOVX A,GJ%OLD!GJ%IFG!.GJALL ;OLD FILE, ALLOW WILDCARDING, DEFAULT TO ALL GENERATIONS
	MOVEM A,.GJGEN+CJFNBK
	HRROI A,[ASCIZ /*/]	;DEFAULT ALL FILESPEC FIELDS TO STARS
	MOVEM A,.GJNAM+CJFNBK	;SO "MT1:" = "MT1:*.*.*"
	MOVEM A,.GJEXT+CJFNBK
	HLRZ A,@INIFH1		;POINT TO BLOCK AGAIN
	MOVE B,.FISTR(A)	;GET POINTER TO FILESPEC THAT USER TYPED
	MOVEI A,CJFNBK		;ASSUME OTHER DEFAULTS ARE CORRECT IN BLOCK
	CALL GTJFS		;GET "REAL" JFN ON TAPE FILE
	 JRST DI3		;IF THIS FAILS, GIVE USER ORIGINAL ERROR
	EXCH A,@INIFH1		;STORE NEW REAL JFN; GET OLD ONE
	MOVE B,JBUFP		;SEE WHERE WE ARE ON JFN STACK
	MOVEM A,(B)		;LEAVE OLD JFN ON STACK SO IT GETS FLUSHED LATER
	TXO Z,MTAF		;REMEMBER WE'VE GOT A MAGTAPE
	JRST DDIR		;GO DO DIRECTORY OF IT
DI3:	PUSHJ P,NXFILE		;CHECK AND PRINT MESSAGE FOR NON-EX FILES
	 JRST [	SKIPE INIFH1	;ALL TERMS DONE?
		JRST DIRFL	;NO, DO NEXT
		JRST DIRFL0]	;ALL DONE
	TLZE Z,F2		;DOING MORE OF SAME JFN?
	JRST DDIR		;YES, SO WE KNOW WHAT KIND OF DEVICE IT IS
	HRRZ A,@INIFH1
	DVCHR
	LDB B,[POINT 9,B,17]	;DEVICE TYPE
	TXZ Z,MTAF!DSKF!DECF	;CLEAR SPECIAL DEVICE FLAGS
	JUMPE B,[TXO Z,DSKF	;REMEMBER IT'S A DISK
		 JRST DDIR]
	CAIN B,.DVMTA		;IS THIS AN MT?
	JRST [	TXO Z,MTAF	;YES. REMEMBER THAT
		HRRZ A,@INIFH1	;MIGHT AS WELL USE THAT JFN FOR THE TAPE JFN
		MOVEM A,TAPJFN	;REMEMBER TAPE JFN
		CALL REWIND	;REWIND THE TAPE
		MOVE B,@INIFH1	;GET JFN AGAIN
		MOVE A,CSBUFP	;SOME STRING SPACE
		MOVEI C,0	;STANDARD OUTPUT
		JFNS		;GET STRING FOR WHAT HE TYPED
		MOVX A,GJ%IFG!GJ%OLD!GJ%SHT ;ALLOW STARS, FILE MUST EXIST, SHORT FORM
		MOVE B,CSBUFP	;POINT TO STRING
		CALL GTJFS	;GET HANDLE ON FIRST FILE TO LIST
		 CALL CJERRE	;SHOULDN'T FAIL, I DON'T THINK.
		EXCH A,@INIFH1	;USE THIS NEW JFN
		MOVE B,JBUFP	;GET ADDRESS OF NEW JFN
		MOVEM A,(B)	;COMPLETE THE SWAP ON THE JFN STACK
		JRST DDIR]	;AND PROCEED
	CAIE B,.DVDTA		;DECTAPE?
	ERROR <Illegal device>
;DECTAPE. DEV DESIGNATOR IN A.

	TXO Z,DECF		;SAY DECTAPE
	CALL DTADIR		;SET UP DIRECTORY INFO

;DISK
;Q1,Q2, AND Z STILL CONTAIN VARIOUS FLAGS (SEE ABOVE)

DDIR:	CALL DSKDIR		;LIST IT

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

	TLNE Z,F2
	JRST DIRFL		;GO DO NEXT ONE FOR THIS JFN
				;(ALREADY GNJFN'D).
	MOVE A,TAPJFN		;GET JFN ON TAPE
	TXNE Z,MTAF		;IS THIS A MAGTAPE?
	CALL REWIND		;YES, REWIND IT
	AOS A,INIFH1		;STEP POINTER INTO JFN BUFFER
	CAMG A,INIFH2		;BEYOND END?
	JRST DIRFL		;NO
DIRFL0:	CALL DFREST		;FINISH VERY LAST LINE
	CALL UNMDIR		;UNMAP BUFFERS
	CALL CNTDMP		;DUMP OUT LAST COUNTS
	TXNN Q2,SSF		;SKIP IF SUPPRESSING SUMMARY
	SKIPG PNTCNT
	JRST NGRAND
	MOVE A,DIRCN2
	MOVEM A,DIRCN1
	MOVE A,BLKCN2
	MOVEM A,BLKCN1
	MOVE A,CHKCN2
	MOVEM A,CHKCN1
	MOVE A,FILCN2
	MOVEM A,FILCN1
	MOVE A,BATCN2
	MOVEM A,BATCN1
	MOVE A,ERRCN2
	MOVEM A,ERRCN1
	MOVE A,DIRFL2
	MOVEM A,DIRFL1
	SETOM GRANDF		;SAY WE WANT GRAND
	CALL CNTDMP
NGRAND:	SKIPE BATCN2		;ANY BAT FILES?
	TXNE Q2,SOF		;YES, DID WE PRINT "*"?
	CAIA			;NO
	ETYPE <%_* Indicates file(s) with possible data errors%_>
	RET
;UNMDIR
;SUBROUTINE TO UNMAP PAGES USED AS BUFFERS IN LISTING DIRECTORIES
;CLOBBERS A-D.  ALSO USED IN LIST/TYPE.

UNMDIR::SETO A,
	MOVE B,[XWD .FHSLF,<BUF0>B44]
	MOVEI C,1
	PMAP
UNMDR1:	SETO A,
	MOVE B,[XWD .FHSLF,<BUF1>B44]
	MOVE C,[PM%CNT+<BUFL-BUF1>B44+1]
	PMAP
	RET
;DIRECTORY...

;SUBCOMMAND TABLE

$DIRS:	TABLE
	T ACCOUNT,ONEWRD,...ACC
	T ALPHABETICALLY,
	T ARCHIVE,,.AROLY	;ARCHIVED FILES ONLY
	T BEFORE		;FILES WRITTEN "BEFORE" GIVEN TIME AND DATE
	T CHECKSUM,
	T CHRONOLOGICAL,
	T COMPLETE,
	T CRAM,
	T DATES,,.DATES
	T DELETED,,..DELE
	T DOUBLESPACE,
	T EVERYTHING,ONEWRD
	T FIND,,..FIND
	T GENERATION-RETENTION-COUNT,ONEWRD,.VERSI
	T HEADING,ONEWRD
	T INVISIBLE,,.INOLY	;INVISIBLE FILES ONLY
	T LARGER		;ONLY FILES "LARGER" THAN SPECIFIED SIZE
	T LENGTH,
	T LPT,
	T NO,,..NO
	T OFFLINE,,.OFOLY	;OFFLINE FILES ONLY
	T ONLINE		;ONLINE FILES ONLY
	T OUTPUT,
	T PROHIBIT-MIGRATION,,.PROLY ;PROHIBITED-FROM-MIGRATION FILES ONLY
	T PROTECTION,ONEWRD,..PROT
	T RESIST-MIGRATION,,.REOLY ;RESISTED-FROM-MIGRATION FILES ONLY
	T REVERSE,
	T SEPARATE,
	T SINCE			;WRITTEN "SINCE" GIVEN TIME AND DATE
	T SIZE,,..SIZE
	T SMALLER		;"SMALLER" THAN SPECIFIED SIZE
	T TIMES,
	T USER,
	TEND
;SUB-COMMAND ROUTINES FOR "DIRECTORY" COMMAND

...ACC:	TRO Q1,ACCF
	RET

.NACCO:	TRZ Q1,ACCF		;NO ACCOUNTS
	RET

.ALPHA:	NOISE <SORTED>
	CONFIRM
	TXZ Z,SORTF		;CLEAR ORDER OF PRINTOUT FLAGS
	TXO Z,ALPHAF
	RET

.CHRON:	NOISE <BY>
	KEYWD $CHRON
	 T WRITE,,CHWRF		;NULL DEFAULTS TO THIS
	 JRST CERR		;NOT FOUND IN TABLE
	CONFIRM
	TXZ Z,SORTF		;CLEAR FLAGS RELATED TO ORDER OF PRINTOUT
	IOR Z,P3		;PUT IN THOSE FROM RESPONSE DECODING
	RET

$CHRON:	TABLE
	T CREATION,,CHCRF
	T READ,,CHRDF
	T TAPE-WRITE,,CHTPF
	T WRITE,,CHWRF
	TEND

.HEADI:	TXO Q2,FHF
	RET
;DIRECTORY SUB-COMMANDS...

.CHECK:	NOISE <FILES>
	KEYWD $CHECK
	 T BY-PAGES,,..CHKP
	 JRST CERR
	CALL (P3)		;PRINT NOISE, GET BIT
	CONFIRM
	TXO Q2,CHKF		;CHECKSUM
	TRZ Q2,1B23		;CLEAR PREVIOUS SETTING
	TRO Q2,(P3)		;SET THIS ONE
	RET

$CHECK:	TABLE
	T BY-PAGES,,..CHKP
	T SEQUENTIALLY,,..CHKS
	TEND

.NCHEC:	TXZ Q2,CHKF		;NO CHECKSUM
	RET

..CHKP:	NOISE <ON DISK>
	SETZ P3,
	RET

..CHKS:	NOISE <ALWAYS>
	MOVEI P3,FSCF
	RET
.COMPL:	NOISE <FILE NAMES>	;PARSE SOME NOISE WORDS
	CONFIRM			;GET CONFIRMATION
	TXO Q2,COMPLN		;TURN ON COMPLETE FILE NAME FLAG
	RET			;RETURN

NCOMPL:	NOISE <FILE NAMES>	;PARSE SOME NOISE WORDS
	CONFIRM			;GET CONFIRMATION
	TXZ Q2,COMPLN		;TURN OFF COMPLETE FILE NAME FLAG
	RET			;RETURN

.CRAM:	NOISE <OUTPUT>
	CONFIRM
	TXO Q1,SCF
	RET

.NCRAM:	TXZ Q1,SCF		;NO CRAM
	RET

.NDATE:	SETOM NOFLG		;REMEMBER "NO"
	JRST DATES0

.DATES:	SETZM NOFLG		;SAY "YES"
DATES0:	NOISE <OF>
	TLZ Z,F1
DATES1:	KEYWD $DATES		;"TIMES" JOINS HERE
	 T WRITE,,DWRF
	 JRST CERR
	CONFIRM
	MOVE A,(P3)		;GET DATE BIT
	TLNE Z,F1		;TIME WANTED WITH DATE?
	IOR A,1(P3)		;YES, ACCUMULATE TIME BIT WITH DATE BIT
	SKIPN NOFLG		;DIFFERENT ACTION ON "NO"
	IOR Q1,A		;UPDATES JFNS OPTIONS FROM TABLE
	SKIPE NOFLG
	TDZ Q1,A		;TURN OFF INSTEAD OF ON IF "NO"
	RET

.NTIME:	SETOM NOFLG		;REMEMBER "NO"
	JRST NTIME0

.TIMES:	SETZM NOFLG		;SAY "YES"
NTIME0:	NOISE <AND DATES OF>
	TLO Z,F1
	JRST DATES1
$DATES:	TABLE
	T CREATION,,[EXP DCREF,PCTF]
XARC <
	T OFFLINE-EXPIRATION,,[EXP POEF,POETF]
	T ONLINE-EXPIRATION,,[EXP PONEF,PONETF]
   >
	T READ,,[EXP DRDF,PRTF]
	T TAPE-WRITE,,[EXP PTDF,PTWF]
	T WRITE,,[EXP DWRF,PWTF]
	TEND

.NUSER:	SETOM NOFLG
	JRST USER0		;NO USER

.USER:	SETZM NOFLG		;SAY "YES"
USER0:	NOISE <WHO LAST>
	KEYWD $USERS
	 T WROTE,
	 JRST CERR
	JRST (P3)

$USERS:	TABLE
	T CREATED,
	T WROTE,
	TEND

.WROTE:	NOISE <FILE>
	CONFIRM
	SKIPN NOFLG
	TXO Q2,UWRF
	SKIPE NOFLG
	TXZ Q2,UWRF		;TURN OFF IF NO
	RET

.CREAT:	NOISE <FILE>
	CONFIRM
	SKIPN NOFLG
	TXO Q2,UCREF
	SKIPE NOFLG
	TXZ Q2,UCREF		;TURN OFF IF NO
	RET
.AROLY:	NOISE <FILES ONLY>
	CONFIRM
	TXO Q2,ARFO
	RET

.INOLY:	NOISE <FILES ONLY>
	CONFIRM
	TXO Q2,INVFO
	RET

.REOLY:	NOISE <FILES ONLY>
	CONFIRM
	TXO Q2,RESTO
	RET

.PROLY:	NOISE <FILES ONLY>
	CONFIRM
	TXO Q2,PROHBO
	RET

.OFOLY:	NOISE <FILES ONLY>
	CONFIRM
	TXO Q2,OFFO
	TXZ Q2,ONOF		;CANCEL POSSIBLE PREVIOUS ONLINE
	RET

.ONLIN:	NOISE <FILES ONLY>
	CONFIRM
	TXO Q2,ONOF
	TXZ Q2,OFFO		;CANCEL POSSIBLE PREVIOUS OFFLINE
	RET

..DELE:	NOISE <FILES ONLY>
	CONFIRM
	TLO Q2,1		;SAY DELETED FILES ONLY
	RET
.DOUBL:	NOISE <OUTPUT LINES>
	CONFIRM
	TXO Q2,DSF		;SAY DOUBLE SPACE
	RET

.NDOUB:	TXZ Q2,DSF		;NO DOUBLESPACE
	RET

.EVERY:	IOR Q1,[XARC <POEF+POETF+PONETF+PONEF>+001111177703]	;ALL FIELDS THAT CAN BE PRINTED
	TDO Q2,[SNEF+UCREF+UWRF+RETF] ;GET WRITE AND CREATE DIRS ALSO
	RET			;THIS IS TOO MUCH TO FIT ONE TTY LINE.

..FIND:	NOISE <FILES WITH MORE THAN>
	DEFX <1>		;DEFAULT IS 1
	DECX <Number of generations>
	 CMERRX
	CAIN B,1
	NOISE <GENERATION>
	CAIE B,1
	NOISE <GENERATIONS>
	CONFIRM
	SKIPGE B			;[7.1184]
	ERROR <Generation number cannot be negative> ;[7.1184]
	MOVEM B,KEPDNM		;STORE NUMBER OF VERSIONS HERE
	RET

.LENGT:	NOISE <IN BYTES>
	CONFIRM
	TXO Q1,PLBF		;SAY PRINT LENGTH IN BYTES
	RET

.NLENG:	TXZ Q1,PLBF		;NO LENGTH
	RET
;DIRECTORY SUB-COMMANDS...

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

.LPT::	CALL FINLPT		;FINISH THE SUBCOMMAND
	MOVEM A,DIRJFN		;REMEMBER OUTPUT JFN
	RET

.NLPT:	SETZM DIRJFN		;FORGET LPT JFN
	RET

;SUBROUTINE USED BY SYSTAT AND DIRECTORY FOR SUBCOMMAND TO ESTABLISH
;LPT AS OUTPUT DEVICE

FINLPT::NOISE <IS OUTPUT DEVICE>
	CONFIRM
        MOVSI A,(GJ%FOU!GJ%NEW!GJ%SHT)
	MOVE B,[POINT 7,[ASCIZ /LPT:/],-1]
	CALL GTJFS		;GET JFN ON LPT AND STACK
	 CALL CJERRE		;PROBABLY "LPT" SUBCOMMAND WHEN LPT: DEFINED AS JUNK:
	RET

GETLPT::MOVSI A,(GJ%FOU!GJ%NEW!GJ%SHT)
	MOVE B,[POINT 7,[ASCIZ /LPT:/],-1]
	CALL GTJFS		;GET AND STACK JFN
	 JRST [CONFIRM 
	       CALL CJERRE]	;PROBABLY "LPT" SUBCOMMAND WHEN LPT: DEFINED AS JUNK:
	RET

.OUTPU:	NOISE <TO FILE>
	MOVE A,[XWD [ASCIZ /DIR/],[ASCIZ /DIR/]] ;DEFAULT NAME & EXT
	CALL COUTFN
	 JRST CERR
	CONFIRM
	MOVEM A,DIRJFN		;ESTABLISH OUTPUT DEVICE
	RET
..NO:	KEYWD $$NO
	 T HEADING,,.NHEAD
	 JRST CERR
	JRST (P3)

$$NO:	TABLE
	T ACCOUNT,ONEWRD,.NACCO
	T CHECKSUM,ONEWRD,.NCHEC
	T COMPLETE,,NCOMPL
	T CRAM,ONEWRD,.NCRAM
	T DATES,,.NDATE
	T DOUBLESPACE,ONEWRD,.NDOUBL
	T FILE-LINES,ONEWRD,.NFILE
	T GENERATION-RETENTION-COUNT,ONEWRD,.NGENE
	T HEADING,ONEWRD,.NHEAD
	T LENGTH,ONEWRD,.NLENG
	T LPT,ONEWRD,.NLPT
	T PROTECTION,ONEWRD,.NPROT
	T REVERSE,,.NREVER
	T SEPARATE,ONEWRD,.NSEPA
	T SIZE,ONEWRD,.NSIZE
	T SUMMARY-LINES,ONEWRD,.NSUMM
	T TIMES,,.NTIME
	T USER,,.NUSER
	TEND

.NFILE:	TXOA Q2,SOF
.NSUMM:	TXO Q2,SSF
	RET

.NHEAD:	TXO Q2,SHF		;SAY NO HEADER
	TXZ Q2,FHF		;SAY DON'T FORCE HEADER
	RET

..PROT:	TXOA Q1,PPF		;PRINT PROTECTION
.NPROT:	TXZ Q1,PPF		;NO PROTECTION
	RET

.REVER:	NOISE <SORTING>
	CONFIRM
	TXO Z,REVF		;SAY LIST IN REVERSE ORDER
	RET

.NREVE:	NOISE <SORTING>
	CONFIRM
	TXZ Z,REVF		;NO REVERSE
	RET
;SINCE (TIME AND DATE) ONLY LIST FILES WRITTEN SINCE CERTAIN DATE

.SINCE:	NOISE <DATE AND TIME>
	DTPX <
Only files written more recently than specified date and time will be listed>
	 CMERRX <Invalid SINCE subcommand>
	CONFIRM
	MOVEM B,SINDAT		;REMEMBER WHAT DATE SUPPLIED
	TXO Q2,SINCEF		;REMEMBER THAT SINCE SUBCOMMAND GIVEN
	RET

;BEFORE (DATE AND TIME) ONLY LIST FILES WRITTEN BEFORE CERTAIN DATE

.BEFOR:	NOISE <DATE AND TIME>
	DTPX <
Only files written earlier than specified date and time will be listed>
	 CMERRX <Invalid BEFORE subcommand>
	CONFIRM
	MOVEM B,BEFDAT
	TXO Q2,BEFORF
	RET

;SMALLER (THAN) ONLY LIST SMALL FILES

.SMALL:	NOISE <THAN>
	DECX <Only files smaller than specified decimal number of pages will be listed>
	 CMERRX <Invalid SMALLER subcommand>
	CONFIRM
	MOVEM B,SMLSIZ		;SAVE UPPERBOUND ON SIZE
	TXO Q2,SMALLF		;NOTE THAT THIS SUBCOMMAND GIVEN
	RET

;LARGER (THAN) ONLY LIST LARGE FILS

.LARGE:	NOISE <THAN>
	DECX <Only files larger than specified decimal number of pages will be listed>
	 CMERRX <Invalid LARGER subcommand>
	CONFIRM
	MOVEM B,LRGSIZ
	TXO Q2,LARGEF
	RET
.SEPAR:	NOISE <LINES FOR EACH FILESPEC>
	CONFIRM
	TXO Q2,SMVF!SNEF
	RET

..SIZE:	NOISE <IN PAGES>
	CONFIRM
	TXO Q1,SIZPF
	RET

.NSEPA:	TXZA Q2,SMVF!SNEF	;NO SEPARATE
.NSIZE:	TXZ Q1,SIZPF		;NO SIZE
	RET

.VERSI:	TXOA Q2,RETF		;CAUSE GENERATION-RETENTION-COUNT TYPEOUT
.NGENE:	TXZ Q2,RETF		;NO GENERATION-RETENTION-COUNT
	RET

OFMES:	ASCIZ /Offline expiration/	;USED AND MEASURED HEADER STRINGS
ONMES:	ASCIZ /Online expiration/
;DHEAD
;TYPE HEADING, IF ANY, FOR DISK FILE DIRECTORY PRINTOUT.
;THIS ROUTINE MUST BE CHANGED WHENEVER DFILE'S FORMAT IS CHANGED!
;TAKES:	Q1: FIELDS TO PRINT BITS
;	Q2: SHF TO SUPPRESS HEADING

DHEAD:	TXNE Z,DECF
	JRST DTAHDR		;DECTAPE HEADER IS DIFFERENT
	PUSH P,A
	TXNE Q2,FHF		;WANT TO FORCE HEADER?
	JRST	DHEAD1		;YES - SKIP OTHER TESTS
	TXNE Q2,VDIRF!SHF!SOF	;"VDIRECTORY","SUPP. HEAD.", "DTA", OR "SUMMARY" FLAGS ON?
	JRST DHEADZ		;YES, NO HEADING
	TXNN P2,SIZPF+DCREF+DWRF+DRDF+PLBF+PCTF+PWTF+PRTF+PTDF+POEF+POETF+PONETF+PONEF+PTWF	;ANYTHING TO LIST AFTER ACCT FIELD?
	TXNE Q2,CHKF+UCREF+UWRF+RETF	;ANY OF THIS MAGIC?
	CAIA			;YES, HEADER
	JRST DHEADZ		;NO, NON-VERBOSE LISTINGS GET NO HEADING
DHEAD1:	PUSH P,B
	PUSH P,C
	CALL DINDNT		;INDENT THE RIGHT AMOUNT FOR FIELDS TO PRINT
;PRINT HEADERS FOR THE COLUMNS TO BE INCLUDED IN THIS LISTING

	MOVEI C,0		;FIRST ASSUME SUPPRESSING COLUMNATION
	TXNN P2,SCF		;ARE WE?
	HRROI C,[ASCIZ / /]	;NO, SO PUT SPACES IN
	TXNE P2,SIZPF		;SIZE IN PAGES
	ETYPE <PGS >
	TXNE P2,PLBF		;SIZE IN BYTES
	ETYPE <Bytes(SZ) %3M>
	TXNE Q2,RETF		;GENERATION RETENTION COUNT
	ETYPE <Ret %3M>
	TXNE P2,DCREF+PCTF	;CREATION DATE
	ETYPE <Creation %3M>
	TXNE P2,PCTF		;CREATION TIME
	ETYPE <        %3M>
	TXNE P2,DWRF+PWTF
	ETYPE <Write    %3M>
	TXNE P2,PWTF
	ETYPE <        %3M>
	TXNE P2,DRDF+PRTF
	ETYPE <Read     %3M>
	TXNE P2,PRTF
	ETYPE <        %3M>
	TXNE P2,PTDF+PTWF
	ETYPE <Tape-write  %3M>
	TXNE P2,PTWF
	ETYPE <         %3M>
	TXNE P2,PONEF!PONETF
	ETYPE <Online expiration %3M>
	HRROI A,OFMES		;POINT TO "OFFINE EXPIRATION"
	TXNE P2,POEF!POETF
	ETYPE <%1M %3M>
	TXNE Q2,UCREF
	ETYPE <Creator  %3M>
	TXNE Q2,UWRF
	ETYPE <Writer   %3M>
	TXNE Q2,CHKF
	ETYPE <Checksum>
	ETYPE <%_%%_>
	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.

XTRAS==2			;EXTRA SPACES NEEDED

DINDNT:	PRINT .CHTAB		;NAME, EXT, VERSION CROSS FIRST TAB STOP
	TXNE P2,PPF		;PROTECTION, IF REQUESTED IN PRINTOUT,
	PRINT .CHTAB		;CROSSES ANOTHER TAB STOP.
	TRNE P2,ACCF		;ACCT CROSSES ANOTHER.
	PRINT .CHTAB
	TXNN P2,SCF		;UNLESS COLUMNATION SUPPRESSED,
	PRINT .CHTAB		;FOLLOWING FIELDS BEGIN AT NEXT TAB STOP
	SKIPLE A,[XTRAS]	;ANY EXTRA SPACES NEEDED?
DINDN1:	 PRINT " "		;YES, PRINT THEM
	SOJG A,DINDN1		;PRINT DESIRED NUMBER
	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:	MOVE Q2,REALQ2		;START WITH ALL THE FLAGS
	MOVE P2,REALP2		;ALL FOR DISK
	CALL DFREST		;PRINT REST OF LAST LINE
	TLZN Z,F1		;ANY LIST ACCESS ERRORS?
	JRST DSKP5
	TLNN Z,GROUPF
	TYPE < LIST protection violation
>				;FOR A SINGLE FILE
	TLNE Z,GROUPF
	TYPE < Plus file(s) that are LIST protected from you
>
DSKP5:	SETZM LPNAME		;NOT "SAME NAME AS PREVIOUS" YET
	SETZM LPEXT
	TXNN Z,DECF		;IS THIS A DECTAPE?
	 JRST DSKP6		;NO, CHECK MAGTAPE
	MOVEI A,0		;NO ILLEGAL OPTIONS YET
	TXZE P2,Q1NDTA		;TURN OFF ALL OPTIONS ILLEGAL FOR DECTAPE
	 MOVEI A,1		;FLAG SOME WERE ON
	TXZE Q2,Q2NDTA		;TURN OFF ALL OPTIONS ILLEGAL FOR DECTAPE
	 MOVEI A,1		;FLAG SOME WERE ON
	CAIE A,0		;ANY ON?
	 SKIPE DTWRNF		;YES, WARNING GIVEN YET?
	  CAIA			;NO, NO MESSAGE
	   ETYPE <%%Invalid options for dectape being ignored%_>
	SETOM DTWRNF		;REMEMBER GIVEN
	JRST DSKP0

DSKP6:	TXNN Z,MTAF		;NO.  IS THIS A TAPE?
	JRST DSKP0		;NO WARNINGS NECESSARY
	MOVEI A,0		;SEE IF WARNING NEEDED
	TXZE P2,Q1NTAP		;TURN OFF ALL OPTIONS ILLEGAL FOR TAPE
	MOVEI A,1		;SAY WARNING NEEDED
	TXZE Q2,Q2NTAP		;SEE IF ANY ILLEGAL COMBINATIONS REQUESTED HERE
	MOVEI A,1		;YES!
	CAIE A,0		;PRINT WARNING IF ANY VIOLATIONS
	SKIPE TPWRNF		;HAVE WE ALREADY WARNED ABOUT TAPE?
	CAIA
	ETYPE <%%Invalid options for magtape being ignored%_>
	SETOM TPWRNF		;DON'T GIVE WARNING MORE THAN ONCE!
DSKP0:	TXNE Q2,SHF		;HEADING SUPPRESS?
	TXNN Q2,SSF		;YES, OK IF NO SUMMARY
	CAIA			;BUT MUST HAVE IT OTHERWISE
	RET
	PUSH P,A
	PUSH P,B
	PUSH P,C
	HRROI A,DSBUF		;JFNS TO STRING BUFFER
	SETZM DSBUF		;SO WE'LL KNOW IF SOMETHING GETS WRITTEN
	HRRZ B,@INIFH1		;JFN OF CURRENT ARG
	MOVE C,[FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!JS%PAF]	;PRINT DEV, PRINT DIR, PUNCUATE
	TXNE Z,MTAF!DECF	;IS THIS A MAGTAPE OR DECTAPE?
	MOVE C,[FLD(.JSSSD,JS%DEV)!JS%PAF]	;YES. GET DEVICE ONLY THEN
	JFNS
	 ERJMP R
	SKIPN DSBUF
	JRST DNAMEX		;NULL STRING, PRINT NOTHING
	TXNE Z,MTAF!DECF	;IS THIS AN MT OR DTA?
	JRST [	SETZM NAMDIR
		JRST DNAME8]	;YES. NO DIRECTORY THEN
	PUSH P,A
	MOVSI A,(RC%EMO)	;NO RECOGNITION ALLOWED
	HRROI B,DSBUF
	RCDIR
	MOVEM C,DIRNO		;SAVE DIRECTORY NUMBER
	POP P,B
	MOVE A,DIRNO
	CAMN A,NAMDIR
	JRST DNAMEX		;NO CHANGE, DON'T PRINT AGAIN
	MOVEM A,NAMDIR
DNAME8:	CALL CNTDMP
	TXNN P2,SCF		;SKIP INITIAL CR IN CRAM FORMAT FOR "VDIRECTORY"
	ETYPE <%_>		;BLANK LINE ABOVE DIRECTORY
	HRROI B,DSBUF
	ETYPE <   %2M%%_>
	CALL DHEAD		;PRINT HEADINGS
	TXNE Q2,DSF
	ETYPE <%_>		;EXTRA EOL IF DOUBLE-SPACING
DNAMEX:	POP P,C
	POP P,B
	POP P,A
	RET
;CNTDMP
;SUBROUTINE TO DUMP SIZE, LENGTH, CHECKSUM TOTALS

CNTDMP:	TXNN Q2,SSF		;SUPPRESSING SUMMARY?
	SKIPG A,FILCN1		;NO, ANY FILES IN THIS TERM?
	RET			;RETURN IMMEDIATELY IF NO FILES
	CAIN A,1		;IF ONLY 1 FILE,
	TXNE Q2,SOF		;AND NOT SUMMARY ONLY
	CAIA			;NOPE
	JRST CNTDM9		;THEN NO PRINT, BUT RESET COUNTERS
	ETYPE <%_>
	HRROI B,[ASCIZ/ Total of /]
	SKIPE GRANDF		;REQUESTING "GRAND"?
	HRROI B,[ASCIZ/ Grand total of /]	;YES
	ETYPE <%2M>
	TXNN P2,SIZPF		;SIZE REQUESTED?
	JRST CNTDM2
	SKIPGE B,DIRCN1
	JRST CNTDM0
	ETYPE <%2Q page>
	MOVE C,DIRCN1
	CAIE C,1
	TYPE <s>
	SKIPL BLKCN1
	TYPE < and >
CNTDM0:	SKIPGE B,BLKCN1
	JRST CNTDM1
	ETYPE <%2Q block>
	MOVE C,BLKCN1
	CAIE C,1
	TYPE <s>
CNTDM1:	TYPE < in >
CNTDM2:	MOVE B,FILCN1
	ETYPE <%2Q file>
	MOVE C,FILCN1
	CAIE C,1
	PRINT "s"
	TXNN Q2,CHKF		;CHECKSUM?
	JRST CNTDM3
	SKIPE KEPDNM		;CAN'T GET CORRECT SUMMARY WITH THIS
	JRST CNTDM4		;JUST SUMMARIZE FILE ERRORS
	TYPE <, Checksum = >
	HLRZ B,CHKCN1
	HRRZ C,CHKCN1
	ADD C,B
	HLRZ B,C
	ADDI B,(C)
	MOVE C,[1B0+1B2+1B3+6B17+10]
	MOVE A,CSBUFP		;WRITE NUMBER TO TEMPORARY BUFFER
	NOUT
	 CALL JERRC
	MOVE A,CSBUFP
	ETYPE <%1M>		;TYPE THE NUMBER
	SKIPN B,DIRFL1
	JRST CNTDM4
	CAMN B,FILCN1		;IF SAME AS NUMBER OF FILES,
	JRST [	HRROI B,[ASCIZ/ P/] ;JUST PRINT "P"
		JRST CNTDM6]
	MOVE B,DIRFL1
	ETYPE <, %2Q>
	HRROI B,[ASCIZ/ by pages/]
CNTDM6:	ETYPE <%2M>
CNTDM4:	SKIPN ERRCN1
	JRST CNTDM3
	MOVE B,ERRCN1
	ETYPE <, with %2Q checksum error>
	MOVE C,ERRCN1
	CAIE C,1
	TYPE <s>
CNTDM3:	SKIPN BATCN1
	JRST CNTDM5
	MOVE B,BATCN1
	ETYPE <, %2Q file>
	MOVE C,BATCN1
	CAIE C,1
	TYPE <s>
	TYPE < with possible data errors>
CNTDM5:	ETYPE <%_>
CNTDM9:	AOS PNTCNT		;COUNT A SUBTOTAL EVEN IF WE DON'T PRINT IT
	SETOM DIRCN1
	SETOM BLKCN1
	SETZM CHKCN1
	SETZM FILCN1
	SETZM BATCN1
	SETZM ERRCN1
	SETZM DIRFL1
	RET
;DTADIR - DECTAPE SPECIFIC
DTADIR:	TRNN Z,SORTF		;ORDER SPCIFIED?
	TXO Z,ALPHAF		;NO, DEFAULT TO ALPHABETIC

;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.

;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 on "REMOTE">
		JRST CJERR]

;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
DTADR2:	ILDB D,B		;FETCH A SLOT BYTE
	AOS DTATBL(D)		;INDEX APPROPRIATE TABLE WORD
	SOJG C,DTADR2
	RET
;TYPE # FREE BLOCKS
;SUPPRESS IF NOT LISTING WHOLE DIRECTORY ??

DTAHDR:	TXNE P2,SCF
	RET			;OMIT IN CRAM FORMAT (VDIRECTORY)
	PUSH P,A
	SKIPN DTADRC+^D127
	JRST DTFRE0		;NO LABEL
	TXNE Q2,DSF
	ETYPE <%_>		;EXTRA EOL IF DOUBLE-SPACING
	MOVE A,DTADRC+^D127
	ETYPE< Tape id: %1'%%_>
DTFRE0:	TXNE Q2,DSF
	ETYPE <%_>		;EXTRA EOL IF DOUBLE-SPACING
	MOVE B,DTATBL+0
	ETYPE < %2Q. Free blocks, >
	MOVE C,[XWD -^D22,^D83]	;PREPARE TO LOOP THROUGH ALL NAMES
	SETZ B,			;COLLECT COUNT HERE
DTFRE1:	SKIPN DTADRC(C)		;NAME HERE?
	ADDI B,1		;NO, COUNT FREE SPACE
	AOBJN C,DTFRE1		;LOOP
	ETYPE <%2Q. Free files%_%%_>
	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
;	INIFH1:	POINTER TO INDEXABLE FILE HANDLE
;	Z,Q1,Q2:	VARIOUS FLAGS, SEE COMMENTS AT
;		BEGINNING OF "DIRECTORY", INCL Q2 B12 FOR DECTAPE.
;RETURNS F2 SET IF ADDITIONAL FILES ARE TO BE LISTED
;	FOR CURRENT INDEXABLE FILE HANDLE.
;CLOBBERS A-D,Q3-GG.

;BUFFER DEFINITIONS


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

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

DSKDIR:
;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 P4,0		;INITIALIZE TABLE INDEX
	SETZM FNDPTR		;INITIALIZE PREVIOUS EXT POINTER
	MOVEI C,DIRBUF		;INITIALIZE BUFFER SPACE POINTER

;TOP OF LOOP

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

DSKR1:	CAIG C,720+BUFL
	CAIL P4,TABLEN-1
	JRST [	TYPE < Storage full,
 Directory will be printed in two or more sections
>
		JRST DSKR8]	;GO SET F2, LIST THIS MUCH.
;DSKDIR... READ...
;READ AND STORE FDB AND STRINGS FOR A FILE

	TXNE Z,MTAF!DECF	;IS THIS AN MT?
	JRST DSKR2		;YES. DON'T DO GTFDB THEN
	HRRZ A,@INIFH1		;JFN
	MOVE	B,[FDBHGH+1,,.FBHDR] ;LEN,,START
				;C ALREADY SET RIGHT
	GTFDB			; GET THE FDB
	 ERJMP [CALL %GETER	; GET THE ERROR
		HRRZ A,ERCOD
		CAIN A,GFDBX3	; LIST ACCESS NOT ALLOWED?
		JRST [TLO Z,F1	;FLAG INVOKES MSG LATER
			JRST DSKR7] ;SKIP THIS ONE
		CAIN A,STRX10	;[7.1170]Is the structure offline?
		JRST CJERRE	;[7.1170]Yes, just say so
		CAIE A,GFDBX2
		CAIN A,GFDBX1	; INVALID # WORDS OR DISPLACEMENT?
		CAIA		; ONE OF THOSE
		JRST JERRE	; NEITHER, LOOSE
		HRRZ A,@INIFH1	; RETRIEVE THE JFN
		MOVE B,[.FBLN0+1,,.FBHDR] ; GET WHAT WE CAN
		GTFDB
		 ERJMP JERRE
		JRST .+1]

	MOVE A,.FBCTL(C)	;CONTROL BITS WORD OF FDB
	TXNE Q2,DFOF		;"DELETED FILES ONLY" REQUESTED?
	TXC A,FB%DEL		;YES,COMPLEMENT "DELETED" BIT
	TXNE A,FB%DEL		;IS THIS FILE DELETED OR NOT
				;AS REQUESTED?
	JRST DSKR7		;NO SKIP IT.
	TXNN Q2,BEFORF		;"BEFORE" SWITCH?
	 JRST DSKRNB		;NO
	MOVE A,.FBWRT(C)	;GET WRITE DATE OF FILE
	CAML A,BEFDAT		;IS FILE OLD ENOUGH?
	JRST DSKR7		;NO SKIP IT.
DSKRNB:	TXNN Q2,RESTO		;RESIST-MIGRATION ONLY?
	 JRST DSKNRE		;NO
	MOVE A,.FBBBT(C)	;YES, GET INFO FOR THIS FILE
	TXNN A,AR%NAR		;IS THIS FILE RESISTED?
	JRST DSKR7		;NO, SO SKIP IT
DSKNRE:	TXNN Q2,PROHBO		;PROHIBIT-MIGRATION ONLY?
	 JRST DSKNBO		;NO
	MOVE A,.FBBBT(C)	;YES, GET INFO
	TXNN A,AR%EXM		;IS THIS FILE PROHIBITED FROM MIGRATION
	JRST DSKR7		;NO, SO SKIP IT
DSKNBO:	TXNN Q2,SINCEF		;"SINCE" SWITCH?
	 JRST DSKRNS		;NO
	MOVE A,.FBWRT(C)	;YES, GET WRITE DATE OF FILE
	CAMG A,SINDAT		;IS FILE NEW ENOUGH?
	JRST DSKR7		;NO
DSKRNS:	TXNN Q2,SMALLF		;"SMALLER" SWITCH GIVEN?
	 JRST DSKRNM		;NO
	HRRZ A,.FBBYV(C)	;GET FILE PAGE SIZE
	CAML A,SMLSIZ		;IS FILE SMALL ENOUGH?
	 JRST DSKR7		;NO
DSKRNM:	TXNN Q2,LARGEF		;"LARGER" SWITCH GIVEN?
	 JRST DSKRNO		;NO
	HRRZ A,.FBBYV(C)	;GET FILE PAGE SIZE
	CAMG A,LRGSIZ		;IF FILE BIG ENOUGH?
	 JRST DSKR7		;NO
DSKRNO:	MOVE A,.FBCTL(C)	; RECOVER CTL BITS
	TXNE Q2,ONOF		;USER ONLY WANTS ONLINE?
	TXNN A,FB%OFF		;YES.  IS THIS FILE ONLINE?
	CAIA			;USER DIDN'T CARE, OR DOES AND FILE IS ONLINE.
	JRST DSKR7		;USER WANTS ONLINE ONLY, AND THIS FILE IS OFFLINE.
	TXNE Q2,OFFO		;OFFLINE ONLY?
	TXNE A,FB%OFF		;YES, IS FILE OFFLINE?
	 CAIA			;NO, OR NO & YES
	  JRST DSKR7
	TXNE Q2,ARFO		;ARCHIVED?
	 JRST [	MOVE B,.FBBBT(C) ;GET REQUEST BITS ETC.
		TXNN A,FB%ARC	;ARCHIVED?
		TXNE B,AR%RAR	;VOLUNTARY REQUEST?
		CAIA		;ONE OF THEM IS ON
		JRST DSKR7
		TXNN Q2,INVFO	;WANT TO FILTER OUT VISIBLE FILES?
		TXZ A,FB%INV	;NO, MAKE INVISIBLE APPEAR VISIBLE...
		JRST .+1]
	TXNE Q2,INVFO		;INVISIBLE?
	TXC A,FB%INV
	TXNE A,FB%INV
	 JRST DSKR7		;NO
DSKR2:	MOVEM C,SAVPTR		;REMEMBER POINTER TO FDB
	TXZE Z,PDNF		;TIME TO PRINT DIR NAME?
	CALL DNAME		;YES, BECAUSE MAYBE IT CHANGED
	MOVE D,SAVPTR		;RESTORE POINTER TO FDB
	TXNN Q2,CHKF		;REQUESTING CHECKSUM?
	JRST DSKRNC		;NO
	HRRZ A,@INIFH1		;GET JFN
	MOVE B,[44B5+0B9+OF%RD+OF%PDT] ;READ FULL WORDS, MODE 0, PRESERVE DATES
	OPENF
	JRST [	HRRZM A,FDBCHK(D);STORE ERROR CODE FOR LATER
		AOS ERRCN1
		AOS ERRCN2	;COUNT ERROR
		JRST DSKRNC]
	MOVEM P,CHKPSV		;SAVE P IN CASE OF ERROR
	MOVEI B,FILEOF		;WHERE TO GO ON EOF
	MOVEM B,EOFDSP
	MOVEI B,DSKRCE		;WHERE TO GO ON DATA ERROR
	MOVEM B,DATDSP
	MOVEI B,DSKRCI		;WHERE TO GO ON ILLEGAL ACCESS, ETC.
	MOVEM B,ILIDSP
	SETZM CHKCN0		;INTIALIZE FILE CHECKSUM
	DVCHR			;DEVICE CHARACTERISTICS FOR JFN
	HLRZ A,A
	CAIE A,.DVDES+.DVDSK	;DSK?
	JRST DSKRC1		;NO, DO IT SEQUENTIALLY
	TXNN Q2,FSCF		;SEQUENTIAL DISK CHECKSUM?
	JRST DSKRC5		;NO, SKIP SEQUENTIAL DISK SETUP
	LOAD C,FB%BSZ,.FBBYV(D)	;COMPUTE LAST FULL PAGE OF FILE
	MOVEI A,^D36
	IDIV A,C		;COMPUTE NUMBER OF BYTES IN WORD
	MOVE B,.FBSIZ(D)	;GET FILE SIZE IN BYTES
	IDIV B,A		;COMPUTE NUMBER OF WORDS IN FILE
	LSH B,-^D9		;COMPUTE NUMBER OF PAGES BEFORE USING SIN
	JUMPE B,DSKRC1		;IF NONE TO USE, GO START SIN'ING,
	MOVEM B,SEQPGC		;OTHERWISE STORE SEQUENTIAL PAGE COUNTER
	LSH B,^D9		;COMPUTE WORD NUMBER TO START SIN'ING AT
	MOVEM B,SEQSWC		;STORE SIN WORD COUNT
	JRST DSKRC7		;AND REJOIN COMMON CODE
DSKRC5:	SETZM SEQPGC		;MAKE SOSE AT END OF LOOP ALWAYS FAIL
	SETOM FDBCHK(D)		;FLAG CHECKSUM BY PAGES
	AOS DIRFL1		;COUNT FOR SUMMARY
	AOS DIRFL2		;AND FOR GRAND
DSKRC7:	HRLZ A,@INIFH1		;GET JFN,,0
	MOVE B,[.FHSLF,,<CHKBUF>B44] ;FORK,,PAGE
DSKRC3:	HRRZM A,LSTPAG		;SAVE PAGE WE ARE STARTING AT
	FFUFP			;FIND NEXT USED FILE PAGE
	 JRST [	CAIN A,FFUFX3	;NO MORE PAGES?
		JRST DSKRC2	;RIGHT, NORMAL END
		JRST DSKRC6]	;GO STORE ERROR CODE
	HRRZ D,A		;GET JUST PAGE
	SUB D,LSTPAG		;GET OFFSET FROM WHERE WE STARTED
	TXNN Q2,FSCF		;JUMP IF DOING SEQUENTIAL CHECKSUM
	SKIPN D			;OR IF NO HOLE
	JRST DSKRC4
	MOVNI C,(D)		;YES, GET -PAGE #
	HRL C,D			;MAKE IT PAGE #,,-PAGE #
	PUSH P,C		;STUFF WORD ONTO STACK
	MOVSI C,-1
	HRRI C,-CHKBUF(P)	;ARRANGE TO POINT AT IT
	CALL CHKSOM		;CHECKSUM 1 WORD
	POP P,(P)		;RESTORE STACK
DSKRC4:	LDF C,PM%RD		;READ ACCESS
	PMAP			;MAP PAGE INTO BUFFER
	MOVSI C,-1000		;SET UP AOBJN POINTER TO WHOLE PAGE
	CALL CHKSOM		;CHECKSUM IT
	AOJ A,			;COMPUTE NEXT PAGE TO GET
	SOSE SEQPGC		;WAS THIS THE LAST PAGE TO DO WITH PMAP?
	JRST DSKRC3		;NO, GO GET NEXT PAGE
	SETO A,			;RELEASE CHKBUF PAGE FROM MAP
	MOVE B,[.FHSLF,,<CHKBUF>B44]
	SETZ C,
	PMAP
	HRRZ A,@INIFH1		;RESET BYTE POINTER FOR SIN'ING
	MOVE B,SEQSWC
	SFPTR
	 CALL CJERR		;SHOULD NEVER FAIL
DSKRC1:	HRRZ A,@INIFH1		;GET JFN AGAIN
	MOVE B,[POINT 36,CHKBUF] ;INTO CHKBUF
	MOVNI C,1000		;MAX 1000 WORDS
	SIN
	MOVNI C,1000(C)		;MAKE AOBJN POINTER TO WORDS READ
	HRLZS C
	CALL CHKSOM
	JRST DSKRC1		;LOOP TILL EOF
CHKSOM:	MOVE D,CHKCN0
	ROT D,1
	ADD D,CHKBUF(C)
	MOVEM D,CHKCN0
	MOVE D,CHKCN1
	ROT D,1
	ADD D,CHKBUF(C)
	MOVEM D,CHKCN1
	MOVE D,CHKCN2
	ROT D,1
	ADD D,CHKBUF(C)
	MOVEM D,CHKCN2
	AOBJN C,CHKSOM
	RET

FILEOF:	MOVNI C,1000(C)		;MAKE AOBJN POINTER TO WORDS READ
	JUMPE C,DSKRC2		;IN CASE NO WORDS READ
	HRLZS C
	CALL CHKSOM
	JRST DSKRC2		;NO ERROR ENDING

DSKRCE:	MOVNI A,2		;DATA ERROR FLAG
	JRST DSKRC6
DSKRCI:	HRRZ A,ERCOD
DSKRC6:	MOVE P,CHKPSV		;RESTORE STACK TO CORRECT LEVEL
	MOVE D,SAVPTR
	MOVEM A,FDBCHK(D)	;STORE ERROR CODE FOR PRINT LATER
	AOS ERRCN1
	AOS ERRCN2		;COUNT ERROR
DSKRC2:	MOVE D,SAVPTR
	SETO A,
	MOVE B,[.FHSLF,,<CHKBUF>B44]
	SETZ C,
	PMAP			;RELEASE PAGE FROM MAP
	MOVE A,CHKCN0
	MOVEM A,FDBSUM(D)	;STORE CHECKSUM
	SETZM EOFDSP
	SETZM DATDSP
	SETZM ILIDSP
	HRRO A,@INIFH1
	CLOSF			;LOT GO OF FILE, BUT NOT JFN
	 CALL JERR		;SHOULD BE ABLE TO LET GO
DSKRNC:	HRROI A,FDBLEN(D)	;CREATE STRING POINTER PAST FDB AND CHECKSUM INFO
	HRRM A,.FBCTL(D)	;NAME POINTER TO FDB
	HRRZ B,@INIFH1		;JFN
	MOVX C,FLD(.JSAOF,JS%NAM) ;FORMAT
	TXNE Q2,SOF		;"NO FILES"
	JRST DSK1		;YES, SO DON'T WASTE TIME DOING JFNS
	TXNE Q2,COMPLN		;COMPLETE SUBCOMMAND GIVEN?
	JRST [TXO Q2,SMVF!SNEF	;YES, TURN ON MORE NEEDED FLAGS
	     MOVX C,JS%DEV!JS%DIR!JS%NAM!JS%PAF	;TURN ON FLAGS FOR JFNS
	     JRST .+1]		;CONTINUE ON OUR MERRY WAY
	JFNS			;GET NAME STRING
	 ERCAL JERRE

DSK1:	TXNE Z,MTAF		;IS THIS A TAPE?
	JRST [	PUSH P,A	;SAVE START
		HRROI A,2(A)	;YES. GET A PLACE TO STORE VERSION
		MOVX C,FLD(.JSAOF,JS%GEN)
		JFNS		;GET VERSION
		 ERJMP [POP P,A	;FAILED. CLEAN UP STACK
			JRST .+1] ;AND DONE
		POP P,A		;GET BACK SP
		HRROI A,2(A)	;GET POINTER TO VERSION
		MOVEI C,^D10	;GET IT AS DECIMAL
		NIN		;DO IT
		 ERJMP .+1	;IF FAILED, GIVE UP
		HRLM B,.FBGEN(D) ;SAVE VERSION IN "FDB"
		JRST .+1]	;AND PROCEED
	HRRZ B,@INIFH1		;GET JFN AGAIN
	HRROI A,2(A)		;STRING POINTER TO BEGINNING OF NEXT WORD TO USE
				;LEAVES A 0 WORD TO TERMINATE
				;STRING FOR SORT.
	HRLM A,.FBEXL(D)	;EXT PTR TO FDB
	MOVX C,FLD(.JSAOF,JS%TYP)
	TXNE Q2,SOF		;"NO FILES"?
	JRST DSK2		;YES, SO DON'T BOTHER READING EXTENSION
	JFNS			;EXTENSION STRING
	 ERCAL JERRE
DSK2:	MOVE B,.FBACT(D)	;ACCOUNT
	JUMPLE B,DSKR2B		;NUMERIC OR MISSING
	HRROI A,2(A)
	HRRZM A,.FBACT(D)
	HRRZ B,@INIFH1
	MOVX C,FLD(.JSAOF,JS%ACT)
	TRNN P2,ACCF		;"ACCOUNT"?
	JRST DSK3		;NO, SO DON'T BOTHER GETTING IT
	JFNS			;GET ACCOUNT STRING
	 ERCAL JERRE
DSK3:
DSKR2B:	HRROI B,2(A)		;POINTER TO STORE LAST WRITER'S NAME
	HRLM B,.FBUSE(D)	;REMEMBER WHERE NAME GETS STORED
	TXNN Q2,UWRF		;"USER (WHO LAST) WROTE"?
	JRST DSK5		;NO, SO DON'T GET IT
	MOVE A,@INIFH1		;FILE TO GET LAST WRITER OF
	HRLI A,.GFLWR		;SPECIFY WE WANT LAST WRITER
	HLRO B,.FBUSE(D)	;SAY WHERE IT GOES IN MEMORY
	GFUST
	 ERCAL [HRROI A,[ASCIZ /?Unknown/]
		HLRO B,.FBUSE(D) ;USE "UNKNOWN" IF CAN'T GET AUTHOR
		MOVEI C,0
		SIN
		RET]
DSK5:	HRROI B,2(B)		;GET POINTER FOR STORING AUTHOR
	HRRM B,.FBUSE(D)	;REMEMBER WHERE AUTHOR IS STORED
	TXNN Q2,UCREF		;"USER (WHO LAST) CREATED"?
	JRST DSK6		;NO, SO DON'T GET IT
	MOVE A,@INIFH1		;FILE TO GET LAST CREATOR OF
	HRLI A,.GFAUT		;SPECIFY WE WANT AUTHOR
	HRRO B,.FBUSE(D)	;TELL MONITOR WHERE TO PUT IT
	GFUST
	 ERCAL [HRROI A,[ASCIZ /?Unknown/]
		HRRO B,.FBUSE(D) ;USE "UNKNOWN" IF CAN'T GET AUTHOR
		MOVEI C,0
		SIN
		RET]
DSK6:
	MOVEI C,2(B)		;WHERE TO STORE NEXT FDB
				;AGAIN LEAVING A 0 WORD POINTER
	MOVE A,C		;GET START OF NEW FDB
	SUB A,D			;COMPUTE LENGTH OF ONE WE'RE FINISHING
	MOVEM A,FDBRLN(D)	;STORE REAL LENGTH
	TXNN Z,DECF
	JRST DSKR5

;PRESERVE THESE ACS

	PUSH P,P1
	PUSH P,P2
	PUSH P,P3
	PUSH P,P4
	PUSH P,P5

;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 P1,-^D22
				;CONVERT NAME AND EXT FROM "FDB" TO SIXBIT IN P2, CC.
				;CLOBBERS P2-FF.
	HRLI P5,<POINT 7,0,-1>B53 ;NAME
	HRR P5,.FBCTL(D)
	MOVEI P4,6
DTADRN:	ILDB P3,P5		;NAME CHAR LOOP
	SKIPE P3
	 SUBI P3,40
	LSH P3,36
	LSHC P2,6
	SOJG P4,DTADRN
	HRLI P5,<POINT 7,0,-1>B53 ;EXTENSION
	HLR P5,.FBEXL(D)
	MOVEI P4,3
DTADRE:	ILDB B,P5		;EXT CHAR LOOP
	SKIPE B
	 SUBI B,40
	LSH P3,6		;MAKE ROOM FOR NEXT CHAR
	DPB B,[POINT 6,P3,35]	;BUILD SIXBIT EXT IN P3
	SOJG P4,DTADRE
DTADR1:	CAME P2,DTADRC+^D83(P1)
	JRST DTADR9		;WRONG NAME
	HRLZ B,P3		;XWD EXT,0 FROM "FDB"
	XOR B,DTADRC+^D105(P1)	;COMPARE EXT, PICK UP DATE FROM DTADRC
	TLNE B,-1
	JRST DTADR9		;WRONG EXT
	DPB B,[POINT 12,.FBWRT(D),35] ;DATE TO "FDB"

;COPY EXTRA BITS FOR DATE75

	LDB B,[POINT 1,DTADRC+0(P1),35]
	DPB B,[POINT 1,.FBWRT(D),23]
	LDB B,[POINT 1,DTADRC+^D22(P1),35]
	DPB B,[POINT 1,.FBWRT(D),22]
	LDB B,[POINT 1,DTADRC+^D44(P1),35]
	DPB B,[POINT 1,.FBWRT(D),21]
	HRRZ B,DTATBL+1(P1)
	HRRM B,.FBBYV(D)	;SIZE IN BLOCKS
	JRST DTADR8

DTADR9:	AOBJN P1,DTADR1		;IF NOT FOUND LEAVE THINGS 0

DTADR8:	POP P,P5
	POP P,P4
	POP P,P3
	POP P,P2
	POP P,P1
;DSKDIR... READ...
;MAKE TABLE ENTRY

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

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

DSKR7:	MOVE A,@INIFH1
	TXNN Q2,INVFO+ARFO	;DOING INVISIBLE OR ARCHIVED FILES?
	 TXO A,GJ%GIV		;NO, DON'T LET GNJFN FIND THEM
	TLNE A,<77B5>B53	;IF NO *-FLAGS SKIP GNJFN AND ITS BUGS
	CALL GNJFS		;STEP TO NEXT FILE
	JRST [	CALL FNDFIX	;CHECK FOR "FIND"
		JRST DSKR9]	;NO MORE,DONE READING
				;THIS ASSUMES GNJFN DOES RETURN
				;"WHAT CHANGED" BITS.
	TLNE A,76		;DEV, DIR, NAME, EXT CHANGE?
	CALL FNDFIX		;YES, CHECK FOR "FIND"
	TXNE A,GN%STR!GN%DIR	;STRUCTURE OR DIRECTORY CHANGED?
	TXO Z,PDNF		;SAY DIRECTORY CHANGED
	SKIPE KEPDNM		;"FIND" SUBCOMMAND?
	JRST DSKR10		;YES, BUFFER THE SPECS
	TXNN Z,SORTF		;USER ASK FOR SORTING?
	TXNE Z,REVF		;IF REVERSE ALPHABETIC, BUFFER IT
	CAIA			;BUFFER IT, SINCE SORTING NEEDED
	JRST DSKR8		;NO, PRINT NOW INSTEAD OF BUFFERING
DSKR10:	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 P4,[POINT 9,TABLE,8] ;PUT "REVERSE" POINTER
				;TO LAST ENTRY IN DUMMY ENTRY 0.
				;USED FOR REVERSE UNSORTED LISTING.
	MOVEM P4,TABLNX		;REMEMBER REAL TABLE LENGTH
	TXNN Z,SORTF		;ANY ORDER-OF-PRINTOUT FLAGS ON?
	JRST DSKP		;NO, NO SORT REQUIRED, GO PRINT
	TXNE Z,ALPHAF		;SORTING ALPHABETICALLY?
	TXNN Z,DSKF		;ALPHABETIC AND DISK DIRECTORY?
	CAIA			;OTHER THAN ALPHABETIC, OR NOT DISK, SO SORT.
	JRST DSKP		;ALREADY SORTED BY MONITOR IF DISK AND ALPHABETIC
;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 P4,0		;INDEX OF CURRENT (LAST INSERTED)
				;SORTED TABLE ENTRY
	MOVEI P1,1		;INDEX INTO UNSORTED TABLE

;TOP OF LOOP

DSKS1:	CAMLE P1,TABLNX		;SEE IF WE'VE SCANNED ENTIRE TABLE
	JRST DSKP		;NO MORE TO SORT, GO PRINT
	CALL FDBSC		;COMPARE ENTRY (P4) TO (P1),3 RETURNS
	JRST LESS		;UNSORTED ENTRY (P4) LESS
	JRST HERE		;EQUAL
				;GREATER

;UNSORTED ENTRY GREATER, SEARCH FORWARD

GRATR:	LDB P4,[POINT 9,TABLE(P4),17] ;GET FWD PTR
	CALL FDBSC		;COMPARE AGAIN
	 JRST GRATR1		;LESS
	 JRST GRATR1		;EQUAL OR AT END OF TABLE
	JRST GRATR		;GREATER, KEEP SEARCHING
				;LESS OR EQUAL, PUT IT BEFORE THIS ONE
GRATR1:	LDB P4,[POINT 9,TABLE(P4),8] ;BACK UP 1
	JRST HERE		;PUT IT AFTER THIS ONE

;UNSORTED ENTRY LESS, SEARCH BACKWARD

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

;INSERT ENTRY AFTER CURRENT ENTRY BY UPDATING LIST POINTERS

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

FDBSC:	HRRZ Q1,TABLE(P4)	;Q1 POINTS TO FIRST FDB
	HRRZ Q3,TABLE(P1)	;Q3 TO SECOND
	JUMPE Q1,FDBEQ		;NULL, RETURN AS THOUGH EQUAL.
	TXNN Z,ALPHAF
	JRST FDBSC2

;ALPHABETIC COMPARISON.

				;COMPARE NAMES
	HRRZ A,.FBCTL(Q1)	;NAME PTRS
	HRRZ B,.FBCTL(Q3)
	CALL FDBSTC		;STRING COMPARE RETURNS HERE
				;ONLY IF EQUAL.
				;NAMES =, COMPARE EXTENSIONS
	HLRZ A,.FBEXL(Q1)
	HLRZ B,.FBEXL(Q3)
	CALL FDBSTC
				;=, COMPARE VERSIONS
	HLRZ A,.FBGEN(Q1)
	HLRZ B,.FBGEN(Q3)
	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:	TXNN Z,CHTPF		;TAPE-WRITE
	 JRST FDBSC4
	MOVE A,.FBTDT(Q1)
	MOVE B,.FBTDT(Q3)
	JRST FDBSC3

FDBSC4:	TRNN Z,1B31
	 JRST FDBSC5
	MOVE A,.FBWRT(Q1)	;WRITE
	MOVE B,.FBWRT(Q3)
	JRST FDBSC3

FDBSC5:	TXNN Z,CHRDF		;CHRONOLOGICAL BY READ?
	 JRST FDBSC6
	MOVE A,.FBREF(Q1)	;READ
	MOVE B,.FBREF(Q3)
	JRST FDBSC3

FDBSC6:	TXNN Z,CHCRF		;CHRONO BY CREATION?
	JRST FDBGR		;NO SORTING SPECIFIED (IE DIRECTORY ORDER).
				;TREAT AS THO GREATER.  NOTE THAT "REVERSE"
				;STILL WORKS.
				;THIS IS WHERE TO ADD CASES
	MOVE A,.FBCRV(Q1)	;CREATE
	MOVE B,.FBCRV(Q3)
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,[XWD 1,1]	;FORGET RETURN
		JRST FDBLS]
	SUB P,[XWD 1,1]
	JRST FDBGR
;FNDFIX
;DECREASE NUMBER OF ENTRIES BY KEPDNM
;BUT ONLY BACK TO FNDPTR
FNDFIX:	SKIPN KEPDNM		;IGNORING ANY?
	RET			;NO, NO-OP
	SUB P4,KEPDNM		;REMOVE N HIGHEST NUMBERED VERSIONS
	CAMGE P4,FNDPTR		;BACKUP TOO FAR?
	MOVE P4,FNDPTR		;YES, ONLY REMOVE THIS FILE
	MOVEM P4,FNDPTR		;RESET FNDPTR
	PUSH P,A
	SETZ A,
	DPB A,[POINT 9,TABLE(P4),17] ;CLEAR FORWARD POINTER
	POP P,A
	RET
;DSKDIR...
;PRINT DISK DIRECTORY

DSKP:	MOVEI P4,0		;P4 IS TABLE POINTER
				;WORD TABLE+0 IS A DUMMY,
				;NOT TO BE LISTED
DSKP1:	TXNN Z,REVF		;SKIP IF REVERSE ORDER
	LDB P4,[POINT 9,TABLE(P4),17] ;FWD POINTER
	TXNE Z,REVF		;SKIP IF NORMAL ORDER
	LDB P4,[POINT 9,TABLE(P4),8] ;REVERSE PTR
	HRRZ Q3,TABLE(P4)	;FDB PTR FROM TABLE ENTRY
	JUMPE Q3,DSKP4		;0 MEANS END
	CALL COUNTF		;DO COUNTING
	TXNN Q2,SOF		;SKIP PRINT IF "NO FILE-LINES".
	CALL DFILE		;LIST THIS ENTRY
	JRST DSKP1

DSKP4:	RET			;RETURN FROM DSKDIR
;COUNTF
;COUNT AND CHECKSUM FILE, ADD TO SUMMARY CELLS

COUNTF:	HRRZ A,.FBBYV(Q3)	;GET SIZE IN PAGES OR BLOCKS
	TXNE Z,DECF		;DTA?
	JRST COUNT1		;YES, DO BLOCKS
	SKIPGE DIRCN1
	SETZM DIRCN1
	SKIPGE DIRCN2
	SETZM DIRCN2
	ADDM A,DIRCN1
	ADDM A,DIRCN2
	JRST COUNT2

COUNT1:	SKIPGE BLKCN1
	SETZM BLKCN1
	SKIPGE BLKCN2
	SETZM BLKCN2
	ADDM A,BLKCN1
	ADDM A,BLKCN2
COUNT2:	AOS FILCN1		;COUNT ANOTHER FILE
	AOS FILCN2
	MOVE A,.FBCTL(Q3)	;GET FILE BITS
	TXNN	A,FB%BAT	;BAD BLOCKS IN FILE?
	RET			;NO, RETURN
	AOS BATCN1		;YES, COUNT FILE
	AOS BATCN2
	RET
;DFILE
;LIST ONE FILE
;TAKES:
;	P2: WHAT FIELDS TO PRINT BITS -- SAME AS JFNS'S EXCEPT
;	   COMBINATIONS NOT PRODUCED BY "DIRECTORY" COMMAND AREN'T
;	   NECESSARILY HANDLED.
;	   AND ALSO: B26 (PLBF): PRINT LENGTH IN BYTES.
;		     B27 (PCTF)-30: CREATE, WRITE, READ, TAPE WRITE TIMES (IMPLYING DATES)
;		     B32: SUPPRESS COLUMNATION
;	Q2: SMVF: DON'T PUT MULTIPLE VERSIONS OF SAME NAME.EXT
;		ON SAME LINE
;	   SNEF: 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
;	Q3: POINTER TO FDB

; DCNT IS USED TO KEEP TRACK OF THE POSITION ON THE LINE.  IT HAS A VALUE
; WHICH IS A NUMBER OF SPACES RELATIVE TO WHERE YOU WANT TO BE.  I.E.
; POSITIVE MEANS THAT FILL IS NEEDED, AND NEGATIVE MEANS THAT YOU
; ARE TOO FAR BECAUSE ONE OR MORE FIELDS HAS OVERFLOWED.

;EACH LINE UP THROUGH THE EXTENSION MUST TAKE AT LEAST 3 SPACES--I.E.
;THE LEADING BLANK, ONE SPACE FOR THE NAME, AND THE DOT BEFORE
;THE EXTENSION.  IF THE NAME IS NOT BEING PRINTED BECAUSE IT IS
;THE SAME AS THE PREVIOUS LINE, 3 LEADING BLANKS ARE USED.  IF
;THE NAME AND EXTENSION ARE NOT BEING PRINTED BECAUSE BOTH ARE THE
;SAME AS THE PREVIOUS LINE, 6 LEADING BLANKS ARE USED.
;DFILE

DFILE:	SETZM DCNT		;NO FIELDS HAVE EXCEEDED MIN WIDTH YET

;NAME, EXTENSION, VERSION

	HRRZ B,.FBCTL(Q3)	;NAME

;IF NAME IS SAME AS THAT LAST PRINTED, JUST PRINT 3 SPACES.

	TXNE Q2,SNEF
	JRST DFL03A		;FLAG SUPPRESSES COMPACT FORMAT
	SKIPE C,LPNAME		;LAST NAME PRINTED. TREAT NONE AS "DIFFERENT".
	CALL DCMPR		;COMPARE CURRENT NAME TO LAST PRINTED
	 JRST DFL03A		;DIFFERENT, PRINT IT.
	HLRZ B,.FBEXL(Q3)
	SKIPE C,LPEXT
	CALL DCMPR		;NAME IS SAME, IS EXT SAME ALSO?
	 JRST [	CALL DFREST	;FINISH PREVIOUS LINE, IF ANY.
		CALL BATSPC	;TYPE "*" OR " "
		MOVE B,[POINT 7,[ASCIZ /  /],-1] ;NAME SAME, EXT DIFF
		AOS DCNT
		JRST 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.

	TXNE Q2,SMVF
	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,
	SOJ D,
	MOVEM D,DCNT
	JRST 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
	MOVEI D,^D3		;ACCOUNT FOR THE 3 MINIMUM SPACES
	MOVEM D,DCNT
	CALL BATSPC		;TYPE "*" OR " "
	HRROI B,[ASCIZ /     /] ;BUT INDENT 6 SPACES IF NO NAME.EXT
	CALL DFILL		;SPACES(S) IN PLACE OF NAME.EXT
	JRST DFL05		;GO PRINT VERSION
;ROUTINE USED BY DFILE TO RELEASE STORAGE USED BY PREVIOUSLY REMEMBERED
;STRING, AND STORE NEW ONE.
;
;ACCEPTS:	A/	NEW STRING POINTER
;		B/	LOCATION HOLDING POINTER TO OLD STRING
;
;RETURNS:	+1	WITH OLD STRING RELEASED, AND NEW STRING STORED

DFL:	MOVEM A,NEWPTR		;REMEMBER POINTER TO NEW STRING
	MOVEM B,CELADR		;REMEMBER WHERE NEW POINTER GOES
	SKIPN A,@CELADR		;ANY OLD POINTER?
	JRST DFL1		;NO
	CALL STREM		;YES, RELEASE STORAGE
DFL1:	MOVE A,NEWPTR		;GET POINTER TO NEW STRING
	CALL BUFFS		;BUFFER IT UP
	MOVEM A,@CELADR		;REMEMBER NEW POINTER
	RET

;ROUTINE TO FLUSH FDB POINTED TO BY LPFDB IF LPFDB IS NON-ZERO.
;LPFDB IS CLEARED TO SHOW THAT ITS FDB HAS BEEN FLUSHED.

FLSFDB:	SKIPN B,LPFDB		;ANYTHING TO FLUSH?
	RET			;NO
	MOVE A,FDBRLN(B)	;YES, SAY HOW MANY WORDS TO FLUSH
	SETZM LPFDB		;SAY FDB IS FLUSHED
	CALLRET RETBUF		;RETURN ITS SPACE TO FREE POOL AND RETURN.
;DFILE...
;PRINT NAME

DFL03A:	CALL DFREST		;PRINT REST OF PREVIOUS LINE, IF ANY
	AOS DCNT
	CALL BATSPC		;TYPE "*" OR " "
	HRRO A,.FBCTL(Q3)	;NAME BLOCK RELATIVE LOCATION
	MOVEI B,LPNAME		;RELEASE PREVIOUS NAME SINCE THEY MAY USE UP STORAGE
	CALL DFL		;REMEMBER LAST NAME PRINTED
	MOVE B,LPNAME
DFL03B:	AOS DCNT		;USE 1 COLUMNS MINIMUM
	CALL DFILL		;PRINT NAME OR SPACES

;PRINT EXTENSION

	HLRO A,.FBEXL(Q3)	;EXT
	MOVEI B,LPEXT
	CALL DFL		;REMEMBER LAST EXTENSION (FILE TYPE)
	PRINT "."
	MOVE B,LPEXT
	CALL DFILL		;OUTPUT EXTENSION

;PRINT FIRST VERSION ON LINE

DFL05:	MOVEI B,"."
DFL05A:	TXNE Z,DECF		;NO GENERATION FOR DECTAPE
	 JRST DFL05B
	PRINT @B		;ADDITIONAL VERSION ON SAME LINE JOINS HERE
	HLRZ B,.FBGEN(Q3)	;VERSION
	MOVEI C,^D10
	CALL DFNOUT		;NOUT AND KEEP TRACK OF COLS USED.
DFL05B:	CALL FLSFDB		;FLUSH PREVIOUS SAVED FDB
	MOVE A,FDBRLN(Q3)	;GET REAL LENGTH OF FDB BEING SAVED
	CALL GETBUF		;ALLOCATE A BUFFER FOR STORING NEW FDB
	MOVE C,Q3		;GET OLD ADDRESS
	SUB C,A			;GET AMOUNT TO BE SUBTRACTED FROM STRING ADDRESS OFFSETS
	MOVEM A,LPFDB		;REMEMBER ADDRESS OF SAVED FDB
	MOVE B,FDBRLN(Q3)	;GET LENGTH OF FDB BEING MOVED
	ADDI B,-1(A)		;COMPUTE LAST WORD TO BE STORED INTO
	HRL A,Q3		;MAKE BLT POINTER FOR SAVING FDB
	BLT A,(B)		;COPY THE FDB
	MOVE A,LPFDB		;GET NEW LOCATION OF THE FDB
	HRRZ B,.FBCTL(A)	;GET OLD POINTER TO NAME
	SUB B,C			;FIX IT DUE TO NEW FDB LOCATION
	HRRM B,.FBCTL(A)
	HLRZ B,.FBEXT(A)	;FIX FILE TYPE POINTER
	SUB B,C
	HRLM B,.FBEXT(A)
	HRRZ B,.FBACT(A)	;ACCOUNT
	SUB B,C
	HRRM B,.FBACT(A)
	HLRZ B,.FBUSE(A)	;AUTHOR
	SUB B,C
	HRLM B,.FBUSE(A)
	HRRZ B,.FBUSE(A)	;WRITER
	SUB B,C
	HRRM B,.FBUSE(A)
	MOVE D,DCNT
	MOVEM D,LFPOS		;LINE "POSITION" (- # COLS OV) ALSO
	RET
;PRINTING OF ADDITIONAL FIELDS FOR THIS NAME.EXT;VERSION IS DEFERRED
; SO THAT ADDITIONAL VERSION NUMBERS MAY BE PRINTED HERE,
; SEPARATED BY COMMAS.

BATSPC:	MOVE B,.FBCTL(Q3)
	TXNE	B,FB%BAT
	SKIPA B,["*"]
	MOVEI B," "
	PRINT @B
	SOS DCNT
	RET
;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"
;	Q1,Q2:	AS FOR "DFILE" ABOVE.
;RETURNS: LPFDB 0, B,C CLOBBERED, D-Q3 PRESERVED.

DFREST:	SKIPN LPFDB
	RET			;NOTHING TO PRINT REST OF, RETURN.
	MOVEM Q3,SAVQ3
	MOVE A,DCNT
	MOVEM A,SVDCNT		;SAVE OLD COLUMN
	MOVE Q3,LPFDB		;LOCATION OF FDB
	MOVE D,LFPOS		;LINE OVERFLOW SITUATION
	MOVEM D,DCNT

;PROTECTION

	TXNN P2,PPF
	JRST DFR07		;PRINTING PROTECTION NOT REQUESTED
	TYPE <;P>
	LDB B,[POINT 3,.FBPRT(Q3),2] ;LEFT HALF OF PROTECTION WORD
	CAIE B,5		;5 MEANS 33-BIT OCTAL IN REST OF WORD
	JRST DFR06A		;ANYTHING ELSE IS MAGIC
	MOVE B,.FBPRT(Q3)
	TLZ B,700000
	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 P2,ACCF
	JRST DFR08
	TYPE <;A>
	MOVE B,.FBACT(Q3)
	JUMPL B,DFR07A
				;STRING ACCOUNT
	SKIPN .FBACT(Q3)	;"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
DFR07A:	TLZ B,700000		;NUMERICAL ACCT: CLEAR HI BITS.
	MOVEI C,^D10		;DECIMAL
	CALL DFNOUT		;NOUT AND KEEP TRACK OF CHARACTERS OUTPUT

; ;T: ALWAYS PRINTED IF FILE IS TEMPORARY.

DFR08:	MOVE B,.FBCTL(Q3)	;CONTROL BITS
	TXNN	B,FB%TMP	;IS FILE TEMP?
	JRST DFR86
	HRROI B,[ASCIZ /;T/]
	CALL DFILL		;SOUT AND KEEP TRACK OF COLUMNS

DFR86:	MOVE B,.FBCTL(Q3)
	TXNN B,FB%OFF		;OFFLINE?
	 JRST DFR09		;NYET
	HRROI B,[ASCIZ /;OFFLINE/]
	CALL DFILL
;DFREST...

DFR09:	TXNN P2,SIZPF+DCREF+DWRF+DRDF+PLBF+PCTF+PWTF+PRTF+PTDF+POEF+POETF+PONETF+PONEF+PTWF ;ANYTHING MORE TO PRINT?
	TXNE Q2,CHKF+UCREF+UWRF+RETF
	CAIA
	JRST DFR13		;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.

	TXNN P2,SCF		;NEVER AN EOL IF COLUMNATION SUPPRESSED
	MOVE D,DCNT
	CAML D,[-35]		;TO MUCH LINE OVERFLOW?
	JRST DFR09A		;OK

;-35 WAS CHOSEN BECUASE IT IS ONE CHARACTER SHORT OF PUSHING
;DATES CLEAR INTO NEXT COLUMN WHEN ;A AND ;P ARE PRESENT.

	ETYPE <%_>
	CALL DINDNT		;INDENT THE RIGHT AMOUNT ON NEW LINE
	SETZM DCNT		;NO LINE OVERFLOW NOW
	JRST DFR09C

DFR09A:	HRROI B,[ASCIZ / /]	;THE ONE SPACE
	MOVEI D,14+XTRAS	;RAISED FROM 14 WHEN ";OFFLINE" ADDED
	TXNE Z,DECF		;FOR DECTAPE
	 SUBI D,2		;2 LESS
	ADDM D,DCNT
	MOVEI D,6		;ANOTHER TAB STOP FOR PROT
	TXNE P2,PPF
	ADDM D,DCNT
	TRNE P2,ACCF
	ADDM D,DCNT		;ACCT LIKEWISE (";A" AND ";P NOT COUNTED IND)
	CALL DFILL		;SOUT AND ADD SPACES

;SIZE IN PAGES OR DECTAPE BLOCKS

DFR09C:	TXNN P2,SIZPF
	JRST DFR09D
	HRRZ B,.FBBYV(Q3)	;SIZE IN PAGES
	MOVEI C,^D10		;DECIMAL
	CAIGE B,^D1000		;WILL FIT IN 3 COLS?
	HRLI C,(1B2+3B17)	;YES, RIGHT JUSTIFY IT
	MOVEI D,3		;3 COLS MIN WIDTH, LESS PRECEDING OVERFLOW
	ADDM D,DCNT
	CALL DFNOUT		;NOUT WITH FANCY COLUMNATION
	PRINT " "
;LENGTH IN BYTES: PRINT "LENGTH(SIZE)"

DFR09D:	TXNN P2,PLBF
	JRST DFR10A
	MOVE B,.FBSIZ(Q3)
	MOVEI C,^D10		;DECIMAL
	CALL DFNOUT		;NO COLUMNATION YET
	PRINT "("
	LDB	B,[POINTR (<.FBBYV(Q3)>,FB%BSZ)] ;BYTE SIZE
	MOVEI C,^D10
	CALL DFNOUT
	PRINT ")"
	HRROI B,[ASCIZ / /]	;NOW A SEPERATING SPACE, PLUS ENOUGH MORE
	MOVEI D,^D9		;SO "SIZE(LENGTH)" TAKES UP 10 COLS,
	ADDM D,DCNT
	CALL DFILL		;( 10 - ()'S+" "=9), LESS EXCESS USED BY NAME.
DFR10A:	TXNN Q2,RETF
	JRST DFR10B
	LDB	B,[POINTR (<.FBBYV(Q3)>,FB%RET)] ;GEN RET COUNT
	MOVEI C,^D10		;DECIMAL
	TXNN P2,SCF		;COLUMNATING?
	HRLI C,(1B2+3B17)	;YES, RIGHT JUSTIFY IT
	MOVEI D,3		;3 COLS MIN WIDTH, LESS PRECEDING OVERFLOW
	ADDM D,DCNT
	CALL DFNOUT		;NOUT WITH FANCY COLUMNATION
	PRINT " "
;DFREST...
;THE VARIOUS DATES AND TIMES

DFR10B:	SETZ C,			;DATE AND TIME FORMAT: DD-MMM-YY HH:MM:SS
	TXNE P2,SCF		;SUPPRESS COLUMNATION?
	TXO C,OT%SCL		;SUPPRESS COLUMNATION.
	MOVEM C,TFORMT		;REMEMBER ODTIM FORMAT FLAGS
	TXNN P2,DCREF+PCTF
	JRST DFR11
	TXNN P2,PCTF		;TIME TO BE INCLUDED?
	TXO C,OT%NTM		;NO, EXCLUDE IT
	SKIPN B,.FBCRV(Q3)	;VERSION CREATION DATE & TIME
	JRST [	CALL TNEVER
		JRST DFR11]
	CALL DOOTIM		;PRINT DATE AND MAYBE TIME.
DFR11:	TXNN P2,DWRF+PWTF
	JRST DFR12
	TXZ C,OT%NTM
	TXNN P2,PWTF
	TXO C,OT%NTM
	MOVE B,.FBWRT(Q3)	;WRITE DATE
	TXNE Z,DECF
	JRST [	CALL DTADAT	;PRINT DECTAPE FORMAT DATE
		PRINT " "
		JRST DFR12]
	JUMPE B,[CALL TNEVER
		JRST DFR12]
	CALL DOOTIM
DFR12:	TXNN P2,DRDF+PRTF
	JRST DFR120
	TXZ C,OT%NTM
	TXNN P2,PRTF
	TXO C,OT%NTM
	SKIPN B,.FBREF(Q3)	;LAST REFERENCE (NON-WRITE) DATE
	JRST [	CALL TNEVER
		JRST DFR120]
	CALL DOOTIM
DFR120:	TXNN P2,PTDF+PTWF
	 JRST DFR129
	TXZ C,OT%NTM		;NO TIME
	TXNN P2,PTWF
	TXO C,OT%NTM		;INCLUDE THE TIME
	SKIPN B,.FBTDT(Q3)	;TAPE WRITE T&D
	 JRST [	CALL TNEVER
		JRST DFR129]
	CALL DOOTIM
DFR129:	TXNN P2,PONEF!PONETF	;PRINT ONLINE EXPIRATION?
	JRST DFR130		;NO
	SKIPN B,.FBNET(Q3)	;YES, GET IT
	JRST [	CALL DFNONE	;THERE ISN'T ONE
		JRST DFR130]
	MOVX C,FB%OFF		;IS THE FILE OFFLINE?
	TDNE C,.FBCTL(Q3)
	JRST [	MOVE A,ONMESL	;GET CORRECT WIDTH
		CALL DFNA	;YES, ONLINE EXP N/A
		JRST DFR130]
	MOVE C,.FBCRE(Q3)	;FIND THE NEWEST DATE
	CAMGE C,.FBCRV(Q3)
	MOVE C,.FBCRV(Q3)
	CAMGE C,.FBWRT(Q3)
	MOVE C,.FBWRT(Q3)
	CAMGE C,.FBREF(Q3)
	MOVE C,.FBREF(Q3)
	TLNN B,-1		;INTERVAL?
	JRST [	HRLZS B		;PUT # DAYS IN DAYS PORTION OF D&T
		ADD B,C		;ADD IN MOST RECENT DATE & TIME
		JRST .+1]
	MOVE C,TFORMT		;GET FORMAT FLAGS
	TXNN P2,PONETF
	TXO C,OT%NTM		;INCLUDE THE TIME
	MOVE A,ONMESL		;GET CORRECT WIDTH
	CALL DFTIM		;PRINT DATE OR DATE-TIME
DFR130:	TXNN P2,POEF!POETF	;WANT OFFLINE EXP DATE?
	JRST DFR131		;NO
	SKIPN B,.FBFET(Q3)	;PICK UP THE OFF EXP DATE/INTERVAL
	JRST [	CALL DFNONE	;THERE IS NONE
		JRST DFR131]
	SKIPN C,.FBTDT(Q3)	;GET TIME WRITTEN TO TAPE
	JRST [	MOVE A,OFMESL	;GET CORRECT WIDTH
		CALL DFNA	;NOT ON TAPE YET, N/A
		JRST DFR131]
	TLNN B,-1		;INTERVAL?
	JRST [ HRLZS B
		ADD B,C		;ADD # DAYS TO DAY PART
		JRST .+1]
	MOVE C,TFORMT		;GET ODTIM FORMAT FLAGS
	TXNN P2,POETF
	TXO C,OT%NTM		;INCLUDE THE TIME
	MOVE A,OFMESL		;GET LENGTH OF OFF-LINE HEADER MESSAGE
	CALL DFTIM		;PRINT DATE OR DATE-TIME
DFR131:	TXNN Q2,UCREF		;CREATE DIR?
	JRST DFR12B
	HRRO B,.FBUSE(Q3)
	CALL DFRDIR
DFR12B:	TXNN Q2,UWRF
	JRST DFR12Z
	HLRO B,.FBUSE(Q3)
	CALL DFRDIR
DFR12Z:	TXNN Q2,CHKF		;CHECKSUM
	JRST DFR13		;NO
	SKIPLE B,FDBCHK(Q3)	;GET CHECKSUM CODE
	JRST [	ETYPE <%2?>
		JRST DFR121]
	CAMN B,[-2]		;FLAG FOR DATA ERROR
	JRST DFR12E
	HLRZ B,FDBSUM(Q3)
	HRRZ C,FDBSUM(Q3)
	ADD C,B
	HLRZ B,C
	ADDI B,(C)
	MOVE C,[1B0+1B2+1B3+6B17+10]
	MOVEI D,7
	ADDM D,DCNT
	CALL DFNOUT
	MOVEI B," "
	SKIPGE FDBCHK(Q3)
	MOVEI B,"P"
	PRINT @B
	JRST DFR121

;ROUTINE CALLED FROM ABOVE TO OUTPUT VARIOUS FORMATS OF DATE AND TIME

DOOTIM:	MOVE A,CSBUFP		;GET SOME STRING SPACE
	ODTIM			;MAKE THE STRING
	MOVE A,CSBUFP
	ETYPE <%1M >		;PUT STRING IN OUTPUT BUFFER
	RET
DFR12E:	TYPE <Data error in file>
DFR121:

;EOL AND EXIT

DFR13:	ETYPE <%_>
	TLNE Q2,2		;DOUBLE-SPACE?
	ETYPE <%_>		;YES, ANOTHER EOL.
	MOVE A,SVDCNT
	MOVEM A,DCNT
	MOVE Q3,SAVQ3
	CALLRET FLSFDB		;THROW AWAY FDB SO IT ISN'T LISTED AGAIN

TNEVER:	HRROI B,[ASCIZ/Never              /]
	TXNE C,OT%NTM
	HRROI B,[ASCIZ/Never     /]
	TXNE C,OT%SCL
	HRROI B,[ASCIZ/Never /]
	ETYPE <%2M>
	RET

DFRDIR:	MOVEI D,9
	ADDM D,DCNT
	CALL DFILL
	PRINT " "
	RET

DFNA:	ADDM A,DCNT
	HRROI B,[ASCIZ \N/A\]
	CALL DFILL		;PRINT STRING AND FILL
	PRINT " "		;AT LEAST ONE SPACE
	RET

DFNONE:	HRROI B,[ASCIZ /None               /]
	ETYPE <%2M>
	RET
;SUBROUTINE DTADAT: PRINTS DECTAPE FORMAT DATE FROM B.
;USED IN DFREST, OLDTAD.
;TAKES: B: DATE. CLOBBERS A,C,D.

DTADAT:	ATSAVE
	PUSH P,Q1
	MOVEI D,ILIDAT		;TRAP FOR ILLEGAL DATE
	MOVEM D,ILIDSP
	MOVE D,B
	IDIVI D,^D31
	HRLZ C,Q1		;DAY OF MONTH
	IDIVI D,^D12
	HRR B,Q1		;MONTH
	HRLI B,^D1964(D)	;YEAR
	MOVX Q1,OT%NTM		;SUPPRESS TIME
	MOVE A,CSBUFP		;STORE STRING HERE
	ODTNC			;OUTPUT DATE WITHOUT CONVERSION FROM INTERNAL
	SETZM ILIDSP		;CLEAR ILLEGAL INST DISP
	MOVE A,CSBUFP		;GET STRING POINTER
	ETYPE <%1M>		;OUTPUT IT
	POP P,Q1
	RET

ILIDAT:	TYPE <Ill. date>
	POP P,Q1
	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,RSKP
	JUMPE B,RSKP
	HRLI B,<POINT 7,0,-1>B53
	HRLI C,<POINT 7,0,-1>B53
DCMPR1:	ILDB A,C
	ILDB D,B
	CAME A,D
	RET			;DIFFERENT
	JUMPN A,DCMPR1		;TERMINATE ON NULL
	RETSKP
;DFDBCM: COMPARE FDB'S POINTED TO BY Q3 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:	MOVE B,LPFDB
	JUMPE B,[RET]		;NO PREVIOUS FDB, GIVE "DIFFERENT" RETURN
	MOVE C,.FBCTL(B)
	XOR C,.FBCTL(Q3)	;COMPARE FILE BITS
	TXNE C,FB%BAT!FB%TMP!FB%OFF ;BAT/TMP/OFF DIFFERENT?
	RET			;YES, GIVE DIFFERENT RETURN
	TXNN P2,PPF		;PROTECTION: IS IT TO BE LISTED?
	JRST DFDBC1		;NO, CONTINUE COMPARING FIELDS
	MOVE C,.FBPRT(B)
	CAME C,.FBPRT(Q3)	;IS IT SAME?
	RET			;NO, DIFFERENT
DFDBC1:	TRNN P2,ACCF		;ACCOUNT
	JRST DFDBC2
	MOVE C,.FBACT(B)
	CAME C,.FBACT(Q3)
	RET
DFDBC2:	TXNN P2,SIZPF		;SIZE IN PAGES
	JRST DFDBC3
	HRRZ C,.FBBYV(B)
	HRRZ D,.FBBYV(Q3)
	CAME C,D
	RET
DFDBC3:	TXNN P2,PLBF		;BYTES
	JRST DFDC9
	MOVE C,.FBSIZ(B)
	CAME C,.FBSIZ(Q3)
	RET
				;ALSO MAKE SURE BYTES ARE SAME SIZE:
	LDB	C,[POINTR (<.FBBYV(B)>,FB%BSZ)]
	LDB	D,[POINTR (<.FBBYV(Q3)>,FB%BSZ)]
	CAME C,D
	RET
DFDC9:	TXNN Q2,RETF		;VERSION RETENTION COUNT?
	JRST DFDC10		;NO
	LDB	C,[POINTR (<.FBBYV(B)>,FB%RET)]
	LDB	D,[POINTR (<.FBBYV(Q3)>,FB%RET)]
	CAME C,D
	RET
DFDC10:	MOVE C,.FBCRV(B)	;DATES AND TIMES
	MOVE D,TIMCVT		;COMPARE IN LOCAL TIME
	ADD C,D
	ADD D,.FBCRV(Q3)
	XOR C,D
	TXNN P2,PCTF
	TRZ C,-1		;NOT TIME, MASK IT OUT.
	TXNE P2,DCREF+PCTF	;CREATE DATE OR TIME TO BE PRINTED?
	JUMPN C,[RET]		;YES, TEST FOR SAME
	MOVE C,.FBWRT(B)
	MOVE D,TIMCVT		;COMPARE IN LOCAL TIME
	ADD C,D
	ADD D,.FBWRT(Q3)
	XOR C,D
	TXNN P2,PWTF
	TRZ C,-1
	TXNE P2,DWRF+PWTF
	JUMPN C,[RET]
	MOVE C,.FBREF(B)
	MOVE D,TIMCVT		;COMPARE IN LOCAL TIME
	ADD C,D
	ADD D,.FBREF(Q3)
	XOR C,D
	TXNN P2,PRTF
	TRZ C,-1
	TXNE P2,DRDF+PRTF
	JUMPN C,[RET]
	TXNN Q2,CHKF		;CHECKSUM?
	JRST DFDC12		;NO
	MOVE C,FDBCHK(B)
	CAME C,FDBCHK(Q3)
	RET
	MOVE C,FDBSUM(B)
	CAME C,FDBSUM(Q3)
	RET
DFDC12:	MOVE C,.FBTDT(B)	;TAPE WRITE DATE/TIME
	MOVE D,TIMCVT		;COMPARE IN LOCAL TIME
	ADD C,D
	ADD D,.FBTDT(Q3)
	XOR C,D
	TXNN P2,PTWF
	 TRZ C,-1		;NOT TIME, GET RID OF THAT
	TXNE P2,PTDF+PTWF	;DOING TAPE-WRITE DATE/TIME?
	 JUMPN C,R		;DO THEY MATCH?
	PUSH P,A		;SAVE A
	PUSH P,B		;SAVE POINTER TO FDB
	HLRO A,.FBUSE(B)	;GET POINTER TO LAST WRITER STRING
	HLRO B,.FBUSE(Q3)	;OTHER FILE'S LAST WRITER STRING
	STCMP			;COMPARE WRITER'S NAMES
	HLL C,A			;SAVE COMPARISON RESULT IN L.H. OF C
	POP P,B			;GET BACK POINTER TO LAST WRITER STRING
	HRRO A,.FBUSE(B)	;MAKE POINTER TO AUTHOR NAME
	HRRO B,.FBUSE(Q3)	;POINTER TO OTHER AUTHOR
	STCMP			;COMPARE AUTHOR'S NAMES
	HLR C,A			;STORE COMPARISON RESULT IN R.H. OF C
	POP P,A			;RESTORE A
	TXNE Q2,UCREF		;CREATE DIRS?
	TRNN C,-1		;YES, DIFFERENT?
	CAIA			;NO
	RET			;YES
	TXNE Q2,UWRF		;WRITE DIRS?
	TLNN C,-1		;YES, DIFFERENT?
	RETSKP			;NO
	RET			;YES
;DFNOUT: SUBROUTINE FOR DFILE.
;LIKE NOUT EXCEPT ADDS TRAILING SPACES, LIKE "DFILL" (NEXT),
;USING DCNT IN SAME MANNER.
;REQUIRES A, B, C SET UP FOR NOUT, DCNT FOR DFILL.
;CLOBBERS B, C.

DFNOUT:	PUSH P,A
	HRROI A,DSBUF		;STRING BUFFER PTR
	NOUT			;CONVERT NUMBER TO STRING IN CORE
	 CALL JERRC		;GENERAL JSYS ERROR ROUTINE FOR ERR # IN C
	POP P,A
	HRROI B,DSBUF
	CALLRET DFILL		;PRINT STRING AND FILL

;DFTIM is like DFNOUT but prints a date/time
;
;Accepts:	A/	width of field
;		B,C/	ODTIM stuff

DFTIM:	ADDM A,DCNT		;TELL DFILL ABOUT THE FIELD WIDTH
	HRROI A,DSBUF		;WRITE STRING TO BUFFER
	ODTIM
	HRROI B,DSBUF		;POINT TO STRING AGAIN
	CALL DFILL		;PRINT STRING AND FILL IN
	PRINT " "		;LEAVE AT LEAST ONE SPACE
	RET
;DFILL: SUBROUTINE FOR DFILE.
;OUTPUT STRING B POINTS TO, THEN TYPE SPACES IF NECESSARY TO
;MAKE IT TAKE UP NUMBER OF COLUMNS SPECIFIED IN DCNT.
; 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
	ETYPE <%2M>
	MOVE D,DCNT
DFILL1:	ILDB C,B
	CAIE C,.TICCV		;IS CHAR A CTRL/V?
	SOJL D,DFILL9		;NO, CHECK FOR OVERFLOW
	JUMPN C,DFILL1
DFILL2:	TXNN P2,SCF		;SUPPRESS COLUMNATION?
	PRINT " "
	SOJGE D,DFILL2
DFILL9:	JUMPE C,[AOJ D,
		 MOVEM D,DCNT	;UPDATE COLUMN POSITION
		 RET]		;REMOVE THE NULL TERMINATOR FROM COUNT
	ILDB C,B		;COUNT CHARS OVER SPECIFIED MINIMUM
	CAIE C,.TICCV		;CONTROL-V?
	SOJA D,DFILL9
	JRST DFILL9
	END