	.title	dsklup	return the ascii filespec string of next file

	section	$code

;	Copyright (C) 1978 1979 1980 1981 1982 1983   Change Software, Inc.
;	
;	This software is furnished in  an  as-is
;	condition,  with no committments of sup-
;	port or updates.  This software may  NOT
;	be sold for profit nor can it be includ-
;	ed in any package to be sold for  profit
;	without  the  written consent of the au-
;	thor.  This software may  be  used  only
;	within the above conditions of use.
;	
;	The information in contained  herein  is
;	subject  to  change  or  revision at any
;	time without notice.
;	
;	
;	
;
;
;	D S K L U P
;
;	Do disk wildcard lookups for TED on RSTS and RSX

	.iif ne	,rsx11m	, .enabl gbl

	.sbttl	DSKLUP for RSTS

	.if	eq	,rsx11m!rt11
	.ift


;	D S K L U P
;
;	input:	@r5	wildcard filespec
;		@2(r5)	index for lookup
;
;	output:	@4(r5)	.asciz string of the filename
;		r0	= 1	filespec not wildcarded
;			= 0	success
;			< 0	negative of fip error code


	w$bits == 2 ! 4 ! 40 ! 100	; wildcard bits from .fss

stduic::.byte	200			; disallow wildcardign if
	.even				; programmer number ge.


dsklup::save	<r1,r2,r3,r4,r5>	; save temps please

10$:	.priv				; for compatibilty please
	.stat				; get ppn out please
	clr	r0			; assume priv
	cmpb	xrb+11	,#1		; a priv user here ?
	beq	20$			; yes
	mov	xrb+10	,r0		; no, flag for ppn clear later

20$:	calls	$fscan	,<@r5>		; see if any wildcards in name
	iferr	110$			; oops
	bit	#w$bits	,xrb+10		; check it out for ? or *
	beq	100$			; no
	movb	#ed.badn,errsav		; preset bad filename first
	cmpb	r0	,stduic		; 'student account' here ?
	bhis	110$			; yes, flag bad filename.
	tst	r0			; user in a priv account ?
	beq	30$			; yes
	clr	firqb+fqppn		; no, clear ppn field out.
30$:	mov	@2(r5)	,firqb+4	; where it must be put
	movb	#lokfq	,firqb+fqfun	; wildcard lookup function
	.priv				; for compatibilty please
	calfip				; very easy to do
	movb	firqb	,errsav		; find one ?
	bne	110$			; no
	calls	filcnv	,<4(r5)>	; convert the name over
	clr	r0			; return success
	br	120$			; exit

100$:	calls	filcnv	,<4(r5)>	; convert to asciz anyway
	mov	#1	,r0		; say file not wildcarded
	br	120$			; and exit


110$:	tstb	errsav			; a real error set ?
	bne	115$			; yes
	movb	#ed.eof	,errsav		; fake an error
115$:	mov	errsav	,r0		; return minus of error in r0
	neg	r0			; and exit
120$:	unsave	<r5,r4,r3,r2,r1>	; pop temps and exit
	return				; bye

	.endc				; if eq, rsx11m (ie, for RSTS)

	.sbttl	convert firqb to filespec for RSTS

	.if eq	,rsx11m!rt11
	.ift


filcnv:	mov	@r5	,r2		; address to return filename
	mov	#firqb+fqdev,r1		; convert device name first
	movb	(r1)+	,(r2)+		; first of it
	movb	(r1)+	,(r2)+		; last character of devnam
	bne	10$			; something was there
	movb	#'Y	,-(r2)		; nothing was there, return
	movb	#'S	,-(r2)		; 'SY0:' then
	cmpb	(r2)+	,(r2)+		; fix output buffer pointer
10$:	movb	(r1)+	,r0		; unit number in binary
	tstb	@r1			; unit number real ?
	beq	20$			; no, force explicit unit zero
	add	#'0	,r0		; concert to ascii
	movb	r0	,(r2)+		; and return it to the buffer.
