	.TITLE *** TDV 'DIRECTORY' FUNCTION
/
/ COPYRIGHT (C) 1975
/ DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/ THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
/ ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
/ THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS
/ SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO-
/ VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
/ EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO
/ THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/ SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/ THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE
/ WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM-
/ MITMENT BY DIGITAL EQUIPMENT CORPORATION.
/
/ DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/ OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
/ DEC.
/
	.EJECT
/
/	EDIT #73	10 JUN 75	C. PROTEAU
/					M. HEBENSTREIT
/
/
/ TDV (TASK DEVELOPMENT) FUNCTION, CALLED "DIR...", USED TO LIST INFORMATION
/ ABOUT THE SEQUENTIAL AND RANDOM ACCESS FILES THAT EXIST ON THE
/ RF15, RP02, OR RK05. TO LIST A DISK DIRECTORY TYPE
/ 'DIR RX# <ABC>' ON THE TDV TERMINAL THE DIRECTORY WILL BE LISTED ON LUN 16.
/
/////////////////////////////////////////////////////////////////
/								/
/ CALL:	TDV>DIR RX# <ABC>						/
/								/
/ SAMPLE DIRECTORY PRINTOUT:					/
/								/
/	RX#-ABC							/
/	###### USER BLOCKS					/
/	###### FREE BLOCKS					/
/								/
/	FILNAM EXT     71     15  3-AUG-71			/
/	RANDOM FIL    106     10  4-AUG-71    400     10	/
/	FILE2  SRC      0      0  4-AUG-71 *			/
/								/
/////////////////////////////////////////////////////////////////
/  
/ IN THE COMMAND STRING RX INDICATES RF, RP, OR RK. # IS THE UNIT NUMBER  
/ OF THE INDICATED DISK. FOR THE RF DISK THE UNIT NUMBER SHOULD BE ZERO
/ SINCE ONLY ONE RF DISK IS SUPPORTED (ALTHOUGH THAT DISK CAN HAVE UP TO
/ EIGHT PLATTERS). 'ABC' IS THE NAME OF THE UFD WANTED LISTED.
/
/ THE FIRST NUMBER INDICATES THE FILE'S FIRST DATA BLOCK. THE SECOND NUMBER
/ IS THE NUMBER OF BLOCKS IN THE FILE. THE ASTERISK APPEARS ONLY IF THE FILE
/ IS "TRUNCATED", WHICH MEANS THAT THE FILE IS UNREADABLE BECAUSE THE FIRST
/ BLOCK NUMBER AND THE NUMBER OF BLOCKS IN THE FILE ARE ZERO. ONLY SEQUEN-
/ TIAL ACCESS FILES CAN BE TRUNCATED. A RANDOM ACCESS FILE IS CHARAC-
/ TERIZED BY TWO ADDITIONAL NUMBERS, ACCOUNTING INFORMATION PARAMETERS
/ THAT ARE ENTERED AT THE OPTION OF THE USER. WHEN RANDOM ACCESS FILES
/ ARE CREATED USING FORTRAN, THE ACCOUNTING INFORMATION IS (1) THE
/ NUMBER OF RECORDS IN THE FILE AND (2) THE NUMBER OF WORDS PER RECORD.
/
/ AT COMPLETION OF THE DIRECTORY LISTING, THE TERMINATING CHARACTER OF THE
/ COMMAND LINE IS EXAMINED. IF IT IS A CARRIAGE RETURN, THE RESIDENT TDV
/ TASK IS 'REQUESTED' AND THIS TASK EXITS. IF THE LINE IS TERMINATED BY AN
/ ALTMODE, THIS TASK EXITS WITHOUT 'REQUESTING' 'TDV...'. A CTRL T TYPEIN
/ IS THEN NECESSARY TO RE-ESTABLISH TDV DIALOGUE.
/
IDX=ISZ				/USED WHEN THE SKIP IS NOT INTENDED.
ECLA=641000			/EAE CLEAR AC CODE.
	.DEC
DSKLUN=1			/DISK I/O DRIVER LUN.
TDVTTY=13			/TDV TTY ERROR LUN.
TDVOUT=16			/TDV PRINTOUT LUN.
	.OCT
SYSDSK=301			/SYSTEM DEVICE INDICATOR
LUFD1=304			/PTR TO START OF LUN-UFD TABLE
DUFD1=306			/PTR TO START OF DSK-UFD TABLE
RKDISK=302
RPDISK=303
DSIZE=137
/
	.EJECT
