	.title	dirset
	.ident	"V2.0"
	.enabl	lc
	.nlist	bex,cnd
;
; This routine has no GETRNO documentation as it is
; an "internal" subroutine for setfnb().
;
; This file contains the code for determining and looking up a
; User File Directory file (UFD). It checks the FNB pointed to by
; R0 on entry for the NB.DIR bit set in N.STAT. If so, it assumes
; that the N.DID and N.DID+2 fields contain a RAD50 UFD filename.
; If the NB.DIR bit is off, it does a GTSK$ to determine the current
; task UIC, which is then converted to RAD50 UFD name form. Finally
; it looks up the UFD in the MFD and places the UFD file ID in the
; N.DID field of the user's FNB (Have a few 3-letter abbreviations!).
;
;
; Edits:
; X01.01 ??-Jul-81 RBD	Creation
; X01.02 30-Jul-81 RBD	Pass LUN in R1.
; V01.02 26-Aug-82 RBD	P-section changes for CX
; V01.03 20-Oct-82 RBD	Remove CSD copyright notice.  Release to
;			public domain for new DECUS C kit.
; V02.00 21-Jan-83 TTC	Add P/OS GTDIR$ support for directory defaulting
;
	.mcall	dir$	qiow$s	gtsk$s	nbof$l
	nbof$l

	.psect	c$code		;*** UGLY IMPURE CODE!!!! ***
;
; P/OS "Get Default Directory"  --  Fails on RSX
;
gdir:	.byte	207.,6			; GTDIR$ DIC and DPB size
	.byte	4			; Subfunction code for GET
	.byte	0			; "Modifier" (?)
	.word	0			; Reserved
	.word	ens			; Equivalence name string goes here
	.word	enssz			; Maximum length (buffer size)
	.word	rsize			; Actual length of equiv. string
;
; P/OS Equivalence string buffer
;
ens:	.blkb	82.
enssz = .-ens			        ; Maximum length (buffer size)
	.even
rsize:	.word	0


	.psect	c$code


	.sbttl	SUBRTN	- Determine and look up UFD
;
; -DIRSET- Determine and look up User File Directory
;
; Inputs:
;	r0 --> User's FNB as set up by PARSE and DEVSET
;	r1  =  LUN of device to do lookup on
;
; Outputs:
;   C-bit clear:
;	r0 --> User's FNB
;	N.DID field contains file ID of directory (DID)
;   C-bit set:
;	Directory access error
;
dirset::
	call	$saval			; In SYSLIB, we need R5
	mov	r0,r5			; r5 --> user's FNB
;
; Create and initialize a local FNB.
;
	mov	#s.fnbw,r0		; r0 = size of fnb, words
10$:	clr	-(sp)			; Create a clear FNB on stack
.if ndf c$$nhd
	sob	r0,10$
.iff
	dec	r0
	bne	10$
.endc
	mov	sp,r4			; r4 --> re-entrant FNB
	add	#n.fnam,r4		; r4 --> N.FNAM field
;
; Fill in from user FNB if it has a specified UFD name.
;
	bit	#nb.dir,n.stat(r5)	; User UFD name?
	beq	20$			; (no)
	mov	n.did(r5),(r4)+		; Yes, copy to N.FNAM locally
	mov	n.did+2(r5),(r4)+
	mov	n.did+4(r5),(r4)+
	br	60$			; Finish in common code
;
; Determine current task directory.
;
20$:	DIR$	#gdir			; Try P/OS directive first.
	cmp	$dsw,#IS.SUC		; Successful?
	bne	25$			; No, try standard RSX.
	mov	#ens,r1			; Yes, pick up directory string
	mov	r1,r0			; r0 --> string
	add	rsize,r1		; Tack on a null.
	clrb	(r1)
	clr	r1			; Get ready to convert
	tstb	(r0)+			; Scan past "["
	call	$cat5			; Convert first three chars to RAD50
	mov	r1,(r4)+		; Put in the FNB
	bcs	23$			; Branch if all converted
	clr	r1			; Get ready to convert
	call	$cat5			; Convert second three
	mov	r1,(r4)+		; Put in FNB
	bcs	24$			; Branch if all converted
	clr	r1			; Get ready to convert
	call	$cat5			; Convert third three
	mov	r1,(r4)+		; Put in FNB
	br	60$			; Branch to code for UFD lookup
23$:	clr	(r4)+
24$:	clr	(r4)+
	br	60$

25$:	sub	#32.,sp			; Create a GTSK parameters buffer
	mov	sp,r3			; r3 --> buffer
	GTSK$S	r3			; Get task parameters (no error)
	mov	16(r3),r2		; r2 = task UIC (binary)
	add	#32.,sp			; Cut off buffer

;
; Convert binary UIC in r2 to 2 RAD50 words <-- R1.
; of local FNB.
;
	call	30$			; Convert proj. number
	mov	r0,(r4)+		; Put it into the FNB
	mov	#50$,-(sp)		; Convert prog. number	fall thru.
30$:	clr	r0			; Initialize RAD50
	clr	r3			; Clear accumulator
	call	40$			; Convert high octal digit
	call	(PC)			; Convert 2 remaining octal digits
.if ndf c$$nhd
	mul	#50,r0
	mov	r1,r0			; Pick up LSH of product
.iff
	mov	r0,-(sp)		; RAD50 form of octal digit
	asl	r0			; 2N
	asl	r0			; 4N
	add	(sp)+,r0		; N+4N=5N
	asl	r0			; 12N		(octal)
	asl	r0			; 24N		(octal)
	asl	r0			; 50N		(octal)
.endc
	clr	r3			; Get ready for next octal digit
	asl	r2			; Shift 1 bit from r2
	rol	r3			;  into r3
40$:	asl	r2
	rol	r3
	asl	r2
	rol	r3
	add	#36,r3			; Adjust by RAD50 "0"
	add	r3,r0			; Accumulate result
	return
50$:	mov	r0,(r4)+		; Store second RAD50 word.
	clr	(r4)+			; 3rd RAD50 name word = blank
;
; Now complete setting up the local FNB for looking up the UFD in
; the MFD. The MFD has a file ID of (4,4) on RSX-11M/M+.
;
60$:	mov	#^RDIR,(r4)+		; File extension is "DIR"
	mov	#1,(r4)+		; Version # = 1
	clr	(r4)+			; Status bits cleared
	clr	(r4)+			; "next" field cleared
	mov	#4,(r4)+		; MFD directory ID = <4,4>
	mov	#4,(r4)+
	clr	(r4)+			; ??? third word of DID
	mov	n.dvnm(r5),(r4)+	; Device name
	mov	n.unit(r5),(r4)+	; Unit
;
; Finally, look up the UFD file in the MFD and return the UFD's
; file ID to the caller's FNB in the N.DID field. Use the input
; file LUN.
;
	mov	s.fnb+4(sp),r0		; Recover LUN
	mov	sp,r4			; r4 --> local FNB again
	sub	#4,sp			; Create an IOSB
	mov	sp,r1			; r1 --> IOSB
	QIOW$S	#io.fna,r0,#ef.fcs,,r1,,<,,,,,r4>
	bcs	errxit
	cmpb	(r1),#is.suc
	bne	errxit
	add	#n.did,r5		; r5 --> DID field in user's FNB
	mov	(r4)+,(r5)+		; Copy Directory FID to user FNB
	mov	(r4)+,(r5)+
	mov	(r4)+,(r5)+
;
; Returns.
;
	add	#s.fnb+4,sp		; Cut off the local FNB/IOSB
	clc
	return

errxit:	add	#s.fnb+4,sp
	sec
	return

	.end