20$:	movb	#':	,(r2)+		; all done with the device name
	tst	firqb+fqppn		; a real ppn here ?
	beq	30$			; no, do not create [0,0] string
	movb	#'[	,(r2)+		; stuff the start of the ppn in
	mov	r2	,-(sp)		; now convert the project number
	movb	firqb+fqppn+1,-(sp)	; at last
	call	deccvt			; convert to decimal now
	call	200$			; and throw away leading zeroes
	movb	#',	,(r2)+		; and so on
	mov	r2	,-(sp)		; now convert the programmer #
	movb	firqb+fqppn+0,-(sp)	; at last
	call	deccvt			; convert to decimal now
	call	200$			; and throw away leading zeroes
	movb	#']	,(r2)+		; all done with the ppn now.
30$:	calls	rdtoa	,<r2,firqb+fqnam1+0>; convert first 3 characters
	add	#3	,r2		; of filename and fix pointer.
	calls	rdtoa	,<r2,firqb+fqnam1+2>; convert last  3 characters
	add	#3	,r2		; of filename and fix pointer.
	movb	#'.	,(r2)+		; need a dot in filename please
	calls	rdtoa	,<r2,firqb+fqnam1+4>; convert the rad50 filetype
	add	#3	,r2		; of the filename and fix pointer
	clrb	(r2)+			; all done
	return


200$:	mov	#3	,r0		; assume 3 characters in unit
	cmpb	@r2	,#'0		; leading zero here ?
	bne	210$			; no
	movb	1(r2)	,@r2		; yes, shuffle things down
	movb	2(r2)	,1(r2)		; and check for next space
	dec	r0			; only 2 characters in unit
	cmpb	@r2	,#'0		; still a zero around ?
	bne	210$			; no
	movb	1(r2)	,@r2		; yes, unit # must be < 10
	dec	r0			; only 1 character in unit #
210$:	add	r0	,r2		; move the buffer pointer now
	return

	.endc				; for RSTS

	.sbttl	fake lookup for real rt11


;	for now, simply copy input to output and flag success
;	but no wildcarding.

	.if ne	,rt11
	.ift

dsklup::save	<r1,r2,r3>
	mov	@r5	,r1
	mov	4(r5)	,r2
10$:	movb	(r1)+	,(r2)+
	bne	10$
	mov	#1	,r0
	unsave	<r3,r2,r1>
	return

	.endc


	.sbttl	dsklup for RSX

	.if ne	,rsx11m
	.ift

;	D S K L U P
;
;	input:	@r5	wildcard filespec
;		@2(r5)	index for lookup
;
;	output:	@4(r5)	.asciz string of the filename
;		r0	= 1	filespec not wildcarded
;			= 0	success
;			< 0	dir/fcs error code

	fsize	=	40.
	fdbsiz	=	150.

	.mcall	fdop$r	,csi$1	,csi$2	,nmblk$	,csi$	,gtsk$s

	csi$
defnam:	nmblk$	,,0,SY,0
	.even

	.psect	$code


dsklup::call	gettsk			; real rsx or ame under vms?
	cmpb	r0	,#5		; if eq 5, must be vms
	bne	1$			; rsx
	call	vmslup			; do it for vms instead
	return

1$:	save	<r1,r2,r3,r4,r5>
	clr	errsav
	sub	#fdbsiz	,sp		; allocate fdb on the stack
	mov	sp	,r4		; use r5 to point to it
	mov	#fdbsiz	,r0		; and clear the new fdb out
5$:	clrb	(r4)+			; to avoid strange side effects
	sob	r0	,5$		; next, please
	mov	sp	,r4		; restore pointer to the fbd
	sub	#c.size+2,sp		; allocate a csi buffer
	mov	sp	,r3		; and a pointer to it.
	mov	4(r5)	,r2		; set up a pointer now.
	mov	r3	,-(sp)		; save pointer to csi block
	add	#c.dsds	,r3		; setup for fdop$ call
	fdop$r	r4,#2,r3,#defnam,<#fa.rd!fa.shr>
	mov	(sp)+	,r3		; pop pointer to the csi block
	clrb	@r2			; zap the new name
	mov	@r5	,r1		; point to input filename.
	clr	r0			; count length here
	mov	r2	,-(sp)		; save the filename pointer
10$:	cmpb	@r1	,#'/		; hit any switches yet ?
	beq	20$			; yes, stop copying then.
	inc	r0			; increment the length.
	cmp	r0	,#fsize-2	; overflow the tiny buffer?
	bhis	20$			; yep
	movb	(r1)+	,(r2)+		; no, continue copying name.
	bne	10$			; no end in sight yet
