PDP-10.its/src/syseng/dirdev.86

;-*-MIDAS-*-

TITLE DIRDEV -- DIRECTORY JOB DEVICE

	;Details of updates moved to .INFO.;DIR RECENT


IMAGE==1	;1 => Do hair also for image mode open.

.XCREF	A B P

;AC DEFS

R0==0
A=1
B=2		;MUST = A+1
C=3		;MUST = B+1
D=4
E=5		;RELATIVELY PERMANENT.
F=6		;RELATIVELY PERMANENT.
I=7
Q=11		;RELATIVELY PERMANENT.
LFBPTR=13	;BYTE POINTER FOR GENERATING ASCII DIR.
H=14
P=15		;PDL POINTER
AUTHFL=16	;-1 IF DEVICE HAS AUTHORS

BLANK=40	;BLANK ASCII CHAR.

BOJC==1		;BOJ OUTPUT CHANNEL.
IFILE==2	;INPUT FILE DIRECTORY CHANNEL.


SUBTTL	File directory symbol definitions.
	
.INSRT	SYSTEM;FSDEFS >

MFDPGE==20		;WHERE TO PUT MFD
MFDBFR=MFDPGE*2000

UFDLEN=2000		;LENGTH OF THE DIRECTORY.

UN==1,,525252		;FOR DDT'S BIT-TYPEOUT MODE.


SUBTTL	Impure stuff

	LOC	77

	SIXBIT	/DIRDEV/	;IDENTIFICATION INFO FOR PEEK
DIRDEV:	0
F1:	0
F2:	0
DIRECT:	0
	0
	0
CRUNAM:	0
CRJNAM:	0
	0
DEVICE:	0

.M"HERE==.

LOC	42
	JSR	TSINT

LOC	.M"HERE

LPDLL==40
PDL:	BLOCK	LPDLL


IWD1:	0		;JOBCAL AREA FOR INTERRUPT LEVEL.

;JOBCAL AREA FOR MAIN PROGRAM LEVEL

WD1:	0
WD2:	0
OPNFN1:	0
OPNFN2:	0
WD5:	0
WD6:	0


ERRCOD:	0		;ERROR CODE.


OPMODE:	0		;Open mode on JOB device.

IMGHAK:	0		;-1 => we are  DSK: .FILE. (DIR)

SORTER:	NAME1		;SORT's comparator predicate.
SELECT:	SUBALL		;SUBSET's selector predicate.

NOTSW:	0		;Set if subsetting, eg, NOT DUMPED.
PACKNO:	0		;Disk pack # if subsetting PACKxx
DATE:	0		;Date or name for subsetting.
MASK:	0		;Mask for name (where asterisks are).

ASCEND:	0		;For SORT:  0 => ASCENDING ORDER.
NMCOMP:	0		;For 3-WAY SORT holds name to compare with.
FNCOMP:	0		;For 3-WAY SORT holds address of comparison routine used.
PRNFLG:	0		;For 3-WAY SORT:  1 => already printed first separator line.

INITED:	0		;Set to -1 after we do a successful JOBRET.
HNGFLG:	0		;Set 0 if hung, -1 if not.
IFOPEN:	0		;Set -1 if IFILE is open.

ILFBPT:	0		;Holds LFBPTR at beginning of each line.

TSINT:	0		;Interrupt JSR area.
	0
	JRST	INTGO


BFR:	BLOCK	UFDLEN	;Directory buffer.
TBFR:	BLOCK	50

TOPNO:	SETZ
	SIXBIT /OPEN/
	[.BAI,,IFILE]
	DEVICE
	[SIXBIT /.FILE./]
	[SIXBIT /(DIR)/]
	SETZ	DIRECT

MFDOPN:	SETZ
	SIXBIT /OPEN/
	[.BII,,IFILE]
	DEVICE
	[SIXBIT /M.F.D./]
	SETZ	[SIXBIT /(FILE)/]

MFDBLK:	SETZ		;CALL BLOCK TO GET MFD PAGE
	SIXBIT /CORBLK/
	[100,,0]
	[-1]
	1000,,MFDPGE
	SETZI	-5

;MAXIMUM POSSIBLE NUMBER OF FILES IN 1 DIRECTORY,
;= TOTAL AVAIL BYTES DIVIDED BY MINIMUM BYTES PER FILE --
MAXFIL==<UFDLEN-UDDESC>*UFDBPW/<UFDBPW*LUNBLK+1>+1

NAPTR:	0		;AOBJN PTR DESCRIBING --
NAVECT:	BLOCK	MAXFIL	;Vector of  size.ptr,,name.block.ptr
SZVECT:	BLOCK	MAXFIL	;Vector of  file.size (in words).

MAXCHS==66.		;MAX # CHARS LISTF WILL DO FOR 1 FILE,
			;ASSUMING THERE ARE MAXFIL FILES.

OUTPTR:	0		;NEXT WORD/BYTE IN OUTBUF.
OUTFIN:	0		;LAST WORD +1.
OUTBUF:	BLOCK	<100.+<MAXFIL+2>*MAXCHS+4>/5 ;OUTPUT FOR LISTF.
			;The 100. is for the header lines.
			;The 2 is for the separator lines.
				
IFN IMAGE,[
IMGBUF==OUTBUF
OUTPAD==<MAXFIL*LUNBLK>-<.-OUTBUF> ;MORE WORDS NEEDED FOR IMAGE.
	BLOCK	IFG OUTPAD,OUTPAD .ELSE 0
]

BUFEND:

IFN 0,[LOC	<.*2000+1777>/2000 ;Pad the last impure page.]

SUBTTL	Various .CALL blocks & other constants

RET=2000,,0			;VALUE RETURNED.
ERR=3000,,0			;ERROR CODE RETURNED.
IMM=1000,,0			;IMMEDIATE ARGUMENT.

IJGET:	SETZ			;JOBCAL for interrupt level.
	SIXBIT	/JOBCAL/
	IMM	BOJC
	SETZ	IWD1

JGET:	SETZ			;JOBCAL for main program level.
	SIXBIT	/JOBCAL/
	IMM	BOJC
	RET	WD1
	SETZ 	[-5,,WD2]

JRET:	SETZ
	SIXBIT	/JOBRET/
	IMM	BOJC
		H		;io.err.code,,number.to.skip
	SETZ	I		;AOBJN pointer for ret values.

JIOC:	SETZ
	SIXBIT	/SETIOC/
	IMM	BOJC
	SETZ	I		;IOCERR code.


QBTBLI:	440600,,		;Byte ptrs for directory descr.
	360600,,
	300600,,
	220600,,
	140600,,
	060600,,
	000600,,

	CONSTA

SUBTTL	Dispatching loop