DIR	CAL	XFER		/TRANSFER THE COMMAND LINE READ BY 'TDV...'.
	CAL	WAITFR
	LAC	EV		/SAVE THE EVENT VARIABLE FOR REFERENCE AT
	DAC	XFEREV		/EXIT TIME.
        SPA		/CHECK THE EVENT VARIABLE
        JMP     ERR10	/ERROR -- TDV READ ERROR
        JMS     FAC	/FIND THE 1ST SPACE
        SAD     (15
        JMP     ERR11
        SAD     (175
        JMP     ERR11
        SAD     (40
        SKP
        JMP     .-7
/
/ ATTACH THE "PRINTER".
/
	CAL	ATTACH
	CAL	WAITFR
	LAC	EV
	SAD	(-6)
	JMP	DOHINF		/"ATTACH" UNIMPLEMENTED.
	SPA
	JMP	ERR1		/"ATTACH" ERROR.
/
/ MAKE SURE THAT THE LISTING DEVICE IN FACT CAN PERFORM OUTPUT AND
/ THAT IT DOES NOT HAVE A DIRECTORY.
/
DOHINF	CAL	HINF
	CAL	WAITFR
	LAC	EV
	RTL
	SPA!RAL
	SPA
	JMP	ERR2		/NOT A LISTING DEVICE -- CAN'T DO OUTPUT.
				/NOT A LISTING DEVICE -- HAS A DIRECTORY.
/
	.EJECT
/ CONVERT THE UFD BLOCK NUMBER INTO A PLATTER NUMBER AND DISK ADDRESS. SET
/ THE 'GET' CONTROL TABLE AND READ IN THE UFD BLOCK.
/
	LAC	(BUF		/CALCULATE THE XR ADJUST FACTOR
	AND	(70000
        DAC     ADJXR
        TCA
        DAC     XRADJ
/  
/ GET THE STARTING BLOCK OF THE CORRECT UFD AND SET UP THE GET CPB
/ TO ACCESS THE PROPER DISK TYPE AND UNIT NUMBER.
/  
/  
	JMS	GETDEV	/GET DEVICE NAME AND UNIT NO.
	JMP	ERR11        /RETURN HERE IS A FORMAT ERROR IS FOUND
	SAD	(40		/IS BREAK CHAR A SPACE?
	SKP
	JMP	ERR11		/NO -- ERROR
	JMS	FAC		/YES -- GET NEXT CHAR
	SAD	(40		/SPACE?
	JMP	.-2		/YES -- IGNORE
	SAD	(74		/NO <?
	SKP
	JMP	ERR11		/NO -- ERROR
	JMS	GETU		/YES -- GET 1ST CHAR OF UFD NAME
	ALS	14		/SHIFT AND STORE CHAR
	DAC	UFD
	JMS	GETU		/GET NEXT CHAR
	ALS	6
	TAD	UFD		/STORE IT
	DAC	UFD
	JMS	GETU		/GET LAST CHAR OF UFD NAME
	TAD	UFD
	DAC	UFD		/SAVE UFD NAME
	JMS	FAC		/GET NEXT CHAR
	SAD	(76		/>?
	SKP
	JMP	ERR11		/NO -- ERROR
LKTERM	JMS	FAC		/YES -- LOOK FOR LINE TERM
	SAD	(15
	JMP	H1
	SAD	(175
	JMP	H1
	JMP	LKTERM
H1	DAC	TERM       /SAVE THE TERMINATOR
	LAC	GN2	/SAVE THE UNIT NUMBER
	DAC	UNIT
	LAC	GN1	/SAVE THE NAME
	DAC	NAME1
        SAD     (220600	/RF?
        JMP     RF0	/YES
        SAD     (222000	/NO -- RP?
        JMP     RP0	/YES
        SAD     (221300	/NO -- RK?
        SKP		/YES
        JMP     ERR13	/NO -- ERROR NOT A DISK
RK0     LAC     (24	/GET THE DEVICE CODE FOR RK
	DAC	DEVICE
	LAC	(RKDISK
	JMP	RF9
RP0     LAC     (3	/GET THE DEVICE CODE FOR RP
        DAC     DEVICE
        LAC     (RPDISK
        JMP     RF9
RF0     LAC     (2	/GET THE DEVICE CODE FOR RF
        DAC     DEVICE	/SAVE THE DEVICE CODE
        LAC     UNIT	/BE SURE THE UNIT NO. FOR RF IS 0
        SZA
        JMP     ERR15
        LAC     (DSIZE
RF9     JMS     LOOKUP	/TEST THE EXISTANCE OF DISK UNIT
        SPA
        JMP     ERR15
        LMQ
        LAC     DEVICE
        SAD     (2
        JMP     RF8
        LACQ
        TCA
        TAD     UNIT
        SMA!SZA
        JMP     ERR15
RF8	LAC	DEVICE		/GET THE DEVICE CODE
	SAD	(3		/RP?
	JMP	.+3
	LAC	(1777		/NO -- RF OR RK, GET MFD START BLK
	SKP
	LAC	(47040		/YES
NEXTBL	JMS	CONVRT		/PREPARE TO GET THE DISK BLOCK
	CAL	GET		/GET THE BLK
	CAL	WAITFR
	LAC	EV		/ANY ERROR?
	SPA
	JMP	ERR3		/YES
	LAC	(BUF		/NO -- SETUP BUFFER POINTER
	DAC	TEMP1
LOOK	LAC*	TEMP1		/GET A UFD NAME FROM MFD BLK
	SAD	UFD		/MATCH?
	JMP	FOUND		/YES
	LAC	TEMP1		/NO -- END OF BLK?
	SAD	(BUF+370
	JMP	EOB		/YES
	AAC	4		/NO -- INCREMENT POINTER
	DAC	TEMP1
	JMP	LOOK		/GO LOOK AT NEXT MFD ENTRY
EOB	LAC	BUF+377	/GET POINTER TO NEXT MFD BLK
	SAD	(-1		/END OF MFD?
	JMP	ERR7		/YES -- UFD NOT IN MFD -- ERROR
	JMP	NEXTBL		/NO -- GO GET NEXT BLK
FOUND	IDX	TEMP1		/GET STARTING BLK OF UFD
	LAC*	TEMP1
	SAD	(-1		/EMPTY UFD?
	JMP	ERR6		/YES -- INFORM USER
LOC1	DZM	OCCBLK	/ZERO NO. OF OCCUPIED BLOCKS
	DAC	STARTB	/SAVE THE STARTING BLK OF UFD
	DZM	SATCNT
	LAC	DEVICE	/PREPARE TO GET THE STARTING SAT BLOCK
	SAD	(3
	JMP	.+3
	LAC	(1776
	SKP
	LAC	(764
LOC2	JMS	CONVRT	/CHANGE BLK NO. TO PLATTER AND ADDR.
	CAL	GET
	CAL	WAITFR
	LAC	EV
	SPA
	JMP	ERR3
	LAC	SATCNT	/IS THIS THE 1ST SAT BLK?
	SZA
	JMP	LOC3	/NO
	LAC	BUF	/YES -- GET THE TOTAL NO. OF BLKS.
	DAC	TOTBLK
	IDX	SATCNT
LOC3	LAC	BUF+2	/ADD UP THE OCCUPIED BLKS. 
	TAD	OCCBLK
	DAC	OCCBLK
	LAC	BUF+377	/IS THIS THE END OF ALL SAT BLKS?
	SMA
	JMP	LOC2	/NO -- CONTINUE
	LAC	STARTB	/YES -- GET STARTING UFD BLK INTO AC
NEXBLK	JMS	CONVRT	/CHANGE DIR BLK INTO PLAT. AND ADDR.
RDBLK	CAL	GET		/GET THE UFD BLOCK.
	CAL	WAITFR
	LAC	EV
	SPA
	JMP	ERR3		/DISK ERROR.
	LAC	FLAG		/SEE IF FREE AND TOTAL BLKS SHOULD
	SZA			/BE PRINTED
	JMP	LOC4		/NO -- DONE ALREADY
/
/ PRINT A FORM FEED AND RETURN CARRIAGE
/
	LAC	(MSG0
	DAC	HEADER+4
	CAL	HEADER
	CAL	WAITFR
	LAC	EV
	SPA
	JMP	ERR4
/
/ PRINT THE DISK TYPE, UNIT NUMBER, AND UFD NAME
/
	LAC	(UFDBUF+1	/SET UP THE CHAR PACK POINTER
	DAC	TEMP10
	LAC	(122		/PACK THE DISK NAME AND UNIT
	IDX	TEMP10
	DAC*	TEMP10
	LAC	NAME1
	AND	(7700
	CLL!RTR
	RTR
	RTR
	AAC	100
	IDX	TEMP10
	DAC*	TEMP10
	LAC	UNIT
	AAC	60
	IDX	TEMP10
	DAC*	TEMP10
	LAC	(55		/PACK A DASH
	IDX	TEMP10
	DAC*	TEMP10
	LAC	UFD		/PACK THE UFD NAME
	JMS	SIXBIT
	LAC	(UFDBUF		/SET UP THE PRINT CPB
	DAC	PRINT+4
	CAL	PRINT		/PRINT THE BUFFER
	CAL	WAITFR
	LAC	EV
	SPA
	JMP	ERR4
	LAC	(PRTBUF
	DAC	PRINT+4
/ 
/ PRINT NO. USER BLOCKS AND NO. FREE BLOCKS
/  
	LAC	(MSG1	/PRINT TOTAL NO. OF USER BLKS
	DAC	HEADER+4
	LAC	OCCBLK
	JMS	HEAD
	CAL	HEADER
	CAL	WAITFR
	LAC	EV
	SPA
	JMP	ERR4
	LAC	(MSG2	/PRINT NO. OF FREE BLKS.
	DAC	HEADER+4
	LAC	OCCBLK
	TCA
	TAD	TOTBLK
	JMS	HEAD
	CAL	HEADER
	CAL	WAITFR
	LAC	EV
	SPA
	JMP	ERR4
	LAC	(MSG3	/PRINT A BLAND LINE FOR SPACING
	DAC	HEADER+4
	CAL	HEADER
	CAL	WAITFR
	LAC	EV
	SPA
	JMP	ERR4
	ISZ	FLAG		/SET FLAG SO FREE BLK PRINTOUT WILL
				/NO BE DONE NEXT TIME THRU THIS ROUTINE
/
/ CONVERT THE FILE ENTRY INFORMATION AND PACK IT IN IMAGE ASCII FORM IN THE
/ PRINT BUFFER.
/
LOC4	LAW	-37		/THERE ARE 37 FILE ENTRIES PER UFD BLOCK.
	DAC	NTRIES
	LAC	(BUF)
	AND	(7777)
/
NXNTRY	PAX
	DAC	XRVAL
	LAC	(PRTBUF+1)	/SETUP STORAGE POINTER.
	DAC	TEMP10
/
/ CHECK FOR AN EMPTY FILE ENTRY, I.E., A NULL FILE NAME.
/
	LAC	0,X
	SZA
	JMP	OK
	SAD	1,X
	JMP	EMPTY		/EMPTY SLOT.
/
	.EJECT
/ CONVERT THE FILE ENTRY INFORMATION.
/
OK	IDX	LINCNT		/AUGMENT THE COUNT OF THE NUMBER OF
				/PRINTOUT LINES.
	LAC	(024003)	/SET THE PRINT BUFFER HEADER FOR A SHORT
	DAC	PRTBUF		/LINE (SEQUENTIAL ACCESS FILE ENTRY).
	LAC	0,X		/FIL
	JMS	SIXBIT
	LAC	1,X		/NAM
	JMS	SIXBIT
	JMS	SPACE
	LAC	2,X		/EXT
	JMS	SIXBIT
	JMS	SPACE
	LAC	3,X		/FILE'S 1ST BLOCK #.
	AND	(377777)
	JMS	OCTAL		/CONVERT TO 6 DIGITS -- SUPPRESS LEADING 0'S.
	JMS	SPACE
	LAC	4,X		/NUMBER OF BLOCKS IN THE FILE.
	AND	(377777)	/MASK OFF THE FILE TYPE BIT.
	JMS	OCTAL
	JMS	SPACE
	LAC	7,X		/DATE: MM/DD/YY, WHERE YY=0 FOR 1970.
	LRS	6		/DAY.
	AND	(77)
	JMS	TWODIG		/CONVERT TO 2 DIGITS -- SUPPRESS LEADING 0.
	LAC	(55)		/- (HYPHEN).
	IDX	TEMP10
	DAC*	TEMP10
	LAC	7,X
	LRS	14		/MONTH.
	AND	(17)
	TAD	(MONTAB-1)
	DAC	TEMP11
	IDX	TEMP11
	LAC*	TEMP11
	JMS	SIXBIT
	LAC	(55)		/- (HYPHEN).
	IDX	TEMP10
	DAC*	TEMP10
	LAC	7,X
	AND	(77)		/YEAR.
	.DEC
	AAC	-30
	SPA
	AAC	100
	.OCT
	JMS	TWODIG		/CONVERT TO 2 DIGITS -- SUPPRESS LEADING 0.
	LAC	4,X		/WHAT TYPE OF FILE IS IT?
	SPA
	JMP	RNDFIL		/RANDOM ACCESS.
SEQFIL	LAC	3,X		/SEQUENTIAL ACCESS -- TRUNCATED FILE?
	SMA
	JMP	FILEOK		/NO.
	JMS	SPACE		/YES.
	LAC	(52)		/*
	IDX	TEMP10
	DAC*	TEMP10
	JMP	FILOK1
FILEOK	IDX	TEMP10
	LAC	(40
	DAC*	TEMP10
	IDX	TEMP10
	DAC*	TEMP10
FILOK1	LAC	(15)		/CAR. RET.
	IDX	TEMP10
	DAC*	TEMP10
	LAC	(12)		/LINE FEED.
	IDX	TEMP10
	DAC*	TEMP10
	JMP	PRNTIT		/PRINT IT.
/
/ RANDOM ACCESS FILE.
/
RNDFIL	JMS	SPACE
	LAC	5,X		/ACCOUNTING INFO. WORD 1.
	JMS	OCTAL
	JMS	SPACE
	LAC	6,X		/ACCOUNTING INFO. WORD 2.
	JMS	OCTAL
	LAC	(033003)	/SET THE HEADER IN THE PRINT BUFFER FOR
	DAC	PRTBUF		/A LONGER, RANDOM ACCESS LINE.
/
/ PRINT DIRECTORY LINE.
/
PRNTIT	CAL	PRINT
	CAL	WAITFR
	LAC	EV
	SPA
	JMP	ERR4		/ERROR DURING PRINTING.
/
/ MOVE ON TO THE NEXT ENTRY IN THE UFD BLOCK.
/
EMPTY	LAC	XRVAL
	AAC	+10
	ISZ	NTRIES
	JMP	NXNTRY
/
/ END OF UFD BLOCK REACHED. CHECK THE FORWARD DATA LINK TO SEE IF THERE ARE
/ MORE BLOCKS TO COME.
/
	LAC	BUF+377
	SAD	(-1)
	SKP
	JMP	NEXBLK
/
/ DETACH THE "PRINTER".
/
	CAL	DETACH
	CAL	WAITFR
	LAC	EV
	SAD	(-6)
	CLA			/"DETACH" UNIMPLEMENTED.
	SPA!CLA
	JMP	ERR5		/"DETACH" ERROR.
/
/ CHECK IF THE DIRECTORY IS EMPTY. IF SO, AN ERROR MESSAGE IS PRINTED
/ TO THAT EFFECT SIMPLY TO GIVE THE USER SOME VISIBLE RESPONSE.
/
	SAD	LINCNT
	JMP	ERR6		/YES.
/
/ DIRECTORY PRINTOUT COMPLETED. EXAMINE THE EVENT VARIABLE VALUE RETURNED
/ BY THE TRANSFER-COMMAND-LINE DIRECTIVE TO SEE IF THE LINE WAS TERMINATED
/ BY CARRIAGE RETURN (+2), ALTMODE (+1), OR IF THE LINE BUFFER IS TOO
/ SMALL (-16). REQUEST 'TDV...' UNLESS THE TERMINATOR WAS ALTMODE.
/
	LAC	XFEREV
	SAD	(1)
	SKP
EXIT	CAL	REQTDV		/REQUEST 'TDV...'.
	CAL	(10)		/EXIT.
/
	.EJECT
/ ERRORS.
/
ERR2	LAC	(MES2)		/NOT A LISTING DEVICE.
	SKP
ERR3	LAC	(MES3)		/DISK ERROR.
	SKP
ERR4	LAC	(MES4)		/PRINTOUT ERROR.
	DAC	TYPE+4
	LAC	EV
	DAC	ERRCOD
	CAL	DETACH		/DETACH THE "PRINTER".
	CAL	WAITFR
	JMP	TYPEIT
ERR1	LAC	(MES1)		/"ATTACH" ERROR.
	SKP
ERR5	LAC	(MES5)		/"DETACH" ERROR.
	SKP
ERR7	LAC	(MES7		/UFD NOT IN MFD
	SKP
ERR10   LAC     (MES10	/TDV READ ERROR
        SKP
ERR11   LAC     (MES11	/FORMAT ERROR
        SKP
ERR12   LAC     (MES12		/SPY ERROR
        SKP
ERR15	LAC	(MES15		/NON-EXISTANT DISK
	SKP
ERR13   LAC     (MES13		/DEVICE NOT A DISK
        SKP
ERR6	LAC	(MES6)		/EMPTY DIRECTORY.
	DAC	TYPE+4
	LAC	EV		/SAVE EV VALUE SO THAT SOMEONE MAY EXAMINE
	DAC	ERRCOD		/IT USING THE "OPEN" MCR FUNCTION.
TYPEIT	CAL	TYPE
	CAL	WAITFR
	JMP	EXIT
/
	.EJECT
MES1	004002; 0; .ASCII "DIR-ATTACH ERR"<15>
MES2	006002; 0; .ASCII "DIR-NOT A LISTING DEV"<15>
MES3	004002; 0; .ASCII "DIR-DISK ERR"<15>
MES4	005002; 0; .ASCII "DIR-PRINTOUT ERR"<15>
MES5	004002; 0; .ASCII "DIR-DETACH ERR"<15>
MES6	003002; 0; .ASCII "DIR-EMPTY"<15>
MES7	004002; 0; .ASCII "DIR-NOT IN MFD"<15>
MES10  004002; 0; .ASCII "TDV ERROR"<15>
MES11  005002; 0; .ASCII "FORMAT ERROR"<15>
MES12  004002; 0; .ASCII "SPY ERROR"<15>
MES15  005002; 0; .ASCII "NON-EXISTANT DISK"<15>
MES13  005002; 0; .ASCII "DEVICE NOT A DISK"<15>
MSG0	002003	/FF AND CR
	0
	14
	15
MSG1	013003		/ ###### USER BLOCKS
	0
	0
	0
	0
	0
	0
	0
	40
	125
	123
	105
	122
	40
	102
	114
	117
	103
	113
	123
	15
	12
MSG2	013003		/ ###### FREE BLOCKS
	0
	0
	0
	0
	0
	0
	0
	40
	106
	122
	105
	105
	40
	102
	114
	117
	103
	113
	123
	15
	12
MSG3	003003	/BLANK LINE
	0
	40
	40
	15
	12
	.EJECT
/ SUBROUTINE SIXBIT -- UNPACK THE 3 .SIXBT CHARACTERS IN THE AC, CONVERT
/ THEM TO ASCII, AND STORE THEM IN THE PRINT BUFFER.
/
/ CALLING SEQUENCE:
/
/	.SIXBT WORD IN THE AC
/	JMS	SIXBIT
/	(UNCONDITIONAL RETURN)
/
/ ALTERED REGISTERS:
/
/	AC, MQ & X10
/
SIXBIT	0
	LMQ
	JMS	BYTE
	JMS	BYTE
	JMS	BYTE
	JMP*	SIXBIT
/
BYTE	0			/SUBROUTINE USED BY "SIXBIT".
	CLA!CLL
	LLS	6		/GET NEXT .SIXBT CHARACTER FROM THE MQ.
	SZA			/CONVERT TO ASCII.
	AAC	40
	AND	(77)
	AAC	40
	IDX	TEMP10
	DAC*	TEMP10
	JMP*	BYTE
/
/ SUBROUTINE SPACE -- STORE A "SPACE" CHARACTER IN THE PRINT BUFFER.
/
/ CALLING SEQUENCE:
/
/	JMS	SPACE
/	(UNCONDITIONAL RETURN)
/
/ ALTERED REGISTERS:
/
/	AC & X10
/
SPACE	0
	LAC	(40)		/A "SPACE".
	IDX	TEMP10
	DAC*	TEMP10
	JMP*	SPACE
/
/ SUBROUTINE LOOKUP -- SPY THE ADDRESS IN THE AC ON ENTRY
/
/ CALLING SEQUENCE -- LAC ADDR; JMS LOOKUP
/ 
/ ON RETURN AC HAS VALUE IN ADDRESS, IF ERROR JMP TO ERR12
/
LOOKUP  0
        DAC     SPY+2
        DZM     SPY+3
        CAL     SPY
        LAC     EV
        SPA
        JMP     ERR12
        LAC     SPY+3
        JMP*    LOOKUP
/
/ SUBROUTINE GETU -- GET A CHAR OF UFD NAME AND CHECK FOR LINE TERM
/
GETU	0
	JMS	FAC		/GET A CHAR
	SAD	(15		/IF LINE TERM -- DECLARE ERROR
	JMP	ERR11
	SAD	(175
	JMP	ERR11
	AND	(77
	JMP*	GETU
	.EJECT
/ SUBROUTINE OCTAL -- CONVERT THE NUMBER IN THE AC INTO 6 OCTAL DIGITS IN
/ ASCII, SUBSTITUTING SPACES FOR LEADING ZEROS. STORE THEM IN THE PRINT BUFFER.
/
/ CALLING SEQUENCE:
/
/	NUMBER IN THE AC
/	JMS	OCTAL
/	(UNCONDITIONAL RETURN)
/
/ ALTERED REGISTERS:
/
/	AC, MQ & X10
/
OCTAL	0
	LMQ
	LAW	-6		/SET COUNT FOR 6 DIGITS.
	DAC	DIGCNT
	DZM	ZFLAG		/INITIALIZE THE "LEADING ZERO SUPPRESS" FLAG.
AGAIN	CLA!CLL
	LLS	3		/GET NEXT DIGIT.
	SZA			/IS IT A 0?
	IDX	ZFLAG		/NO -- INDICATE SIGNIFICANT DIGIT ENCOUNTERED.
	SZA
	JMP	NONZER
	LAW	-1		/IS THIS THE LAST DIGIT?
	SAD	DIGCNT
	JMP	LAST0		/YES -- ALWAYS PRINT IT.
	LAC	ZFLAG		/NO -- SUPPRESS LEADING 0 IF ZFLAG=0.
LAST0	SZA!CLA
NONZER	AAC	20		/CONVERT TO ASCII.
	AAC	40
	IDX	TEMP10
	DAC*	TEMP10
	ISZ	DIGCNT
	JMP	AGAIN
	JMP*	OCTAL
/
/ SUBROUTINE XADJ -- ADJUST THE XR
/   
/ CALLING SEQUENCE:
/  
/	ADDRESS IN AC
/	JMS     XADJX
/	(UNCONDITIONAL RETURN)
/    
/ ALTERED REGISTERS:
/  
/	AC & XR
/   
XADJ    0
        TAD     XRADJ
        PAX
        JMP*    XADJ
	.EJECT
/  
/
/       S.R. TO GET A DEVICE NAME AND UNIT NUMBER
/       ON RETURN GN1 HAS 1ST HALF OF NAME AND GN2 HAS UNIT NUMBER
/	GN3 HAS THE NAME OF THE UIC
/       IF ANY ERRORS ARE DETECTED RETURN AT JMS+1
/       IF NO ERRORS ARE DETECTED RETURN AT JMS+2 WITH AC=NEXT CHAR.
/
GETDEV	0
	DZM	GN1	/INIT. NAME AND UNIT NO.
	DZM	GN2
	CLC		/INIT. FLAG -- SPACES NOW LEGAL
	DAC	GNNFLG
	JMS	GDSR /GET 1ST LETTER
	ALS	14
	DZM	GNNFLG	/CLEAR FLAG -- SPACES NOW ILLEGAL
	DAC	GN1	/SAVE CHAR.
	JMS	GDSR /GET 2ND CHAR
	ALS	6
	TAD	GN1
	DAC	GN1	/SAVE NAME OF DEVICE
	JMS	NEXT /GET NEXT CHAR
	JMS	NUMCK	/MAKE SURE IT'S A NO.
	DAC	GN2	/SAVE UNIT NO.
	JMS	NEXT /GET NEXT CHAR
	JMS	NUMCK	/MAKE SURE IT'S A NO.
	DAC	GNTEMP	/CONVERT 2 DIGIT DECI NO. INTO OCATL
	CLL
	LAC	GN2
	MUL
	12
	LACQ
	TAD	GNTEMP
	DAC	GN2	/SAVE UNIT NO.
        JMS     FAC
	JMP	GDOK /PREPARE TO RETURN
/
/       S.R. TO GET NEXT NUMERICAL CHAR.
/
NEXT	0
        JMS     FAC
	SAD	(40	/SPACE?
	JMP	GDOK /YES
	SAD	(175 /NO -- ALTMODE?
	JMP	GDOK /YES
	SAD	(15	/NO -- CR?
	JMP	GDOK /YES
	DAC	GNTEMP	/NO -- SAVE CHAR
	JMP*	NEXT
/
/       S.R. TO CHECK TO SEE NUMBER IS REALLY A NUMBER
/       ON ENTRY AC HAS ASCII OF DIGIT
/       ON EXIT AC HAS OCTAL VALUE OF DIGIT
/       ERRORS FORCE A JMP TO GDERR
/
NUMCK	0
	TAD	(-60
	SPA
	JMP	GDERR	/ERROR IF ASCII<60
	LAC	GNTEMP
	TCA
	TAD	(71
	SPA
	JMP	GDERR	/ERROR IF ASCII>71
	LAC	GNTEMP
	AND	(17	/OK -- AC CONTAINS OCTAL NO.
	JMP*	NUMCK
/
/       S.R. TO CHECK THAT CHARACTER IS A LETTER
/       ON EXIT AC HAS SIXBT OF CHAR
/       ERRORS RESULT IN A JMP TO GDERR
/
GDSR	0
        JMS     FAC
	DAC	GNTEMP
	SAD	(40	/SPACE?
	JMP	GDSPAC	/YES
	SAD	(15	/NO -- CR?
	JMP*	GETDEV	/YES -- RETURN AT JMS+1
	SAD	(175 /NO -- ALTMODE?
	JMP*	GETDEV	/YES -- RETURN
	LAC	(-101	/NO
	TAD	GNTEMP
	SPA
	JMP	GDERR	/ERROR IF ASCII<101
	LAC	GNTEMP
	TCA
	TAD	(132
	SPA
	JMP	GDERR	/ERROR IF ASCII>132
	LAC	GNTEMP
	AND	(77
	CLL
	JMP*	GDSR
GDSPAC	LAC	GNNFLG /IS THE SPACE LEGAL?
	SZA
	JMP	GDSR+1	/YES
GDERR	LAC	GNTEMP	/ERROR
	JMP*	GETDEV
GDOK	ISZ	GETDEV	/OK -- RETURN AT JMS+2
	JMP*	GETDEV
/  
/  
/  
/  
/ SUBROUTINE FAC -- STANDARD TDV LINE BUFFER UNPACKER
/  
/  
FAC     0
        LAC*    FACCBX
        SMA
        JMP     FAC2
        LAC     (FACCB-1
        DAC     FACCBX
        LAC*    FACLBX
        ISZ     FACLBX
        LMQ
        CLA!CLL
        JMS     FACUPS
        JMS     FACUPS
        JMS     FACUPS
        LAC*    FACLBX
        ISZ     FACLBX
        LRS     17
        XOR*    FACCBX
        DAC*    FACCBX
        CLA
        JMS     FACUPS
        JMS     FACUPS
        LAC     (FACCB
        DAC     FACCBX
        LAC*    FACCBX
FAC2    SAD     (15
        JMP*    FAC
        SAD     (175
        JMP*    FAC
        ISZ     FACCBX
        JMP*    FAC
/  
FACUPS  0
        LLS     7
        ISZ     FACCBX
        DAC*    FACCBX
        CLA
        JMP*    FACUPS
FACLBX  FACLB+2
FACCBX  FACCB+5
FACCB   .BLOCK 5
        -1
/  
FACLB   .BLOCK 22
        .ASCII <15>
/  
/ SUBROUTINE TWODIG -- CONVERT THE NUMBER IN THE AC INTO 2 DECIMAL DIGITS
/ IN ASCII, SUBSTITUTING A SPACE FOR A LEADING ZERO. STORE THEM IN THE
/ PRINT BUFFER.
/
/ CALLING SEQUENCE:
/
/	NUMBER IN THE AC
/	JMS	TWODIG
/	(UNCONDITIONAL RETURN)
/
/ ALTERED REGISTERS:
/
/	AC, MQ & X10
/
TWODIG	0
	CLL
	IDIV			/DIVIDE NUMBER BY 10.
	.DEC
	10
	.OCT
	PAL			/SAVE REMAINDER IN LR.
	LACQ			/CONVERT AND STORE DIGIT 1.
	AAC	60
	IDX	TEMP10
	DAC*	TEMP10
	PLA			/CONVERT AND STORE DIGIT 2.
	AAC	60
	IDX	TEMP10
	DAC*	TEMP10
	JMP*	TWODIG
/  
/  
/ SUBROUTINE CONVRT -- CONVERT A BLOCK NUMBER INTO A DISK ADRESS
/			AND PLATTER NUMBER.
/ 	THE AC MUST HAVE THE BLOCK NUMBER ON ENTRY
/  
/  
CONVRT	0
	LMQ
	LAC	DEVICE
	SAD	(2
	JMP	RF2
	CLL
	LLSS!ECLA 10
	DAC	GETCTB+0
	LACQ
	DAC	GETCTB+1
	LAC	UNIT
	CLL
	ALS	17
	TAD	GETCTB+0
	DAC	GETCTB+0
	JMP*	CONVRT
RF2	LACQ
	DAC	TEMP
	CLL
	LRS	12
	DAC	GETCTB+0
	LAC	TEMP
	AND	(1777
	ALS	10
	DAC	GETCTB+1
	JMP*	CONVRT
/  
/  
/ SUBROUTINE HEAD -- CONVERTS NO. IN AC INTO ASCII AND PUTS INTO BUFFER
/  
/  
HEAD	0
	LMQ
	LAC	HEADER+4
	IAC
	DAC	TEMP10
	LAW	-6
	DAC	TEMP
	CLA!CLL
	LLS	3
	AAC	60
	IDX	TEMP10
	DAC*	TEMP10
	ISZ	TEMP
	JMP	.-6
	JMP*	HEAD
/
MONTAB=.-1			/TABLE OF MONTHS.
	.SIXBT	/JAN/
	.SIXBT	/FEB/
	.SIXBT	/MAR/
	.SIXBT	/APR/
	.SIXBT	/MAY/
	.SIXBT	/JUN/
	.SIXBT	/JUL/
	.SIXBT	/AUG/
	.SIXBT	/SEP/
	.SIXBT	/OCT/
	.SIXBT	/NOV/
	.SIXBT	/DEC/
/
	.EJECT
WAITFR	20			/"WAITFOR" CPB.
	EV
/
HINF	3600			/"HINF" CPB.
	EV
	TDVOUT			/TDV LISTING OUTPUT LUN.
/
ATTACH	2400			/"ATTACH" CPB.
	EV
	TDVOUT			/TDV LISTING OUTPUT LUN.
/
DETACH	2500			/"DETACH" CPB.
	EV
	TDVOUT			/TDV LISTING OUTPUT LUN.
/
GET	13000			/"GET DISK BLOCK" CPB.
	EV
	DSKLUN			/DISK I/O DRIVER LUN.
	GETCTB
DEVICE  0			/DEVICE INDICATOR
GETCTB	XX			/PLATTER.
	XX			/DISK ADDRESS.
	BUF			/CORE ADDRESS.
	400			/WORD COUNT.
/
PRINT	2700			/"WRITE" CPB.
	EV
	TDVOUT			/TDV LISTING OUTPUT LUN.
	3			/IMAGE ASCII DATA MODE.
	PRTBUF
/
PRTBUF	024003			/PRINT LINE BUFFER.
	0
	.BLOCK	62
	15			/CARRIAGE RETURN.
	12			/LINE FEED.
/
UFDBUF	6003
	0
	.BLOCK	7
	40
	15
	12
/
HEADER	2700
	EV
	TDVOUT
	3
	XX
/
SPY     31			/SPY CAL
	EV
	XX
	0
/ 
TYPE	2700			/"WRITE" CPB.
	EV
	TDVTTY			/TDV TTY ERROR LUN.
	2			/IOPS ASCII DATA MODE.
	XX			/MESSAGE ADDRESS.
/
REQTDV	1			/"REQUEST" CPB.
	0
	.SIXBT	"TDV"
	.SIXBT	"..."
	0			/USE THE DEFAULT PRIORITY.
/
XFER	37			/"TRANSFER TDV COMMAND LINE" CPB.
	EV
	FACLB			/BUFFER ADDRESS.
	22			/BUFFER SIZE.
/
XFEREV	0			/EVENT VARIABLE VALUE RETURNED BY THE
				/"XFER" DIRECTIVE.
EV	0			/EVENT VARIABLE.
NTRIES	0			/COUNTER FOR UFD FILE ENTRIES.
XRVAL	0			/SAVED LOOP VALUE OF THE XR.
DIGCNT	0			/DIGIT COUNTER.
ZFLAG	0			/"LEADING ZERO SUPPRESS" FLAG -- SET NON-0
				/WHEN A SIGNIFICANT DIGIT IS ENCOUNTERED.
LINCNT	0			/COUNT OF THE NUMBER OF LINES IN THE
				/PRINTOUT. USED TO DETECT AN EMPTY DIRECTORY.
ERRCOD	0			/EV VALUE SAVED BEFORE ERROR PRINTOUT IN
				/CASE SOMEONE WANTS TO EXAMINE IT USING
				/THE "OPEN" MCR FUNCTION.
TEMP    0			/TEMPORARY STORAGE
UNIT    0			/UNIT NUMBER OF DISK
XRADJ   0			/XR ADJUST FACTOR
TERM    0			/MISC. VARIABLES
GN1     0
GN2     0
NAME1   0
NODEAD  0
ADJXR   0
GNNFLG  0
GNTEMP  0
OCCBLK	0
STARTB	0
SATCNT	0
TOTBLK	0
FLAG	0
TEMP10  0
TEMP11  0
TEMP1	0
UFD	0
/
BUF	.BLOCK	400
/
	.END	DIR