20$:	clrb	@r2			; insure null terminated.
	mov	(sp)+	,r2		; pop the filename pointer
	.len	r2			; get the length of the name
	mov	r0	,r1		; anything there at all ?
	beq	180$			; oops
	csi$1	r3,r2,r1		; now do the first scan.
	bcs	200$			; oops
	csi$2	r3,OUTPUT		; finish up the scan please
	bcs	200$			; oops

	save				; now parse the filename
	mov	r4	,r0		; setup for call to .parse
	mov	r4	,r1		; setup a pointer to the
	add	#f.fnb	,r1		; filename block
	mov	f.dspt(r4),r2		; where to get the filespec
	mov	#defnam	,r3		; defaults to be filled in.
	call	.parse			; parse it to get the rad50
	unsave				; and other stuff for the file
	bcs	210$			; oops

	calls	lokfl1	,<r4,2(r5)>	; call .find routine
	cmpb	r0	,#ie.nsf	; did we get a file not found?
	bne	80$			; no
	bit	#nb.svr!nb.stp!nb.snm,f.fnb+n.stat(r4) ; wildcarded ?
	beq	90$			; no, ignore the ie.nsf then
80$:	tst	r0			; any other error ?
	bne	210$			; yes, exit with the error in r0

90$:	calls	cvtfil	,<r4,4(r5)>	; no, convert to asciz string
	clr	r0			; and exit
	bit	#nb.svr!nb.stp!nb.snm,f.fnb+n.stat(r4) ;wildcarded ?
	beq	190$			; no, return appropiate status
	br	220$

180$:	clr	r0
	bisb	#ie.bnm	,r0		; null file name
	br	220$
190$:	mov	#1	,r0		; filename not wildcarded
	br	220$			; exit
200$:	movb	@#$dsw	,r0		; csi failure, exit
	bmi	220$			; a real directive error code
	clr	r0			; no error but c is set so
	bisb	#ie.bnm	,r0		; stuff bad filename in
	br	220$			; bye
210$:	mov	f.err(r4),r0

220$:	add	#fdbsiz+c.size+2,sp	; pop temp data and exit
	unsave	<r5,r4,r3,r2,r1>
	return

	.endc				; if ne, RSX11M

	.sbttl	special for vms compatibility mode


;	for now, simply copy input to output and flag success
;	but no wildcarding.


vmslup:	save	<r1,r2,r3>
	mov	@r5	,r1
	mov	4(r5)	,r2
10$:	movb	(r1)+	,(r2)+
	bne	10$
	mov	#1	,r0
	unsave	<r3,r2,r1>
	return


	.sbttl	lookup the file name, index # passed in r0

	.if ne	,rsx11m			; the hard way for RSX
	.ift


;	L O K F L 1
;
;	use .FIND to look up the file in the FBD
;
;	input:	@r5	the address of the FDB
;		2(r5)	the index of the file to look up
;
;
;	output:	r0	=	fcs error code
;		@f.fnb	=	the filename and FID of the file
;				(i.e., updated filename block)


lokfl1:	save				; save all temps please
	mov	@r5	,r0		; setup for .find
	mov	@r5	,r1		; setup a pointer to the
	mov	f.fnb+n.fver(r0),-(sp)	; save .parse's version #
	mov	f.fnb+n.stat(r0),-(sp)	; save filename status word
	add	#f.fnb	,r1		; filename block
	bis	#nb.ver!nb.svr,n.stat(r1); say wildcard file version
	mov	@2(r5)	,n.next(r1)	; stuff the index of the file
	call	.find			; now do a directory lookup
	mov	@r5	,r0		; address of the FDB
	mov	(sp)+	,f.fnb+n.stat(r0); pop .parse's status word
	bit	#nb.ver	,f.fnb+n.stat(r0); did .parse have a version?
	beq	10$			;  no
	bit	#nb.svr	,f.fnb+n.stat(r0); yes, was it wildcarded ?
	bne	10$			;  yes, leave .find's version#
	mov	(sp)+	,f.fnb+n.fver(r0); no, restore .parse's vers #
	br	15$			;  and exit