START:	JFCL			;LEAVE ROOM FOR .VALUE
	MOVE	P,[-LPDLL-1,,PDL-1]	;SET UP PDL
	.SUSET	[.SMASK,,[1_10]]	;ENABLE IOCERR INTRPT.
	.SUSET	[.SMSK2,,[1_BOJC]]	;ENABLE CHANNEL INTRPT.
	.OPEN	BOJC,[SIXBIT/  'BOJ/]	;OPEN CHANNEL
	JRST	CLOSE		;CAN'T
	.CALL	[SETZ		;GET GARBAGE TO MAKE PEEK HAPPY
		 SIXBIT /RFNAME/
		 1000,,BOJC
		 2000,,.
		 2000,,CRUNAM
		 SETZM CRJNAM]
	JFCL
	SETZM	INITED
	SETOM	HNGFLG		;SET NOT HUNG

LOOP:	SKIPN	HNGFLG		;SEE IF HUNG
	.HANG			;YES - WAIT UNTIL NOT
	SETZM	HNGFLG
	.CALL	JGET		;GET INFO FOR CALL
	JRST	CHKOPN		;FAILED - IGNORE
	MOVE	A,OPNFN1
	MOVEM	A,F1
	MOVE	A,OPNFN2
	MOVEM	A,F2
	LDB	A,[370200,,WD1]	;SEE IF CLOSE BITS SET
	JUMPN	A,CLOSE		;YES - GO CLOSE
	LDB	A,[000400,,WD1]	;GET OP CODE
	CAIN	A,1		;IOT?
	 JRST	IOT
	JUMPE	A,OPEN
;ANY OPERATION OTHER THAN OPEN IS NOT ALLOWED AT THE BEGINNING.
	SKIPE	INITED
	 JRST	RNDMOP
	.CALL	[ SETZ ? SIXBIT /JOBRET/
		  IMM BOJC ? SETZ [%EBDDV,,]]
	 JFCL
	JRST	CLOSE

;RANDOM OPERATION DONE ON US AFTER WE ARE OPEN.
RNDMOP:	CAIE A,10		;Some UUO?
	 JRST SUCCED		; Yeah. Most things "succeed". 
	MOVE A,WD2		;Get call name.
	CAMN A,['LNKEDP]	;LNKEDP fails.
	 JRST SUCLOS
	CAME A,['FILLEN]	;FILLEN is wrong type device.
	 JRST SUCCED
	.CALL [	SETZ ? SIXBIT /JOBRET/ ? IMM BOJC ? SETZ [(%EBDDV)]]
	 JFCL
	JRST LOOP

OPNRET:	.CALL	[ SETZ ? SIXBIT /JOBRET/
		  IMM BOJC ? SETZI 1]
	 JRST	CLOSE
	SETOM	INITED		;HERE WHEN INITIAL OPEN SUCCEEDS.  SAY WE ARE OPEN.
	JRST	LOOP

SUCCED:	MOVEI	H,1		   ;Skip once.
	SETZM	I
	.CALL	JRET
	JFCL
	JRST	LOOP

SUCLOS:	MOVEI	H,0		   ;Skip sero times.
	SETZM	I
	.CALL	JRET
	JFCL
	JRST	LOOP


SUBTTL	OPEN handler.

OPEN:.BEGIN
	LDB	A,[410300,,WD1]	;GET MODE
	TRNE	A,1		;MUST BE READ
	JRST	BADOP		;NOPE
	MOVEM	A,OPMODE
	TRO	A,1		;NOW MAKE THE BOJ MATCH
	HRLZS	A
	HRRI	A,(SIXBIT/BOJ/)
	.OPEN	BOJC,A
	 .LOSE	%LSSYS
;Decode the file names to see what to do.
	MOVEI	A,12		;"MODE NOT AVAILABLE".
	MOVEM	A,ERRCOD	;IN CASE SYNTAX ERR.
	MOVE	A,WD5
	MOVEM	A,DIRECT
	MOVE	A,WD6
	MOVEM	A,DEVICE
	CAMN	A,[SIXBIT /JOB/]
	JRST	BADOP
	HLRZ	R0,A		;Look at top 3 chars
	CAIE	R0,(SIXBIT /DIR/)
	JRST	DEV10
	HRLZ	R0,A		;Get bottom 3 chars.
	MOVE	A,[SIXBIT /DSK/];Change DIR to DSK.
	JUMPE	R0,DEV06
	MOVE	A,R0		;Change DIRxxx to xxx.
DEV06:	MOVEM	A,DEVICE
	MOVE	A,[SIXBIT /.FILE./]
	MOVE	B,[SIXBIT /(DIR)/]
	CAMN	A,OPNFN1
	CAME	B,OPNFN2
	JRST	DEVEND
	JRST	NMTRAN

DEV10:	MOVE	A,OPNFN1	;Assume DSK-like dev --
	MOVE	B,OPNFN2
	CAME	A,[SIXBIT /.FILE./]
	JRST	DEV20
	CAME	B,[SIXBIT /(DIR)/]
	JRST	DEV11
	SETOM	IMGHAK		;Set switch.
NMTRAN:	MOVE	A,XNAME1	;Map .FILE. (DIR) to NAME1 UP
	MOVE	B,[SIXBIT /UP/]
	JRST	DEVSET
DEV11:	MOVE	R0,B
	LSH	R0,-30.		;Isolate first char.
	LSH	B,6		;Flush 1st char.
	MOVE	A,[SIXBIT /ONLY/]	;Try for  +<foo>.
	CAIN	R0,'+
	JRST	DEVSET		;Is +<foo>.
	MOVE	A,[SIXBIT /NOT/]
	CAIN	R0,'-
	JRST	DEVSET		;Is -<foo>
	MOVE	A,B
	MOVE	B,[SIXBIT 'UP']
	CAIN	R0,'/
	JRST	DEVSET		;Is /<foo>
	MOVE	B,[SIXBIT 'DOWN']
	CAIN	R0,'\
	JRST	DEVSET		;Is \<foo>
	JRST	BADOP

DEV20:	CAME	B,[SIXBIT /******/]
	JRST	DEV40
	MOVE	B,A		;MAP X ******  TO  FIRST X
	MOVE	A,XFIRST
	JRST	DEVSET
DEV40:	CAME	B,[SIXBIT /######/]
	JRST	DEV50
	MOVE	B,A		;MAP X ######  TO  FIRST# X
	MOVE	A,XFIRSN
	JRST	DEVSET
DEV50:	CAME	A,[SIXBIT /******/]
	JRST	BADOP
	MOVE	A,XSECON	;MAP ****** X  TO  SECOND X
DEVSET:	MOVEM	A,OPNFN1
	MOVEM	B,OPNFN2
DEVEND:	MOVE	A,DEVICE	;FOR PEEK WINNAGE
	HLR	A,A
	HRLI	A,'DIR
	MOVEM	A,DIRDEV

;;;;;	 DETERMINE MODE FROM FN1 & FN2.

	MOVE	A,OPNFN1
;is it a comparative subset?
	HRLZI	B,-SB1CNT
	CAMN	A,SB1NAM(B)
	JRST	ISCOMP
	AOBJN	B,.-2
;is it a special sort?
	TRZ	A,77	
	HRLZI	B,-SRTCNT
	CAMN	A,SRTNAM(B)
	JRST	ISSORT
	AOBJN	B,.-2
;is it a NOT/ONLY SUBSET?
	CAMN	A,[SIXBIT /ONLY/]
	JRST	TRYSB2		;OK -- CHECK 2ND NAME.
	SETOM	NOTSW		;MUST BE /NOT/.
	CAME	A,[SIXBIT /NOT/]
	JRST	BADOP
TRYSB2:	MOVE	A,OPNFN2
	TRZ	A,77		;Zero last char.
	HRLZI	B,-SB2CNT
	CAMN	A,SB2NAM(B)
	JRST	ISSB2
	AOBJN	B,.-2
;is it NOT/ONLY PACKxx?
	TRZ	A,7777
	CAME	A,[SIXBIT/PACK/]
	JRST	BADOP
	LDB	A,[060600,,OPNFN2]	;GET PACK NUMBER
	SUBI	A,'0
	IMULI	A,10.
	MOVEM	A,PACKNO
	LDB	A,[000600,,OPNFN2]
	SUBI	A,'0
	ADDM	A,PACKNO
	MOVEI	A,IFPACK	;SET PROPER SELECTOR.
	MOVEM	A,SELECT
	JRST	SETUP

ISCOMP:	MOVE	A,SB1TAB(B)	;GET INFO FROM TABLE.
	HLRZM	A,SELECT	;SET SELECTOR.
	PUSHJ	P,(A)		;PARSE FN2.
	JRST	BADOP		;IF DOESN'T PARSE.
	JRST	SETUP

ISSORT:	MOVE	A,SRTTAB(B)
	MOVEM	A,SORTER
	MOVE	A,OPNFN2
	CAMN	A,[SIXBIT /UP/]
	JRST	SETUP
	SETOM	ASCEND		;DESCENDING ORDER
	CAMN	A,[SIXBIT /DOWN/]
	JRST	SETUP
	MOVE	A,XNAME1(B)
	CAME	A,[SIXBIT /NAME1/]
	CAMN	A,[SIXBIT /NAME2/]
	SKIPA
	JRST	BADOP
	SETZM	ASCEND
	CAME	A,[SIXBIT /NAME1/]
	JRST	.+3
	MOVEI	A,NAME1+1
	SKIPA
	MOVEI	A,NAME2+1
	MOVEM	A,FNCOMP
	MOVE	A,OPNFN2	;GET NAME FOR 3-WAY SORT
	TLC	A,400000	;TO MAKE COMPARISON WORK
	MOVEM	A,NMCOMP
	JRST	SETUP

ISSB2:	MOVE	A,SB2TAB(B)
	MOVEM	A,SELECT

SETUP:	;Open the directory.
	MOVE	A,DEVICE
	AND	A,[777700,,0]
	CAME	A,[SIXBIT /AR/]
	JRST	DBGTST
	MOVE	A,DEVICE
	MOVEM	A,DNAME1
	MOVE	A,[SIXBIT />/]
	MOVEM	A,DNAME2
	MOVE	A,[SIXBIT /DSK/]
	MOVEM	A,DEVICE
DBGTST:	MOVE	A,[SIXBIT /DEBUG/]
	CAMN	A,DIRECT
	.HANG			;STOP HERE IF BEING DEBUGGED
	.CALL	OPNO
	JRST	BADOP
	MOVE	C,DNAME1
	CAME	C,[SIXBIT /.FILE./]
	MOVEM	C,DEVICE
SETUP1:	SETOM	IFOPEN
	MOVE	A,[-UFDLEN,,BFR]
	JRST	OPEN10

;;;;;;	Constants for OPEN 

OPNO:	SETZ
	SIXBIT/OPEN/
	ERR	ERRCOD
		[.BII,,IFILE]
		DEVICE
		DNAME1
		DNAME2
	SETZ	DIRECT

DNAME1:	SIXBIT /.FILE./
DNAME2:	SIXBIT /(DIR)/


SB1NAM:	SIXBIT /CDATE>/
	SIXBIT /CDATE=/
	SIXBIT /CDATE</
	SIXBIT /RDATE>/
	SIXBIT /RDATE=/
	SIXBIT /RDATE</
XFIRST:	SIXBIT /FIRST/
	SIXBIT /DDT/		;SAME AS FIRST
XSECON:	SIXBIT /SECOND/
XFIRSN:	SIXBIT /FIRST#/
XFIRSM:	SIXBIT /-FIRST/
	SIXBIT /FIRSTX/		;LIKE FIRST BUT NO *-MATCHING.
SB1CNT=.-SB1NAM

SB1TAB:
	IFCDG,,DPARSE
	IFCDE,,DPARSE
	IFCDL,,DPARSE
	IFRDG,,DPARSE
	IFRDE,,DPARSE
	IFRDL,,DPARSE
	IFNM1,,NMPARS
	IFNM1,,NMPARS
	IFNM2,,NMPARS
	IFNM1N,,NMPARS
	IFNM1M,,NMPARS
	IFNM1,,NMPXACT


SRTNAM:		;6th char must be blank.
XNAME1:	SIXBIT/NAME1/
	SIXBIT/NAME2/
	SIXBIT/LENGT/
	SIXBIT/SIZE/
	SIXBIT/CDATE/
	SIXBIT/RDATE/
SRTCNT==.-SRTNAM

SRTTAB:	NAME1
	NAME2
	LENGTH
	LENGTH
	CDATE
	RDATE


SB2NAM:		;6th char must be blank.
XDUMP:	SIXBIT/DUMPE/
	SIXBIT/LINKS/
	SIXBIT/LINK/
SB2CNT==.-SB2NAM

SB2TAB:	IFDUMP
	IFLINK
	IFLINK

OPEN10:	.IOT	IFILE,A
	.CLOSE	IFILE,
	SETZ	AUTHFL,		;ASSUME DEVICE DOESN'T HAVE AUTHORS
	MOVE	B,DEVICE	;SEE IF USING DSK OR AR*
	CAME	B,[SIXBIT /DSK/]
	CAMN	B,[SIXBIT /DM/]
	JRST	OPEN11
	CAME	B,[SIXBIT/AI/]	;THIS SUCKS TOTALLY --MOON
	CAMN	B,[SIXBIT/ML/]
	JRST	OPEN11
	CAME	B,[SIXBIT/MC/]
	CAMN	B,[SIXBIT/TPL/]
	JRST	OPEN11
	CAME	B,[SIXBIT /SYS/]
	CAMN	B,[SIXBIT /COM/]
	JRST	OPEN11
	AND	B,[777700,,0]
	CAME	B,[SIXBIT /AR/]
	JRST	OPEN12
OPEN11:	.CALL	MFDBLK		;GET PAGE FOR MFD
	JRST	OPEN12
	.CALL	MFDOPN		;TRY TO GET MFD
	JRST	OPEN12		;DON'T WORRY IF CAN'T
	MOVE	B,[-2000,,MFDBFR]
	.IOT	IFILE,B
	.CLOSE	IFILE,
	JUMPL	B,OPEN12	;SOMETHING'S SCREWY, BUT DON'T WORRY
	SETO	AUTHFL,		;INDICATE EVERYTHING WENT WELL
OPEN12:	CAMN	C,[SIXBIT /.FILE./]
	JRST	OPEN13
	MOVEI	C,BFR
	MOVE	B,(C)
	CAME	B,[SIXBIT/ARC!!!/]
	 JRST	OPEN13
	MOVE	B,2(C)		;OLD-TYPE ARCHIVE HAS UDNAMP IN WRONG PLACE APPARENTLY
	MOVEM	B,1(C)
;CHECK FOR ASCII-LIKE OPEN.
OPEN13:	TLNN	A,777777	;IF TOO FEW WORDS, IT'S ASCII.
	JRST	OPNOK
OPEN14:	HRRZM	A,OUTFIN	;SET LAST WORD +1.
	MOVE	A,[440700,,BFR]
	MOVEM	A,OUTPTR	;SET POINTER TO 1ST CHAR.
	JRST	OPNRET
OPNOK:
IFN IMAGE,[
	.CALL	TOPNO
	SKIPA
	JRST	OPNOK0
	MOVE	B,DEVICE	;IF COULDN'T OPEN AR* DEVICE,
	AND	B,[777700,,0]	;THIS PROBABLY ISN'T A REAL ARCHIVE,
	CAME	B,[SIXBIT /AR/]	;SO
	JRST	OPNOK0
	HRRZI	A,BFR+2000
	JRST	OPEN14		;JUMP TO ASCII-OPEN PRINT ROUTINE
OPNOK0:	MOVE	B,[-50,,TBFR]
	.IOT	IFILE,B
	.CLOSE	IFILE,
	CAMN	IMGHAK		;If .FILE. (DIR), then don't
	JRST	OPNOK1		;Sort if image mode.
]
	MOVE	A,OPMODE
	TRNE	A,4
	JRST	OPNIMX		;Cheap image mode.
OPNOK1:

;SELECT OUT THE PROPER FILES, BUILDING  NAVECT.
	MOVEI	A,BFR		;-> DIRECTORY.
	MOVE	B,[-MAXFIL,,NAVECT]	;AOBJN PTR FOR VECTOR.
	MOVE	C,SELECT	;SELECTOR PREDICATE.
	PUSHJ	P,SUBSET
	MOVEM	A,NAPTR		;SAVE RETURNED AOBJN PTR.
;SORT NAVECT.
	MOVE	B,SORTER
	PUSHJ	P,SORT
;INITIALIZE FOR SUBSEQUENT .IOT'S
IFN IMAGE,[
	MOVE	A,OPMODE
	TRNE	A,4
	JRST	OPNIMG		;IMAGE MODE.
]
	MOVE	LFBPTR,[440700,,OUTBUF]
	MOVEM	LFBPTR,OUTPTR	;BEGINNING OF OUTPUT AREA.

;Attempt to get header from device handler
	MOVE	A,[440700,,TBFR]
	ILDB	B,A
	JUMPE	B,HE1		;NO HEADER, MAKE OUR OWN
	SETZ	C,
HDL1:	IDPB	B,LFBPTR
	CAIE	B,^J
	JRST	HDL2
	SKIPE	C		;FINISHED AFTER SECOND LINE-FEED
	JRST	FLISTF
	SETO	C,
HDL2:	ILDB	B,A
	JUMPN	B,HDL1
	MOVE	LFBPTR,[440700,,OUTBUF]

;1st header line.
HE1:	MOVE	A,DEVICE
	PUSHJ	P,LF6BIT	;PUT SIXBIT DEV NAME IN OUTPUT.
	MOVEI	A,BLANK
	IDPB	A,LFBPTR
	MOVE	A,DIRECT
	PUSHJ	P,LF6BIT
	MOVEI	A,^M
	IDPB	A,LFBPTR
	MOVEI	B,^J
	IDPB	B,LFBPTR
;2nd header line.
	IDPB	A,LFBPTR
	IDPB	B,LFBPTR
;;;Now listf the files.
FLISTF:	MOVE	A,NAPTR		;VECTOR OF FILE ENTRIES.
	PUSHJ	P,LISTF		;DO THEM.
	AOJ	LFBPTR,		;RH = LAST WORD +1.
	HRRZM	LFBPTR,OUTFIN	;SET IT.
	JRST	OPNRET

;SET UP FOR IMAGE-MODE .IOT'S.
IFN IMAGE,[
OPNIMG:	;;;;;;	USE SORTED NAVECT TO RE-ARRANGE THE DIR.
;First, copy & reorder the name blocks into IMGBUF.
	MOVE	B,NAPTR		;AOBJN for name-block pointers.
	MOVEI	A,IMGBUF	;BLT destination.
	JUMPGE	B,OIMG20	;Weird -- no files.
OIMG10:	MOVEI	C,(A)
	HRL	C,(B)		;Now =  name.block,,next.imgbuf
	BLT	C,LUNBLK-1(C)
	ADDI	A,LUNBLK
	AOBJN	B,OIMG10
OIMG20:
;Second, copy the reordered stuff back into the dir bfr.
	MOVEI	B,IMGBUF
	SUBI	B,(A)		;= -<# words in IMGBUF>.
	ADDI	B,UFDLEN	;offset to start of name area.
	MOVEM	B,BFR+UDNAMP	;Set it in the image dir.
	ADDI	B,BFR		;-> start of name area.
	HRLI	B,IMGBUF
	BLT	B,BFR+UFDLEN-1	;Copy the stuff back.
]
OPNIMX:	MOVEI	A,BFR		;THE DIR ITSELF WILL BE OUTPUT.
	HRLI	A,444400	;FULL-WORD BYTE PTR.
	MOVEM	A,OUTPTR
	MOVEI	B,UFDLEN(A)
	MOVEM	B,OUTFIN
	JRST	OPNRET

.END	OPEN

SUBTTL	IOT handler.

IOT:.BEGIN
		;IOT HACKER FOR WHEN STUFF IS ALL IN CORE.
		;OUTPTR/ POINTS TO NEXT BYTE/WORD TO DO;
		;OUTFIN/ POINTS TO LAST WORD +1.
	MOVE	A,OPMODE
	TRNE	A,2
	JRST	IOT1BL		;GO IF BLOCK INPUT.
;HERE FOR UNIT-MODE OR SIOT
	MOVE	A,WD2		;NUMBER OF CHARACTERS WANTED
	MOVE	D,OUTFIN
	SUBI	D,@OUTPTR	;D GETS NUMBER OF WORDS AVAILABLE
	IMULI	D,5		;NUMBER OF CHARACTERS
	LDB	B,[360600,,OUTPTR]	;OFFSET FOR CHARS ALREADY TAKEN IN 1ST WD
	SUBI	B,44		;-# BITS TAKEN
	IDIVI	B,7		;B GETS -# CHARACTERS ALREADY TAKEN
	ADD	D,B		;D GETS NUMBER OF CHARACTERS AVAILABLE
	CAMLE	A,D
	 MOVE	A,D		;A GETS MIN(AMOUNT WANTED, AMOUNT AVAILABLE)
	MOVE	B,A
	.CALL [	SETZ ? SIXBIT/SIOT/
		MOVEI BOJC ? OUTPTR ? SETZ A ]
	 .LOSE
	CAMN	B,WD2		;DID WE GIVE ALL THAT WAS WANTED?
	 JRST	LOOP
	JRST	IOTUNH		;NO, EOF, UNHANG CALLER

IOT1BL:	HLRE	A,WD2		;CALLER'S AOBJN.
	JUMPGE	A,LOOP
	MOVNS	A		;NOW = LEN WANTED.
	HRRZ	D,OUTPTR	;FIRST WORD AVAILABLE.
	ADDI	A,(D)		;LAST WORD +1.
	MOVEI	C,(A)
	CAMLE	A,OUTFIN
	MOVE	A,OUTFIN	;GIVE NO MORE THAN WE HAVE!
	MOVEI	B,(A)		;LAST WORD +1.
	SUBI	D,(A)		;NOW = -LEN WE WILL GIVE.
	HRLZI	A,(D)
	HRR	A,OUTPTR	;AOBJN PTR.
	HRRM	B,OUTPTR	;UPDATE.
	.IOT	BOJC,A
	CAMN	B,C
	JRST	LOOP
IOTUNH:	SETZM	H		;LUSER WANTED MORE THAN WE HAD.
	SETZM	I
	.CALL	JRET
	JFCL
	JRST	LOOP

.END	IOT

SUBTTL	Exit and interrupt code.


CHKOPN:	SKIPE	INITED		;JOBCAL failed.  In the initial OPEN?
	 JRST	LOOP		; no, so we are still open.
	JRST	CLOSE		;yes, so creator is ignoring us.  Lets log out.


BADOP:	HRLZ	H,ERRCOD	;SET ERROR CODE.
	SETZM	I
	.CALL	JRET
	JFCL
	JRST	CLOSE		;WE MADE THE INITIAL OPEN FAIL, SO DIE.

LOST:
LOSE:
CLOSE:	.CLOSE	BOJC,		;CLOSE THE CHANNEL
	.CLOSE	IFILE,
	.LOGOUT
	.VALUE

INTGO:	SKIPL	TSINT		;IOC INTERRUPT
	JRST	INTIOE		;NO - IOERR INTERRUPT
	.CALL	IJGET		;GET COMMAND INFO
	.DISMISS TSINT+1	;NONE - DISMISS WITHOUT WAKEUP
	PUSH	P,A		;SAVE A
	LDB	A,[370200,,IWD1];GET CLOSE BITS
	JUMPN	A,CLOSE		;IF CLOSE GO QUIT.
	POP	P,A		;OTHERWISE - RESTORE A
	SETOM	HNGFLG		;WAKEUP MAIN PROGRAM LEVEL
	.DISMIS	TSINT+1		;AND DISMISS INTERRUPT

INTIOE:	MOVEI	I,3
	.CALL	JIOC		;SIGNAL IOC ERROR TO USER
	JFCL
	MOVEI	A,300		;SLEEP AWHILE TO TRY AVOID
	.SLEEP	A,		;STATUS TIMING ERROR.
	JRST	CLOSE		;DIE


SUBTTL	Directory subsetting routine.

SUBSET:.BEGIN	;BUILD VECTOR OF FILE POINTERS.
		;EACH ENTRY IS  FILE.LEN.PTR,,NAME.BLK.PTR
		;B/ AOBJN TO VECTOR
		;A/ -> DIRECTORY
		;C/ -> SELECTOR CODE (SKIPS TO USE FILE).
		;	CALLED WITH A/ -> NAME BLOCK.
		;WE RETURN A/ AOBJN TO FILLED PART OF VECTOR.
	MOVE	E,[-MAXFIL-1,,SZVECT-1]	;Size-vector ptr.
	PUSH	P,B		;SAVE.
	SUB	B,[1,,1]
	PUSH	P,A		;Save dir pointer.
	MOVEI	D,UFDLEN(A)	;END OF DIR +1.
	ADD	A,UDNAMP(A)	;-> 1ST NAME ENTRY.
	JRST	SUBTST		;ENTER LOOP.
SUBLUP:	ADDI	A,LUNBLK	;-> NEXT NAME ENTRY.
SUBTST:	CAML	A,D
	JRST	SUBEND
	SKIPN	UNFN1(A)	;SKIP THOSE WITH FN1 = 0.
	JRST	SUBLUP
	PUSHJ	P,(C)		;CALL THE PREDICATE.
	JRST	SUBLUP		;NO SKIP => DON'T USE.
	PUSH	B,A		;ADD ENTRY TO VECTOR.
	PUSH	P,A		;SAVE
	PUSH	P,B
	MOVE	B,-2(P)		;-> dir for FLEN.
	PUSHJ	P,FLEN		;RETURN A/ FILE LEN.
	PUSH	E,A		;Save this file len.
	POP	P,B
	HRLM	E,(B)		;Put ptr to len in LH.
	POP	P,A
	JRST	SUBLUP

SUBEND:	POP	P,A		;Flush dir ptr from stack.
	POP	P,A		;AOBJN TO BEGINNING OF VECTOR.
	AOBJN	B,.+1		;CONVERT PDL PTR TO VECTOR PTR.
	HLLZS	B		;= -UNUSED.IN.VECT,,0
	SUB	A,B		;NOW IS AOBJN TO USED VECTOR.
	POPJ	P,

.END	SUBSET


SUBTTL	Subsetting predicates.


;This page contains routines that are used for directory subset
;selection.  They are not allowed to clobber any regs.


;KEEP ON CREATION DATE

IFCDG:	PUSH	P,A
	HLLZ	A,UNDATE(A)
	CAMG	A,DATE
	JRST	FLSHIT
	JRST	KEEPIT

IFCDE:	PUSH	P,A
	HLLZ	A,UNDATE(A)
	CAME	A,DATE
	JRST	FLSHIT
	JRST	KEEPIT

IFCDL:	PUSH	P,A
	HLLZ	A,UNDATE(A)
	CAML	A,DATE
	JRST	FLSHIT
	JRST	KEEPIT

;KEEP ON REFERENCE DATE

IFRDG:	PUSH	P,A
	HLLZ	A,UNREF(A)
	CAMG	A,DATE
	JRST	FLSHIT
	JRST	KEEPIT

IFRDE:	PUSH	P,A
	HLLZ	A,UNREF(A)
	CAME	A,DATE
	JRST	FLSHIT
	JRST	KEEPIT

IFRDL:	PUSH	P,A
	HLLZ	A,UNREF(A)
	CAML	A,DATE
	JRST	FLSHIT
	JRST	KEEPIT

;KEEP IF NAME1 SAME

IFNM1:	PUSH	P,A
	MOVE	A,UNFN1(A)
	AND	A,MASK
	CAME	A,DATE		;does double duty
	JRST	FLSHIT
	JRST	KEEPIT

;KEEP IF NAME1 SAME & FN2 IS NUMERIC

IFNM1N:	PUSH	P,A
	MOVE	A,UNFN1(A)
	AND	A,MASK
	CAME	A,DATE
	JRST	FLSHIT
	MOVE	A,(P)
	MOVE	A,UNFN2(A)
	PUSHJ	P,RJNUM		;RIGHT-JUSTIFY THE NUMBER.
	JRST	FLSHIT		;IT ISN'T A NUMBER.
	PUSH	P,B
	MOVE	B,-1(P)
	MOVEM	A,UNFN2(B)	;USE RIGHT-JUSTIFIED NUMBER.
	POP	P,B
	JRST	KEEPIT

;KEEP IF NAME1 NOT SAME

IFNM1M:	PUSH	P,A
	MOVE	A,UNFN1(A)
	AND	A,MASK
	CAMN	A,DATE
	JRST	FLSHIT
	JRST	KEEPIT

RJNUM:	;;;;;;	RETURN RIGHT-JUSTIFIED NUMBER IN A,
	;;;;;;	IF NOT NUMERIC, DON'T SKIP.
	JUMPE	A,RJNUMX	;Just in case ALL BLANK.
	MOVE	R0,A		;(KEEP VALUE IN  A).
RJNUM1:	JUMPE	R0,RJNUM2	;ALL THE REST IS BLANK.
	CAML	R0,[SIXBIT /0/]
	CAMLE	R0,[SIXBIT /999999/]
	JRST	RJNUMX
	LSH	R0,6
	JRST	RJNUM1
RJNUM2:	TRNE	A,77
	JRST	RJNUM3
	LSH	A,-6		;RIGHT JUSTIFY.
	JRST	RJNUM2
RJNUM3:	AOS	(P)
RJNUMX:	POPJ	P,


;KEEP IF NAME2 SAME

IFNM2:	PUSH	P,A
	MOVE	A,UNFN2(A)
	AND	A,MASK
	CAME	A,DATE
	JRST	FLSHIT
	JRST	KEEPIT

;KEEP IF DUMPED

IFDUMP:	PUSH	P,A
	MOVE	A,UNRNDM(A)
	TLNE	A,UNLINK
	JRST	NEVER
	TLNN	A,UNDUMP
	JRST	FLSHIT
	JRST	KEEPIT

;KEEP IF PACK NUMBER MATCHES THAT IT PACKNO

IFPACK:	PUSH	P,A
	MOVE	A,UNRNDM(A)
	TLNE	A,UNLINK
	JRST	NEVER
	LDB	A,[UNPKN+A]
	CAME	A,PACKNO
	JRST	FLSHIT
	JRST	KEEPIT

;KEEP IF A LINK

IFLINK:	PUSH	P,A
	MOVE	A,UNRNDM(A)
	TLNN	A,UNLINK
	JRST	FLSHIT
	JRST	KEEPIT

FLSHIT:	POP	P,A
	SKIPE	NOTSW
POPJ1:	AOS	(P)		;HE SAID NOT - KEEP IT
	POPJ	P,

KEEPIT:	POP	P,A
	SKIPN	NOTSW
SUBALL:	AOS	(P)		;HE SAID ONLY - KEEP IT
	POPJ	P,

NEVER:	POP	P,A
	POPJ	P,


SUBTTL	File-length calculator

;FLEN - GET FILE LENGTH
;	INPUT  A/ -> NAME BLOCK;B/ -> DIRECTORY.
;	OUTPUT A/ FILE LENGTH (= 0 for a link)

;DESCRIPTOR BYTE MEANINGS
	;0 => FREE  1-UDTKMX => TAKE NEXT N
	;UDTKMX+1 THRU UDWPH-1 => SKIP N-UDTKMX AND TAKE ONE
	;40 BIT SET => LOAD ADDRESS --
	;LOWER 5 BITS PLUS NEXT TWO CHARS (17 BITS IN ALL)

FLEN:.BEGIN
	PUSH	P,C
	PUSH	P,D
	PUSH	P,A
	MOVEI	D,(B)		;-> DIRECTORY.
	MOVE	B,UNRNDM(A)
	TLNE	B,UNLINK
	JRST	FLENLK
	LDB	A,[UNDSCP UNRNDM(A)]
	IDIVI	A,UFDBPW
	ADDI	D,UDDESC(A)	;D/ -> 1ST DESC WORD.
	HLL	D,QBTBLI(B)	;NOW A/ BYTE POINTER.
	SETZ	B,		;ZERO THE BLOCK COUNTER.

BLKLUP:	ILDB	R0,D
	JUMPE	R0,LSTBYT
	CAILE	R0,UDTKMX
	JRST	ADDTHE
	ADD	B,R0
	JRST	BLKLUP

ADDTHE:	CAIN	R0,UDWPH
	JRST	BLKLUP		;DON'T COUNT IT IF DUMMY.
	AOS	B
	CAIG	R0,UDWPH
	JRST	BLKLUP
	IBP	D		;IF FULL ADDR, SKIP IT.
	IBP	D
	JRST	BLKLUP

LSTBYT:	POP	P,A		;-> NAME BLOCK.
	IMULI	B,2000
	LDB	A,[UNWRDC UNRNDM(A)]
	ADD	B,A
	SKIPE	A
	SUBI	B,2000
FLENXT:	MOVE	A,B
	POP	P,D
	POP	P,C
	POPJ	P,

FLENLK:	MOVEI	B,0
	POP	P,A
	JRST	FLENXT

.END	FLEN

SUBTTL	Sort routine (for vectors)

;SORT ROUTINE

;A/ AOBJN FOR VECTOR TO SORT
;B/ -> COMPARATOR TO USE (SKIPS IF ORDER OK).
;	IT MAY USE REGS C,D WITHOUT RESTORING THEM.

;WE CLOBBER A B E F Q

SORT:.BEGIN
	PUSH	P,A		;SAVE.
	MOVEI	Q,(B)		;SAVE.
	MOVE	E,A		;AOBJN FOR VECTOR.
	AOBJN	E,SRTL1		;BUMP E & GO IF >1.
	JRST	SRTEND
SRTL1:	MOVE	A,-1(E)		;1ST ITEM
	MOVE	B,0(E)		;2ND ITEM
	PUSHJ	P,(Q)		;COMPARE.
	JRST	SRTSW		;IF NO SKIP, NEED TO SWITCH.
SRTL1T:	AOBJN	E,SRTL1
SRTEND:	POP	P,A
	POPJ	P,

SRTSW:	HLLZ	F,0(P)		;-LEN,,0  OF WHOLE VECTOR.
	MOVNS	F		;LEN,,0  OF WHOLE.
	ADD	F,E		;LEN.1ST.PART,,END.FIRST.PART.
SRTL2:	MOVEM	B,-1(F)		;SWAP OUT-OF-ORDER ENTRY.
	MOVEM	A,0(F)
	SUB	F,[1,,1]
	TLNN	F,777777
	JRST	SRTL1T		;WE ARE AT BEGINNING.
	MOVE	A,-1(F)		;NOW A,B ARE PREV PAIR OF ITEMS
	PUSHJ	P,(Q)
	JRST	SRTL2		;ORDER STILL NOT OK.
	JRST	SRTL1T		;ORDER OK - RETURN TO MAIN LOOP

.END	SORT


SUBTTL	Sort predicates

;This page contains comparators for various sort conditions.

;CNAME1 and CNAME2 are comparators used by the comparators.
;Return if equal, go to AFIRST or BFIRST otherwise.

CNAME1:	MOVE	C,UNFN1(A)	;SET UP COMPARISON OF NAME1'S
	MOVE	D,UNFN1(B)

CNAMES:	PUSH	P,A
	MOVE	A,C
	MOVEI	R0,IFNM1N	;IF DOING  FIRST#, THEN
	CAMN	R0,SELECT
	JRST	CN.COM		;DON'T RE-JUSTIFY.
	PUSHJ	P,RJNUM		;RIGHT-JUSTIFY.
	JRST	CN10		;1ST IS NOT NUMERIC.
	MOVE	C,A
	MOVE	A,D
	PUSHJ	P,RJNUM
	JRST	CN.A		;1ST IS NUMERIC, 2ND ISN'T.
	MOVE	D,A
	JRST	CN.COM		;GO DO COMPARISON.
CN10:	MOVE	A,D
	PUSHJ	P,RJNUM
	JRST	CN.COM		;NEITHER ARE NUMERIC.
	POP	P,A
	POP	P,R0		;(SINCE WE JRST)
	SKIPN	NMCOMP
	JRST	BFRST1		;2ND NUMERIC, 1ST NOT.
	TLC	C,400000
	HRLI	R0,
	CAMN	R0,FNCOMP	;MAKE SURE CHECKING RIGHT FILE NAME
	CAMGE	C,NMCOMP
	JRST	BFRST1
	JRST	AFRST1
CN.A:	POP	P,A
	POP	P,R0
	SKIPN	NMCOMP
	JRST	AFRST1		;1ST NUMERIC, 2ND NOT.	
	TLC	D,400000
	HRLI	R0,
	CAMN	R0,FNCOMP	;MAKE SURE CHECKING RIGHT FILE NAME
	CAMGE	D,NMCOMP
	JRST	AFRST1
	JRST	BFRST1
CN.COM:	POP	P,A
	TLC	C,400000
	TLC	D,400000
	CAMN	C,D		;THE SAME?
	POPJ	P,		;YES - RETURN
	POP	P,R0		;NO -- POP 1 SINCE WE JRST.
	CAML	C,D		;WHICH IS FIRST
	JRST	BFIRST
	JRST	AFIRST

CNAME2:	MOVE	C,UNFN2(A)	;SET UP COMPARISON OF NAME2'S
	MOVE	D,UNFN2(B)
	JRST	CNAMES

NAME1:	PUSHJ	P,CNAME1	;COMPARE ON NAME1
	PUSHJ	P,CNAME2	;FIRST NAMES EQUAL, TRY 2ND.
	JRST	A.EQ.B

NAME2:	PUSHJ	P,CNAME2	;COMPARE ON NAME2.
	PUSHJ	P,CNAME1
	JRST	A.EQ.B

;COMPARE BASED ON FILE LENGTH

LENGTH:	HLRZ	C,A
	HLRZ	D,B
	MOVE	C,0(C)		;Pick up len from SZVECT.
	MOVE	D,0(D)
	JRST	COMPAR		;GO DO COMPARISON


;COMPARE BASED ON CREATION DATES

CDATE:	MOVE	C,UNDATE(A)	;COMPARE CREATION DATES
	MOVE	D,UNDATE(B)
	JRST	COMPAR

;COMPARE BASED ON REFERENCE DATES

RDATE:	HLRZ	C,UNREF(A)
	HLRZ	D,UNREF(B)

COMPAR:	SUB	C,D
	JUMPE	C,NAME1		;IF THE SAME - SORT ON NAME
	JUMPG	C,BFIRST

AFIRST:	SKIPN	NMCOMP		;3-WAY SORT?
	JRST	AFRST1		;NO - ACT NORMALLY
	HRLI	R0,
	CAME	R0,FNCOMP	;MAKE SURE CHECKING RIGHT FILE NAME
	JRST	AFRST1
	CAML	C,NMCOMP
	JRST	AFRST1+1
	CAML	D,NMCOMP
	POPJ	P,
	SKIPA
AFRST1:	SKIPN	ASCEND		;ASCENDING ORDER?
	AOS	(P)		;YES - NO SWITCH NEEDED
	POPJ	P,

BFIRST:	SKIPN	NMCOMP		;3-WAY SORT?
	JRST	BFRST1		;NO - ACT NORMALLY
	HRLI	R0,
	CAME	R0,FNCOMP	;MAKE SURE CHECKING RIGHT FILE NAME
	JRST	BFRST1
	CAML	D,NMCOMP
	POPJ	P,
	CAMGE	C,NMCOMP
	POPJ	P,
	SKIPA
BFRST1:	SKIPE	ASCEND		;DESCENDING ORDER?
A.EQ.B:	AOS	(P)		;YES - NO SWITCH NEEDED
	POPJ	P,


SUBTTL	Name and Date parser.

;This page contains routines to parse dates into directory
;format and names into * format.

DPARSE:	PUSH	P,A
	LDB	A,[301400,,OPNFN2]
	PUSHJ	P,SIXNUM
	DPB	A,[UNYRB DATE]
	LDB	A,[141400,,OPNFN2]
	PUSHJ	P,SIXNUM
	DPB	A,[UNMON DATE]
	LDB	A,[001400,,OPNFN2]
	PUSHJ	P,SIXNUM
	DPB	A,[UNDAY DATE]
	AOSA	-1(P)
DPLOSE:	POP	P,A
	POP	P,A
	POPJ	P,

SIXNUM:	CAIL	A,(SIXBIT / 00/)
	CAILE	A,(SIXBIT / 99/)
	JRST	DPLOSE
	PUSH	P,B
	MOVE	B,A
	LSH	A,-6
	ANDI	A,17
	IMULI	A,10.
	ANDI	B,17
	ADD	A,B
	POP	P,B
	POPJ	P,

;A/ name to parse
NMPARS:	PUSH	P,A
	PUSH	P,B
	PUSH	P,C
	MOVE	A,OPNFN2
	SETZ	C,
	CAMN	A,[SIXBIT /*/]
	JRST	NMDONE
	MOVE	B,[440600,,A]
	SETO	C,
NMPAR1:	CAMN	B,[000600,,A]
	JRST	NMDONE
	ILDB	0,B
	CAIE	0,'*
	JRST	NMPAR1
	HRRI	B,C
	SETZ
	DPB	0,B
	HRRI	B,A
	JRST	NMPAR1
NMDONE:	MOVEM	C,MASK
	AND	A,MASK
	MOVEM	A,DATE
	POP	P,C
	POP	P,B
	POP	P,A
	AOS	(P)
	POPJ	P,

;PUT FN2 INTO DATE AND SET MASK TO ALL ONES
;FOR EXACT COMPARISON WITH SUPPLIED NAME (NO STAR-MATCHING).
NMPXACT:
	PUSH P,OPNFN2
	POP P,DATE
	SETOM MASK
	JRST POPJ1

SUBTTL	LISTF routine.

;LISTF -- CREATE ASCII VERSION OF AN IMAGE DIRECTORY.
;	A/	AOBJN FOR VECTOR OF  FILE.LEN,,NAME.PTR.
;	LFBPTR/	BYTE POINTER FOR WHERE TO PUT THE STUFF.
;	BFR==IMAGE DIRECTORY BUFFER,


LISTF:.BEGIN
	MOVE	D,A		;LOOP COUNTER.
	JUMPGE	A,LFDONE
LFNEXT:	MOVE	C,0(D)		;THIS  LEN,,NAME.PTR
	SKIPN	NMCOMP		;WAS THIS A 3-WAY SORT?
	JRST	LFNXT1		;NO -- SKIP SEPARATOR LINE CHECKING
	MOVE	A,UNFN1(C)
	MOVE	B,FNCOMP
	CAIE	B,NAME1+1
	MOVE	A,UNFN2(C)
	TLC	A,400000
	CAMN	A,NMCOMP
	JRST	LFNXT1
	CAML	A,NMCOMP
	JRST	.+3
	SETZM	NMCOMP
	JRST	LFSEP
	SKIPE	PRNFLG
	JRST	LFNXT1
	AOS	PRNFLG
LFSEP:	MOVEI	A,100		;OUTPUT SEPARATOR LINE
	MOVEI	B,"-
LFSEP1:	IDPB	B,LFBPTR
	SOJG	A,LFSEP1
	MOVEI	B,^M
	IDPB	B,LFBPTR
	MOVEI	B,^J
	IDPB	B,LFBPTR
	SKIPN	PRNFLG
	JRST	[AOS	PRNFLG
		 JRST	LFSEP]
LFNXT1:	MOVEM	LFBPTR,ILFBPT	;SAVE INITIAL BYTE-POINTER FOR THIS LINE
	MOVE	A,UNRNDM(C)	;GET FLAG BITS
	TLNN	A,UNLINK	;LINK?
	JRST	LFFILE		;NOT A LINK
LFLINK:	MOVEI	A,[ASCIZ "  L   "]
	PUSHJ	P,LFASCZ
	MOVE	A,UNFN1(C)	;OUTPUT FNAME1
	PUSHJ	P,LF6BIT
	MOVEI	B,BLANK
	IDPB	B,LFBPTR
	MOVE	A,UNFN2(C)	;OUTPUT FNAME2
	PUSHJ	P,LF6BIT
;OUTPUT THE LINKED-TO NAMES.
	IDPB	B,LFBPTR
	IDPB	B,LFBPTR
	IDPB	B,LFBPTR
	MOVEI	B,"=
	IDPB	B,LFBPTR
	IDPB	B,LFBPTR
	MOVEI	B,">
	IDPB	B,LFBPTR
	MOVEI	B,BLANK
	IDPB	B,LFBPTR
	LDB	A,[UNDSCP UNRNDM(C)]	;GET BYTE INDEX
	IDIVI	A,UFDBPW	;CONVERT TO BYTE POINTER
	ADDI	A,UDDESC+BFR
	HLL	A,QBTBLI(B)
	PUSH	P,C
	PUSH	P,D
	MOVEI	C,20.
	MOVEI	D,";
LFCH00:	MOVEI	E,6
LFCHR1:	ILDB	B,A		;GET NEXT CHAR
	JUMPE	B,LFCHR4	;THE END.
	CAIN	B,';		;SEMI-COLON IS SEPARATOR
	JRST	LFCHR3
	CAIN	B,':		;COLON IS QUOTE
	ILDB	B,A
	ADDI	B,40		;CONVERT TO ASCII
	IDPB	B,LFBPTR
	SOJ	C,
	SOJG	E,LFCHR1
LFCHR3:	IDPB	D,LFBPTR
	MOVEI	D,BLANK
	SOJ	C,
	JRST	LFCH00
LFCHR4:	JUMPLE	C,.+3
	IDPB	D,LFBPTR
	SOJG	C,.-1
	POP	P,D
	POP	P,C
	JRST	LFCHR9

LFFILE:		;OUTPUT INFORMATION FOR A REAL FILE.
;OUTPUT STAR IF OPEN FOR WRITING, DELETED, ETC.
	MOVEI	B,BLANK
	MOVE	A,UNRNDM(C)
	TLNE	A,UNIGFL
	MOVEI	B,"*
	IDPB	B,LFBPTR
;OUTPUT PACK NUMBER.
	MOVEI	B,BLANK
	IDPB	B,LFBPTR
	LDB	A,[UNPKN A]	;GET PACK NUMBER
	IDIVI	A,10.
	ADDI	A,"0
	ADDI	B,"0
	CAIE	A,"0
	JRST	LFPAK1
	MOVEI	A,(B)		;USE "3 " INSTEAD OF "03".
	MOVEI	B,BLANK
LFPAK1:	IDPB	A,LFBPTR
	IDPB	B,LFBPTR
	MOVEI	B,BLANK
	IDPB	B,LFBPTR
	IDPB	B,LFBPTR
;OUTPUT FILE NAMES
	MOVE	A,UNFN1(C)
	PUSHJ	P,LF6BIT
	IDPB	B,LFBPTR
	MOVE	A,UNFN2(C)
	PUSHJ	P,LF6BIT
;OUTPUT FILE LENGTH AS NNN+NNN
	MOVEI	A,BLANK
	IDPB	A,LFBPTR
	HLRZ	A,C		;GET FILE LENGTH
	MOVE	A,0(A)
	IDIVI	A,2000
	PUSH	P,C
	MOVEI	C,3
	PUSHJ	P,LFJUST
	POP	P,C
	PUSHJ	P,LFDEC
	JUMPE	B,LFLENX
	PUSH	P,C
	MOVE	A,B
	MOVEI	C,4
	PUSHJ	P,LFJUST
	MOVEI	B,"+
	IDPB	B,LFBPTR
	POP	P,C
	PUSHJ	P,LFDEC
LFLENX:
;OUTPUT REAP AND DUMP BITS
	MOVEI	A,29.
	PUSHJ	P,LFHPOS
	MOVEI	A,BLANK
	MOVE	B,UNRNDM(C)
	TLNN	B,UNDUMP
	MOVEI	A,"!
	IDPB	A,LFBPTR
	MOVEI	A,BLANK
	TLNE	B,UNREAP
	MOVEI	A,"$
	IDPB	A,LFBPTR
;OUTPUT CREATION DATE
	MOVE	A,UNDATE(C)
	PUSHJ	P,LFDATE	;CREATION DATE
	JRST	LFCHR9		;NO CREATION TIME.
;OUTPUT CREATION TIME.
	MOVEI	A,BLANK
	IDPB	A,LFBPTR
	HRRZ	B,UNDATE(C)
	PUSH	P,C
	LSH	B,-1
	IDIVI	B,10.
	PUSH	P,C
	IDIVI	B,6
	PUSH	P,C
	IDIVI	B,10.
	PUSH	P,C
	IDIVI	B,6
	PUSH	P,C
	IDIVI	B,10.
	PUSH	P,C
	PUSH	P,B
	MOVEI	B,2
LFF1:	POP	P,A
	ADDI	A,"0
	IDPB	A,LFBPTR
	POP	P,A
	ADDI	A,"0
	IDPB	A,LFBPTR
	MOVEI	A,":
	SKIPE	B
	IDPB	A,LFBPTR
	SOJGE	B,LFF1
	POP	P,C

LFCHR9:	MOVEI	A,51.
	PUSHJ	P,LFHPOS
	MOVEI	A,BLANK		;REFERENCE DATE.
	IDPB	A,LFBPTR
	PUSH	P,LFBPTR
	MOVE	A,UNREF(C)
	PUSHJ	P,LFDATE
	JFCL
	MOVEI	A,"(
	MOVE	B,(P)
	ILDB	B,B
	CAIN	B,BLANK
	IBP	(P)
	DPB	A,(P)
	POP	P,B
	MOVEI	A,")
	IDPB	A,LFBPTR
;OUTPUT AUTHOR
	JUMPE	AUTHFL,LFEND	;UNLESS NO AUTHORS ON THIS DEVICE
	LDB	B,[UNAUTH+UNREF(C)]
	JUMPE	B,LFEND
	MOVEI	A,BLANK
	IDPB	A,LFBPTR
	CAIN	B,777		;RANDOM AUTHOR
	JRST	AUTRAN
	LSH	B,1
	ADDI	B,MFDBFR+2000
	SUB	B,MDNUDS+MFDBFR
	SUB	B,MDNUDS+MFDBFR
	MOVE	A,(B)
	CAMN	A,DIRECT	;DON'T PRINT IF AUTHOR IS DIR NAME
	JRST	LFEND
	PUSHJ	P,LF6BIT
	JRST	LFEND
AUTRAN:	MOVEI	A,[ASCIZ /???/]
	PUSHJ	P,LFASCZ

LFEND:	MOVEI	A,15
	IDPB	A,LFBPTR
	MOVEI	A,12
	IDPB	A,LFBPTR
	AOBJN	D,LFNEXT	;LOOP.
LFDONE:	MOVEI	A,3		;EOF CHAR.
LFDON1:	IDPB	A,LFBPTR
	TLNE	LFBPTR,760000
	JRST	LFDON1		;FILL OUT LAST WORD.
	POPJ	P,


LFDATE:	CAMN	A,[-1]
	JRST	LFNDAT
	PUSH	P,C
	MOVEI	C,BLANK
	PUSH	P,B
	MOVE	B,A
	LDB	A,[UNMON B]
	CAIG	A,9
	IDPB	C,LFBPTR
	PUSHJ	P,LFDEC
	MOVEI	A,"/
	MOVEI	C,"0
	IDPB	A,LFBPTR
	LDB	A,[UNDAY B]
	CAIG	A,9
	IDPB	C,LFBPTR
	PUSHJ	P,LFDEC
	MOVEI	A,"/
	IDPB	A,LFBPTR
	LDB	A,[UNYRB B]
	ADDI	A,1900.
	PUSHJ	P,LFDEC
	POP	P,B
	POP	P,C
	AOS	(P)
	POPJ	P,
LFNDAT:	MOVEI	A,"-
	IDPB	A,LFBPTR
	POPJ	P,

.END	LISTF

LFDEC:	PUSH	P,B		;OUTPUTS NUMBER
	PUSH	P,[-1]
	IDIVI	A,10.
	PUSH	P,B
	JUMPN	A,.-2
LFDEC1:	POP	P,A
	JUMPL	A,LFDEC2
	ADDI	A,"0
	IDPB	A,LFBPTR
	JRST	LFDEC1
LFDEC2:	POP	P,B
	POPJ	P,

LF6BIT:	PUSH	P,B		;MAY NOT CLOBBER ANYTHING.
	PUSH	P,C
	MOVEI	C,6
LF6BL:	SETZM	B
	ROTC	A,6
	ADDI	B,40
	IDPB	B,LFBPTR
	SOJG	C,LF6BL
	POP	P,C
	POP	P,B
POPJ.P:	POPJ	P,

LFASCZ:		;Output an asciz string.
	HRLI	A,440700	;Make input byte pointer.
	ILDB	R0,A
	JUMPE	R0,POPJ.P
	IDPB	R0,LFBPTR
	JRST	.-3

LFJUST:	PUSH	P,B		;OUTPUT C-(NUMBER OF CHARS NEEDED TO PRINT A) SPACES
	PUSH	P,A
	IDIVI	A,10.
	SOJ	C,
	JUMPN	A,.-2
	JUMPLE	C,LFJST1
	MOVEI	A,BLANK
	IDPB	A,LFBPTR
	SOJG	C,.-1
LFJST1:	POP	P,A
	POP	P,B
	POPJ	P,

LFHPOS:		;Move to specified character position.
	PUSH	P,B
	IDIVI	A,5
	ADD	A,ILFBPT
	JUMPE	B,.+3
	IBP	A
	SOJN	B,.-1
	MOVEI	B,BLANK
	CAMN	A,LFBPTR
	JRST	LFHP0
	IDPB	B,LFBPTR
	CAME	A,LFBPTR
	JRST	.-2
LFHP0:	POP	P,B
	POPJ	P,


CONST:	CONSTA
PAT: PATCH:	BLOCK 100
PATCHE:	-1

END START