10$:	tst	(sp)+			;  ignore passed version #
15$:
	unsave
	bcs	200$			; oops
	mov	@r5	,r0		; address of the FDB
	mov	f.fnb+n.next(r0),@2(r5)	; update index now
	dec	@2(r5)			; fix for rsts compatibilty


;	Now that  .find has  returned the directory  information
;	for the n'th file in the directory matching the wildcard
;	spec, we will do a lookup by filename on the actual name
;	returned by .find so we  can specify an explicit version
;	of '0'  if no version number was passed, else just do it
;	again since we are not called very often.
;	This is  done (the second call) because .find has what I
;	would consider an absurd restriction in that the version
;	must be wildcarded  in order for the  wildcarding of the
;	name  or  filetype  to work.  This entire  mess could be
;	eliminated  if we  were working  on a real  time sharing
;	system (i.e., RSTS) that had all this garbage built into
;	executive.

	save				; now that we have the filename
	mov	@r5	,r0		; we can stuff version 0 into it
	mov	@r5	,r1
	mov	f.fnb+n.stat(r0),-(sp)	; save filename status word
	add	#f.fnb	,r1		; filename block
	bit	#nb.ver	,n.stat(r1)	; explicit version passed ?
	bne	20$			; yes, do not stuff version '0'
	bis	#nb.ver	,n.stat(r1)	; no, force a version passed
	clr	n.fver(r1)		; to be the most recent one.
20$:	clr	n.next(r1)		; we can only get one match.
	bic	#nb.svr!nb.stp!nb.snm,n.stat(r1); force lookup on file
	call	.find			; now do a directory lookup
	mov	@r5	,r0		; address of the FDB
	mov	(sp)+	,f.fnb+n.stat(r0); pop .parse's status word
	unsave				; pop all temps now
	bcs	200$			; oops
	clr	r0
	return

200$:	mov	@r5	,r0		; the fdb address
	mov	f.err(r0),r0		; return an error
	sec				; insure error
	return				; bye....

	.endc				; if ne, RSX11M

	.sbttl	octcvt	convert byte quantity to octal

	.if ne	,rsx11m
	.ift


;	O C T C V T
;
;	input:	2(sp)		number to convert
;		4(sp)		address of 3 char output string

octcvt:	save	<r0,r1,r2>		; always save temp regs
	clr	r1
	bisb	10(sp)	,r1		; number to convert to octal
	mov	12(sp)	,r2		; address of the output string
	clr	r0			; do a divide
	div	#10	,r0		; get number mod 8 in r1
	add	#'0	,r1		; and make it ascii
	movb	r1	,2(r2)		; and return the value
	mov	r0	,r1		; now get the rest of the byte
	clr	r0			; to convert
	div	#10	,r0		; last time
	add	#'0	,r1		; convert low  order to ascii
	add	#'0	,r0		; convert high order to ascii
	movb	r0	,(r2)+		; stuff high part
	movb	r1	,@r2		; and middle digit
	sub	#2	,r2
	unsave	<r2,r1,r0>		; pop temps
	mov	(sp)	,4(sp)
	add	#4	,sp		; pop parameter list and exit
	return

	.endc				; for RSX only



;	this one is for both RSX and RSTS
;
;	D E C C V T
;
;	input:	2(sp)		number to convert
;		4(sp)		address of 3 char output string

deccvt:	save	<r0,r1,r2>		; always save temp regs
	clr	r1
	bisb	10(sp)	,r1		; number to convert to decimal
	mov	12(sp)	,r2		; address of the output string
	clr	r0			; do a divide
	div	#10.	,r0		; get number mod 10 in r1
	add	#'0	,r1		; and make it ascii
	movb	r1	,2(r2)		; and return the value
	mov	r0	,r1		; now get the rest of the byte
	clr	r0			; to convert
	div	#10.	,r0		; last time
	add	#'0	,r1		; convert low  order to ascii
	add	#'0	,r0		; convert high order to ascii
	movb	r0	,(r2)+		; stuff high part
	movb	r1	,@r2		; and middle digit
	unsave	<r2,r1,r0>		; pop temps
	mov	(sp)	,4(sp)
	add	#4	,sp		; pop parameter list and exit
	return


	.sbttl	cvtfil	convert fileblock to .asciz string

	.if ne	,rsx11m
	.ift


;	C V T F I L
;
;	input:	@r5	fdb address
;	output:	@2(r5)	.asciz conversion
;
;	it's complex simply because of the fact that this is RSX
;
;	1. convert the device name and unit to ascii
;	2. take the passed fileid for the directory and lookup the
;	   name of the directory and convert it to ascii of a UIC.
;	3. convert the rad50 filename and filetype to ascii
;	4. convert the version to ascii if NB.VER is set in N.STAT



cvtfil:	save	<r0,r1,r2,r3>
	call	gettsk
	mov	r0	,r3
	mov	@r5	,r1		; get the fdb address
	add	#f.fnb	,r1		; and point to filename block
	mov	2(r5)	,r2		; point to destination

	movb	n.dvnm+0(r1),(r2)+	; insert the device name
	movb	n.dvnm+1(r1),(r2)+	; in ascii
	mov	r2	,-(sp)		; now convert unit number to
	cmpb	n.unit(r1),#377		; RSX emulation under RSTS will
	bne	5$			; return a 377 for the unit due
	clrb	n.unit(r1)		; to the way alun$s works.
5$:	mov	n.unit(r1),-(sp)	; ascii please
	
	call	300$			; do it
	call	200$
	movb	#':	,(r2)+		; done with device name

	
	mov	n.did(r1),-(sp)		;Save n.did for RSX	; HAH
	mov	n.did+2(r1),-(sp)	;Both words		; HAH
	cmp	#4,r3			;RSTS			; HAH
	beq	15$			;Yes			; HAH
	sub	#12,sp			;Need some space	; HAH
	mov	sp,r0			;Point to it		; HAH
	mov	r0,-(sp)		;Save pointer		; HAH
	tst	(r0)+			;Skip where to store	; HAH
	tst	(r0)+			; account file name	; HAH
	movb	#-5,(r0)		;low byte = file name	; HAH
	movb	#4,1(r0)		;high byte = 4 (return 4 bytes)
	mov	r0,2(r0)		;Save start of block	; HAH
	sub	#4,2(r0)		;Adjust to where to store ; HAH
					;File name		; HAH
	clr	4(r0)			;End of list		; HAH
	mov	r1,-(sp)		;Save FNB pointer	; HAH
	add	#n.did,r1		;Point to directory ID	; HAH
	.mcall	qiow$s			;			; HAH
	qiow$s	#io.rat,f.lun-f.fnb-n.did(r1),#32.,,,,<r1,r0>	; HAH
					;R1 points to FNB	; HAH
					;R0 points to list	; HAH
	rol	r3			;Save carry		; HAH
	mov	(sp)+,r1		;Point to FNB		; HAH
	mov	(sp)+,r0		;Point to UIC		; HAH
	mov	(r0)+,n.did(r1)		;Overwrite n.did for now; HAH
	mov	(r0)+,n.did+2(r1)	;Both words		; HAH
	add	#12,sp			;Clean stack		; HAH
	bit	#nb.dir	,n.stat(r1)	;really specified uic	; BDN
	beq	14$			;no, get current uic	; BDN
	ror	r3			;Restore error flag	; HAH
	bcs	14$			;Use saved account	; HAH
	call	r50ppn			;Convert direc. to binary;HAH
	br	25$			;Continue		; HAH
14$:	clr	n.did(r1)		;Force gtsk$		; HAH
	cmpb	r3	,#5		; vms			 BDN
	beq	30$			; yes, skip it		; BDN
15$:	tst	n.did(r1)		; a real uic in there ?
	bne	25$			; yes
	sub	#50	,sp		; no, get our current uic and
	mov	sp	,r0		; stuff it in there then
	gtsk$s	r0			; simple
	movb	g.tsgc(r0),n.did+1(r1)
	movb	g.tspc(r0),n.did+0(r1)
	add	#50	,sp

25$:	movb	#'[	,(r2)+
	mov	r2	,-(sp)		; stuff dest address first
	movb	n.did+1(r1),-(sp)	; then the byte to convert
	call	300$			; convert it to octal
	call	200$			; strip leading zeroes off
	movb	#',	,(r2)+
	mov	r2	,-(sp)		; stuff dest address first
	movb	n.did+0(r1),-(sp)	; then the byte to convert
	call	300$			; convert it to octal
	call	200$			; strip leading zeroes off
	movb	#']	,(r2)+		; all done with uic conversion
30$:	mov	(sp)+,n.did(r1)		;Restore true n.did	; HAH
	mov	(sp)+,n.did+2(r1)	; Both words		; HAH
					; for RSX only		; HAH

	calls	rdtoa	,<r2,<n.fnam+0(r1)>>
	add	#3	,r2
	calls	rdtoa	,<r2,<n.fnam+2(r1)>>
	add	#3	,r2
	calls	rdtoa	,<r2,<n.fnam+4(r1)>>
	add	#3	,r2
	movb	#'.	,(r2)+
	calls	rdtoa	,<r2,<n.fnam+6(r1)>>
	add	#3	,r2
	cmp	r3	,#4		; is this RSTS
	beq	100$			; yep, no versions allowed
	bit	#nb.ver	,n.stat(r1)	; not rsx, did they give an
	beq	100$			; explicit version. skip if not
	movb	#';	,(r2)+		; at last, get the version #
	mov	r2	,-(sp)		; converted to octal
	mov	n.fver(r1),-(sp)	;
	call	octcvt			; do it
	call	200$			; strip leading zeroes off
100$:	clrb	@r2			; make the string .asciz
	unsave	<r3,r2,r1,r0>		; pop temps and exit
	return

	global	<gettsk>

	.endc				; for RSX11M


	.sbttl	subroutines for filespec conversion to asciz

;	2 0 0 $
;
;	strip off leading '00' from a 3 digit ascii string
;	output:   updated r2 pointer to the next free space

	.if ne	,rsx11m
	.ift				; for RSX


200$:	mov	#3	,r0		; assume 3 characters in unit
	cmpb	@r2	,#'0		; leading zero here ?
	bne	210$			; no
	movb	1(r2)	,@r2		; yes, shuffle things down
	movb	2(r2)	,1(r2)		; and check for next space
	dec	r0			; only 2 characters in unit
	cmpb	@r2	,#'0		; still a zero around ?
	bne	210$			; no
	movb	1(r2)	,@r2		; yes, unit # must be < 10
	dec	r0			; only 1 character in unit #
210$:	add	r0	,r2		; move the buffer pointer now
	return


;	3 0 0 $
;
;	decide whether to convert binary to decimal or ascii
;	assume: r3 contains the value of G.TSSY from GTSK$S.

300$:	cmp	r3	,#4		; is this rsts (i do all the
	beq	310$			; developement on RSTS). yes
	jmp	octcvt			; no, convert to octal
310$:	jmp	deccvt			; rsts, use decimal
	
	.endc				; for RSX

	.sbttl	convert rad50 3 digits to binary

	.if ne	,rsx11m
	.ift

;	R 5 0 P P N
;
;	convert rad50 directory name to binary
;
;	input:	r1	--> filename block of desired FDB
;	output:	n.did(r1)   binary of the rad50 digit string

r50ppn:
	save	<r0,r1>
	mov	r1,r0			;copy FNB pointer
	add	#n.did,r0		;Point to directory ID
	mov	(r0),r1			;Get number to convert
					;and store it in same space
	call	ppnbin			;Convert to binary
	mov	(r0),r1			;Get second half
	call	ppnbin			;And convert it
	mov	-(r0),r1		;Get low half of direct.
	swab	-(r0)			;Put upper half in correct pos.
	add	r1,(r0)			;Store low half
	unsave	<r1,r0>			;Restore registers
	return

ppnbin:
	save	<r2>
	MOV	R0,R2
	CALL	10$
	MOV	R0,-(SP)
	CALL	10$
	MOV	R0,-(SP)
	CALL	10$
	clr	r1
	bisb	r0,r1
	ash	#3,r1
	bisb	(sp)+,r1
	ash	#3,r1
	bisb	(sp)+,r1
	mov	r1,(r2)+
	MOV	R2,R0
	unsave	<r2>
	RETURN

10$:	clr	R0
	div	#50,R0
	MOV	R1,-(SP)
	MOV	R0,R1
	MOV	(SP)+,R0
	sub	#36,r0		;Convert to binary
	RETURN


	.endc				; for RSx11M

	.end
