.title	k11rtd	wildcard directory lookup for RT11
	.ident	/2.17/

;	 18-Jun-84  16:33:01  Brian Nelson
;
;
;	 Copyright (C) 1984 Change Software, Inc
;
;	 17-Sep-86  13:23:00 Handle Labels stuffed in by VMS Exchange


;	Include things we want for kermit



	.if ndf, K11INC
	.ift
	.include	/IN:K11MAC.MAC/
	.endc

	.iif ndf, k11inc,   .error	; .INCLUDE failed

	.psect

	.enabl	gbl










	.sbttl	local data offsets and definitions


	.mcall	.csispc ,.dstat ,.fetch ,.lookup,.readw ,.close ,.cstat
	.mcall	.serr	,.herr	,.purge

	topmem	=	50
	errbyt	=	52

	DEV$LD	=	46		;/45/ LD: identification

	tent	=	400		; status for a tentative file
	empty	=	1000		; status for an empty entry
	perm	=	2000		; status bit for a permanent file
	endseg	=	4000		; end of a segment bits

;;	star	=	134745		; from .csispc for a '*' (rt11/rsts)
	star	=	132500		; from .csispc for a '*' (real RT11)

	.psect	rtdir	,rw,d,lcl,rel,con


hd$blk	=	1			; vbn of the home block
hd$fir	=	724			; offset into home block for first block
hd$vol	=	730			; RT11A and seven spaces usually
hd$sys	=	760			; always DECRT11A


outlun: .word	0
dirbuf: .blkb	2000			; 2 block buffer for directory segments
name1:	.blkb	12
name2:	.blkb	12

	.save
	.psect	rtdir1	,rw,d,gbl,rel,con
contex: .word	0			; current file number
hd.fir: .word	0			; block number of first entry
itsopen:.word	0
time:	.word	0,45
devtyp: .word	0
	.restore
junk:	.blkb	20










;	 information from the directory header

h$nseg	=	0			; offset for segment count in buffer
h$next	=	2			; offset for next block link
h$max	=	4			; offset for highest segment in use
h$ext	=	6			; offset for number of extra words
h$blk	=	10			; offset for first block # of data

h.nseg: .blkw	1			; number of segments in the directory
h.next: .blkw	1			; link to the next directory segment
h.max:	.blkw	1			; max segment actually in use
h.ext:	.blkw	1			; number of extra words per entry
h.blk:	.blkw	1			; data block number for the segment


;	 information from the current directoty entry

f.stat	=	0			; entry status word
f.nam	=	2			; all three words of the name+type
f.nam1	=	2			; first three rad50 characters of name
f.nam2	=	4			; last three rad50 characters of name
f.type	=	6			; all three rad50 characters of type
f.len	=	10			; file size
f.misc	=	12			; we don't care about this stuff
f.date	=	14			; creation date


	.save
	.psect	rtdir1	,rw,d,gbl,rel,con
loklen: .word	0			;/38/ added for server
lokdate:.word	0			;/38/ added for server
dirsiz: .blkw	1			; total size of a directory entry
filnam: .blkw	4			; the .csispc parsed filename+type
resnam: .blkw	4			; the name we found
	.restore

	.psect










	.psect	$code

lookup::save	<r1,r2,r3>		; save all the temps please
	copyz	2(r5)	,6(r5)		; return the passed name for starters
	tst	nowild			;/51/ Perhaps send a DEVICE?
	beq	30$			;/51/ No
	clr	r0			;/51/ Assume success
	tst	@4(r5)			;/51/ Second time for sending device?
	beq	20$			;/51/ No
	mov	#ER$NMF ,r0		;/51/ Yes, br 100$ all done
	br	100$			;/51/ Exit
20$:	inc	@4(r5)			;/51/ Success, increment context.
	br	100$			;/51/ Exit

30$:	tst	@4(r5)			; new call sequence today?
	bne	40$			; no
	clr	context			; yes, flag so
	clr	h.max			; also init a flag
	.close	#lun.sr			; close the old device up also
	clr	r0			; no errors please
	clr	itsopen			; device is no longer open

40$:	tst	itsopen			; need to open it up
	bne	50$			; no, already established a context
	call	opndev			; get the disk opened up please
	tst	r0			; any errors ?
	bne	100$			; yes, we will have to die then
	mov	sp	,itsopen	; device is open for next call
50$:	call	getnth			; lookup the next one please
	tst	r0			; errors ?
	bne	90$			; no
	inc	@4(r5)			; return correct context
	br	100$

90$:	push	r0			;	yes, close the device please
	.close	#lun.sr			; close the device up on errors
	clr	context			; insure current context is cleared
	clr	itsopen			; insure we do an open next time
	pop	r0			; restore the error code now

100$:	unsave	<r3,r2,r1>		; pop temps and exit please
	return				; return any errors in r0










	.sbttl	print directory listing



;	 D O D I R
;
;	 input: @r5	wildcarded filespec
;	 output:	r0	error code
;
;	 DODIR prints a directory listing at the local terminal.
;
;
;	 S D O D I R
;
;	 Passed:	@r5	wildcarded name
;	 Return:	r0	error code, zero for no errors
;			r1	next character in the directory listing
;
;	 SDODIR is called by the server to respond to a remote directory
;	 command.  Instead of the pre 2.38 method of dumping output to a
;	 disk file and then sending the disk file in an extended replay,
;	 SDODIR	 returns the next  character so that  BUFFIL can use it.
;	 The routine  GETCR0  is actually a dispatch routine to call the
;	 currently selected GET_NEXT_CHARACTER routine.


	.save
	.psect	dirmap	,rw,d,gbl,rel,ovr
dirnam: .blkw	1			;/51/ Filled in at startup
dirbfr: .blkw	1			;/51/ Ditto

	.psect	rtdir1	,rw,d,gbl,rel,con
diridx: .word	0
dirptr: .word	0
wild:	.asciz	/*.*/
dspace: .byte	40,0
dcrlf:	.byte	15,12,0
	.even
	.restore




dodir:: save	<r1,r2,r3,r5>		; save these please
	mov	2(r5)	,outlun
10$:	mov	@r5	,-(sp)
	mov	#1	,-(sp)
	mov	sp	,r5
	call	.dodir
	cmp	(sp)+	,(sp)+
100$:	unsave	<r5,r3,r2,r1>
	clr	r0
	return


.dodir: tst	itsopen			; need to open it up
	beq	10$			; yes
	.close	#lun.sr			; please close up shop first
	clr	itsopen			; say it's closed now
10$:	call	opndev			; get the disk opened up please
	tst	r0			; any errors ?
	bne	100$			; yes, we will have to die then
	mov	sp	,itsopen	; device is open for next call
50$:	call	pridir			; lookup the next one please
	tst	r0			; errors ?
	beq	50$			; no

90$:	mov	r0	,-(sp)		; yes, close the device please
	.close	#lun.sr			; close the device up on errors
	clr	itsopen			; insure we do an open next time
	mov	(sp)+	,r0		; restore the error code now

100$:	return				; return any errors in r0










	.sbttl	SDODIR	directoty stuff for a server


sdirin::strcpy	dirnam	,@r5		; copy name over
	mov	dirbfr	,dirptr		; yes, init pointers please
	clr	diridx			; ditto
	call	dirini			; init for calls to sdodir
	bcs	100$
	mov	dirbfr	,dirptr		; yes, init pointers please
	clrb	@dirptr			; yes, zap the buffer
	call	dirnex			; preload buffer
100$:	return


sdodir::save	<r2,r3,r4>
10$:	movb	@dirptr ,r1		; get the next character please
	bne	20$			; something was there
	mov	dirbfr	,dirptr		; reset the pointer
	clrb	@dirptr			; yes, zap the buffer
	call	dirnex			; empty buffer, load with next file
	bcs	90$			; no more, return ER$EOF
	br	10$			; and try again
20$:	inc	dirptr			; pointer++
	clr	r0			; no errors
	br	100$			; exit
90$:	mov	#ER$EOF ,r0		; failure, return(EOF)
95$:	clr	r1			; return no data also
	clr	diridx			; init for next time through
100$:	unsave	<r4,r3,r2>
	return



dirini: clr	diridx			; clear context flag
	mov	dirbfr	,dirptr		; set pointer up for SDODIR
	clrb	@dirptr			; clear buffer
	return				; thats all folks



dirnex: movb	defdir	,-(sp)		; anything in DEFDIR ?
	bne	10$			; yes, don't alter it please
	strcpy	#defdir ,#wild		; nothing, insert *.*;*
10$:	mov	dirbfr	,r2		; pointer to buffer
	mov	#junk	,r3		; pointer to work buffer
	calls	lookup	,<#3,dirnam,#diridx,r2>
	tst	r0			; successfull?
	bne	80$			; no
	strlen	r2			; get the length of the string
	mov	#20	,r1		; and format the string
	sub	r0	,r1		; number of spaces to append
	ble	30$			; can't happen
20$:	strcat	r2	,#dspace	; append spaces please
	sob	r1	,20$		; next please
30$:	deccvt	loklen	,r3		; filesize
	clrb	6(r3)			; insure .asciz please
	strcat	r2	,r3		; append it please
	strcat	r2	,#dspace	; a space
	mov	lokdate ,r0		; get date converted
	bne	40$			; valid
	dec	r0			; invalid, force 00-xxx-00
40$:	calls	cvtdat	,<r3,r0>,nogbl	; append the date please
	strcat	r2	,r3		;
	strcat	r2	,#dcrlf		; yes, append <cr><lf>
	clr	r0			; success
	br	100$			; exit
80$:	cmp	r0	,#ER$NMF	; no more files error ?
	bne	90$			; no
	tst	diridx			; ever do anything?
	bne	90$			; yes
	mov	#ER$FNF ,r0		; no, convert to file not found
90$:	sec
100$:	movb	(sp)+	,defdir		; restore DEFDIR
	return











	.sbttl	open the disk up to search the directory

opndev: .SERR				;/51/ Trap fatal errors please
	sub	#20.	,sp		; allocate buffer for the
	mov	sp	,r2		; device status call
	sub	#40.*2	,sp		; allocate a buffer for the
	mov	sp	,r1		; .csispc data

1$:	mov	#defdir ,r3		; insert default device name
	scan	#':	,2(r5)		; check for a device already there
	tst	r0			; well ?
	bne	6$			; yep. don't try to put one in please
5$:	movb	(r3)+	,@r1		; copy it
	beq	6$			; all done
	inc	r1			; not null, next please
	br	5$			;
6$:	mov	2(r5)	,r0		; string address
10$:	movb	(r0)+	,(r1)+		; copy it to the csi buffer
	bne	10$			; until a null byte is found.
	dec	r1			; get back to the last character
	cmpb	-1(r1)	,#':		; is the just just a device only?
	bne	15$			; no
	movb	#'*	,(r1)+		; yes, insert *.*
	movb	#'.	,(r1)+		; yes, insert *.*
	movb	#'*	,(r1)+		; yes, insert *.*
15$:	movb	#'=	,(r1)+		; fake an output filespec here
	clrb	@r1			; and .asciz
	mov	sp	,r1		; reset pointer (also saving sp)
	.csispc r1,#defext,r1		; and try to parse the name
	mov	r1	,sp		; restore from any switches
	bcs	80$			; oops
	calls	fetch	,<@r1>		; try to get the thing loaded
	tst	r0			; well ?
	bne	120$			; no, exit with mapped error
	mov	devidx	,devtyp		;/45/ Save device type from .FETCH
20$:	tst	@r1			; a specific device name ?
	bne	30$			; yes
	mov	#^RDK	,@r1		; no, stuff DK: into it then

30$:	mov	r1	,r0		; copy the pointer to .csispc results
	mov	#filnam ,r2		; and save the results
	mov	(r0)+	,(r2)+		; copy the device spec first of all
	mov	@r0	,(r2)+		; copy the first 3 rad50 of filename
	bne	40$			; something was indeed there
	mov	#star	,-2(r2)		; nothing, convert to wilcard
40$:	clr	(r0)+			; and clear any filenames please
	mov	@r0	,(r2)+		; copy the last 3 rad50 of filename
	clr	(r0)+			; and clear any filenames please
	mov	@r0	,(r2)+		; copy the 3 rad50 of filetype
	.if eq,-1			;/58/ not longer implied wildcard here
	bne	50$			; something was passed for filetype
	mov	#star	,-2(r2)		; nothing there, stuff a wilcard in
	.endc
50$:	clr	(r0)+			; and clear any filetypes please
	clr	(r0)+			; to be sure
	.lookup #rtwork,#lun.sr,r1	; open the file for input
	bcs	100$			; can not find it
	clr	r0			; no errors
	br	120$			; and exit

60$:	mov	#dsterr ,r1
	br	110$
80$:	mov	#csierr ,r1		; .csispc error mapping
	br	110$			; get the correct error now
90$:	mov	#feterr ,r1		; .fetch error codes
	br	110$
100$:	mov	#lokerr ,r1		; .lookup error mapping
	br	110$

110$:	movb	@#errbyt,r0		; get the error code now
	bpl	115$			;/51/ Normal RT11 error
	com	r0			;/51/ Make positive
	add	#faterr ,r0		;/51/ Map to fatal error list
115$:	asl	r0			; times 2 for indexing into error map
	add	r0	,r1		; now map the rt11 error into a fake
	mov	@r1	,r0		; of a rms11 error

120$:	add	#<40.*2>+20.,sp		; pop all the tiny buffers now.
	push	r0			;/51/ Successfull?
	beq	130$			;/51/ Yes
	.PURGE	#LUN.SR			;/51/ No, purge the channel now
130$:	.HERR				;/51/ Restore normal error control
	pop	r0			;/51/ Pop actual error code
	return				; and get out


	.save
	.psect	rtdir
defext: .word	star,star,star,star	;/58/ default ext. are wildcards
	.restore










	.sbttl	read the home block in please

gethom: save	<r1,r2>			;/54/
	.readw	#rtwork,#lun.sr,#dirbuf,#400,#hd$blk
	bcs	90$			; it failed, bye
	mov	#dirbuf ,r2		; point to the buffer now
	mov	hd$fir(r2),hd.fir	; get the first directory block number
	bne	5$			; /56/
	mov	#6	,hd.fir		; /56/ Disk had no init data
5$:	add	#hd$sys ,r2		; point to the volume ident
	cmpb	devtyp	,#DEV$LD	;/45/ Logical disk ?
	beq	30$			;/45/ Yes, skip the check
	tst	rtvol			; really verify volume ?
	beq	30$			; no
	mov	r2	,r1		;/54/ Check
	mov	#rt	,r0		;/54/ ...
10$:	tstb	@r0			;/54/ Done
	beq	30$			;/54/ Yes, exit
	cmpb	(r0)+	,(r1)+		;/54/ Same
	beq	10$			;/54/ Yes, keep looking
	mov	r2	,r1		;/54/ Check
	mov	#vms	,r0		;/54/ ...
20$:	tstb	@r0			;/54/ Done
	beq	30$			;/54/ Yes, exit
	cmpb	(r0)+	,(r1)+		;/54/ Same
	beq	20$			;/54/ Yes, keep looking
	br	80$			;/54/ Not valid
30$:	clr	r0			; no errors
	br	100$			; and exit

80$:	mov	#er$vol ,r0		; return an error code and exit
	br	100$			; bye

90$:	movb	@#errbyt,r0		; get the error code
	asl	r0			; times two
	mov	reaerr(r0),r0		; map it into a unique global error

100$:	unsave	<r2,r1>			;/54/
	return				; bye

	.save				;/54/
	.psect	$PDATA	D		;/54/
rt:	.asciz	/DECRT11/		;/54/
vms:	.asciz	/DECVMSEX/		;/54/ From EXCHANGE under VMS4.x
	.even				;/54/
	.restore			;/54/


gethdr: .readw	#rtwork,#lun.sr,#dirbuf,#1000,r1
	bcs	90$			; it failed, bye
	mov	#dirbuf ,r0		; point to the buffer now
	mov	h$nseg(r0),h.nseg	; get the total segment count now
	asl	h$next(r0)		; segments are two blocks in length
	beq	5$			; no more segments if zero
	add	#4	,h$next(r0)	; and at last, the offset
5$:	mov	h$next(r0),h.next	; get the link to the next one
	tst	h.max			; already set up ?
	bne	10$			; yes, don't touch it please
	mov	h$max(r0) ,h.max	; get the maximum segment in use
10$:	mov	h$ext(r0) ,h.ext	; get the extra words per dir entry
	mov	h$blk(r0) ,h.blk	; and the starting block for data
	mov	#7*2	,dirsiz		; the default entry size
	add	h$ext(r0),dirsiz	; plus extra bytes per entry
	clr	r0			; no errors
	br	100$			; and exit

90$:	movb	@#errbyt,r0		; get the error code
	asl	r0			; times two
	mov	reaerr(r0),r0		; map it into a unique global error

100$:	return				; bye


	global	<rtvol>










	.sbttl	print the directory out



pridir: save	<r1,r2,r3>		; save temps
	call	gethom			; read in the home block
	tst	r0			; did it work ?
	bne	100$			; no, exit with the error please
	mov	hd.fir	,r1		; get this directory entry
10$:	tst	r1			; end of the directory list ?
	beq	90$			; yes, return 'no more files' please
	call	gethdr			; the the first directory header
	tst	r0			; did this work out ?
	bne	100$			; no, return mapped error code please
	mov	#dirbuf ,r3		; point to the directory buffer
	add	#5*2	,r3		; skip past the header information
20$:	bit	#endseg ,f.stat(r3)	; end of this segment ?
	bne	80$			; yes, try the next one please
	bit	#perm	,f.stat(r3)	; is this a real file ?
	beq	70$			; no, skip it please
	call	match			; see if the file matches up
	tst	r0			; well ?
	beq	70$			; no, try again please
	mov	#junk	,r2		; a local buffer to use
	call	convert			; convert to asciz
	mov	#junk	,-(sp)		; push the buffer address
	call	110$			; dump it please
	deccvt	f.len(r3),#junk		; convert size to decimal
	clrb	junk+6			; insure .asciz please
	mov	#junk	,-(sp)		; push the buffer address
	call	110$			; and do it
	mov	#210$	,-(sp)		; push buffer
	call	110$			; dump it
	mov	f.date(r3),r0		; a real date today?
	bne	60$			; yes
	dec	r0			; no, force 00-xxx-00
60$:	calls	cvtdat	,<#junk,r0>,nogbl; and convert the date
	mov	#junk	,-(sp)		; same again
	call	110$			;
	mov	#200$	,-(sp)		;
	call	110$			;


70$:	add	dirsiz	,r3		; skip to the next entry please
	br	20$			; and check this one out please
80$:	mov	h.next	,r1		; end of segment, check the next one
	br	10$			; simple to do

90$:	mov	#er$nmf ,r0

100$:	unsave	<r3,r2,r1>		; pop temps and exit
	return


110$:	save	<r0,r1,r2,r3>		; save registers
	mov	12(sp)	,r3		; get the buffer address
	tst	outlun			; output to disk or terminal
	beq	150$			; tt:
	strlen	r3			; disk, get the buffer size
	mov	r0	,r2		; save it please
	beq	190$			; nothing to do
120$:	movb	(r3)+	,r0		; get the next character
	mov	outlun	,r1		; set the lun up also
	call	putcr0			; dump the character
	sob	r2	,120$		; and get the next one
	br	190$			; exit
150$:	.print	r3			; output to tt:
190$:	unsave	<r3,r2,r1,r0>		; pop registers and exit
	mov	(sp)+	,(sp)		; move return address up and exit
	return				; bye


200$:	.byte	15,12,0
210$:	.byte	40,40,40,0
	.even










	.sbttl	get the next entry matching a possibly wildcarded name


getnth: save	<r1,r2,r3,r4>		; save temps
	clr	r4			; counter for number of matches
	call	gethom			; read in the home block
	tst	r0			; did it work ?
	bne	100$			; no, exit with the error please
	mov	hd.fir	,r1		; get this directory entry
10$:	tst	r1			; end of the directory list ?
	beq	90$			; yes, return 'no more files' please
	call	gethdr			; the the first directory header
	tst	r0			; did this work out ?
	bne	100$			; no, return mapped error code please
	mov	#dirbuf ,r3		; point to the directory buffer
	add	#5*2	,r3		; skip past the header information

20$:	bit	#endseg ,f.stat(r3)	; end of this segment ?
	bne	80$			; yes, try the next one please
	bit	#perm	,f.stat(r3)	; is this a real file ?
	beq	70$			; no, skip it please
	call	match			; see if the file matches up
	tst	r0			; well ?
	beq	70$			; no, try again please
	cmp	r4	,context	; a match here ?
	bne	50$			; no, try again please
	mov	6(r5)	,r2		; a buffer to convert into
	call	convert			; convert to asciz
	mov	r2	,r0		; not get rid off ALL spaces in the name
30$:	tstb	@r0			; end of the string yet ?
	beq	40$			; yes
	cmpb	@r0	,#40		; if it's a space, then ignore it
	beq	35$			; skip it please
	movb	@r0	,(r2)+		; not a space, please copy it then
35$:	inc	r0			; point to the next character now
	br	30$			; and check the next character please
40$:	clrb	@r2			; insure returned string is .asciz
	mov	F.DATE(r3),lokdate	;/38/ save this
	mov	F.LEN(r3),loklen	;/38/ save this
	clr	r0			; success
	inc	context			; next one next time please
	br	100$			; bye
50$:	inc	r4			; matches := succ( matches )
	br	70$			; next try please

70$:	add	dirsiz	,r3		; skip to the next entry please
	br	20$			; and check this one out please
80$:	mov	h.next	,r1		; end of segment, check the next one
	br	10$			; simple to do

90$:	mov	#er$nmf ,r0

100$:	unsave	<r4,r3,r2,r1>		; pop temps and exit
	return










	.sbttl	convert current directory entry to asciz

;	 input: r2	buffer for the result
;			r3	current directory entry pointer


convert:mov	r2	,-(sp)		; save the passed pointer to a buffer
	calls	rdtoa	,<r2,filnam>	; convert the device name please
	cmpb	@r2	,#40		; a space for device name ?
	bne	10$			; no
	movb	#'D&137 ,@r2		; yes, stuff 'DK' in please
	movb	#'K&137 ,1(r2)		; simple to do
10$:	add	#2	,r2		; skip past it and insert a ':'
	cmpb	@r2	,#40		; a space (no unit number?)
	beq	20$			; no
	tstb	(r2)+			; a real unit, skip over number
20$:	movb	#':	,(r2)+		; yes, get DD: format of device name
	calls	rdtoa	,<r2,f.nam1(r3)>; convert first 3 filename to ascii
	add	#3	,r2		; and skip over those three characters
	calls	rdtoa	,<r2,f.nam2(r3)>; now get the rest of the filename
	add	#3	,r2		; point to place a dot into the name
	movb	#'.	,(r2)+		; a dot
	calls	rdtoa	,<r2,f.type(r3)>; get the filetype at last
	clrb	3(r2)			; and insure .asciz please
	mov	(sp)+	,r2		; pop the pointer and exit
	return				; bye

	.enabl	lsb

	percent = '.			;/58/ percent in a filspc string
	wildc	= '?			;/58/ wildcard flag

match:	save	<r1,r2>			; we may need these here
	mov	filnam+2,rtwork+0	; copy the name and type please
	mov	filnam+4,rtwork+2	; copy the name and type please
	mov	filnam+6,rtwork+4	; copy the name and type please
	mov	#name1	,r1		; was not a simple pattern so convert
	mov	#rtwork ,r2		; both names back to ascii and check
	mov	#3	,r0		; for individual character wildcarding
40$:	calls	rdtoa	,<r1,(r2)+>	; convert the patter filename back
	add	#3	,r1		; increment the pointer by 3 char's.
	sob	r0	,40$		; next please
					;
	mov	#name2	,r1		; a buffer for the file we just found
	mov	r3	,r2		; on the disk. Now get the address of
	add	#f.nam1 ,r2		; the name and filetype, convert this
	mov	#3	,r0		; to ascii in a loop
50$:	calls	rdtoa	,<r1,(r2)+>	; convert
	add	#3	,r1		; next please
	sob	r0	,50$		;
					;
60$:	mov	#name1	,r1		; the filename pattern
	mov	#name2	,r2		; the current filename on disk
	mov	#6.	,r0		; the loop count for scanning
	call	200$			;/58/ compare filename
	bcs	90$			;/58/  /B on match failure
	mov	#name1+6,r1		; the filetype pattern
	mov	#name2+6,r2		; the current filetype on disk
	mov	#3.	,r0		; the loop count for scanning
	call	200$			;/58/ compare filetype
	bcs	90$			;/58/  /B on match failure
	mov	sp	,r0		; flag success and exit
	br	100$			; bye
					;
90$:	clr	r0			; failure, exit
					;
100$:	unsave	<r2,r1>			; restore registers
	return				;   and exit at last
					;
200$:	mov	r0	,311$		;/58/ save for later re-use
	mov	r1	,310$		;/58/
201$:	cmpb	@r1	,@r2		;/58/ if they match, no problem
	beq	202$			;/58/ simply check the next character
	cmpb	@r1	,#wildc		;/58/ a translated "* wildcard ?
	beq	210$			;/58/  yes - alternativ check
	cmpb	@r1	,#percent	;/58/ a translated "% wildcard ?
	bne	231$			;/58/  no  - match failure ...
202$:	inc	r1			;/58/ match so far,
	inc	r2			;/58/	update pointers
	sob	r0	,201$		;/58/	and check the next ones
	call	300$			;/58/ are we at end of string?
	bcs	230$			;/58/  yes - success
	cmpb	@r1	,#space		;/58/  no - see if wildcarded
	beq	230$			;/58/	      if so, success
	br	231$			;/58/	      else failure ...
					;/58/
210$:	inc	r1			;/58/ point to char. after wildc
	call	300$			;/58/ are we at end of string?
	bcs	230$			;/58/  if so, success ...
211$:	cmpb	@r1	,#space		;/58/  a spaces?
	beq	230$			;/58/	 end of matching check
	cmpb	@r1	,#percent	;/58/ a translated "% wildcard ?
	bne	220$			;/58/  no - compare strings
	inc	r1			;/58/ point to char. after wildc
	sob	r0,211$			;/58/  otherwise loop to find a char.
	br	230$			;/58/ all "%'s - assume success
					;/58/
220$:	cmpb	@r1	,@r2		;/58/ find a matching character
	bne	221$			;/58/	not yet, see next ...
	cmpb	1(r2)	,@r2		;/58/ next = same?
	bne	202$			;/58/	no - verify remainder
221$:	inc	r2			;/58/	else point to next
	sob	r0,220$			;/58/	     and loop until done
	br	231$			;/58/ match failure
					;/58/
230$:	tst	(pc)+			;/58/ bump next instr. and clr carry
231$:	sec				;/58/ flag failure
	return				;/58/  back to caller
					;/58/
300$:	push	r0			;/58/ save temp
	mov	r1	,r0		;/58/ copy searched string pointer
	sub	(pc)+	,r0		;/58/ make match count
310$:	.word	0			;/58/	 searched string base address
	cmp	(pc)+	,r0		;/58/ compare with char. count
311$:	.word	0			;/58/	 string width
	beq	320$			;/58/	yes - flag end string
	tst	(pc)+			;/58/	else skip next instr.
320$:	sec				;/58/ flag end-of-string
	pop	r0			;/58/ restore reg
	return

	.dsabl	lsb









	.sbttl	ascdat	convert to ascii date for RT11
	.mcall	.date


;	 input: @r5	output buffer address
;		2(r5)	value of date, zero implies current
;
;	 I certainly could use my ASH and DIV macros, but may as
;	 well do it this way for future possibilities.
;
;	 N O T E :  This is a LOCAL copy of ASCDAT so I can overlay
;		    the real ACSDAT oppossing this overlay.



cvtdat: save	<r0,r1,r2,r3>		; save these please
	mov	@r5	,r1		; the result address
	cmp	2(r5)	,#-1		; if -1, then return 00-XXX-00
	bne	5$			; no
	copyz	#310$	,r1		; yes, then exit
	br	100$			; bye
5$:	mov	2(r5)	,r0		; get the date desired please
	bne	10$			; it's ok
	.date				; zero, assume todays date then
10$:	bic	#100000 ,r0		; undefined
	mov	r0	,r3		; copy the date
	asr	r3			;/2
	asr	r3			;/2 again
	asr	r3			; ditto
	asr	r3			; sigh
	asr	r3			; at last
	bic	#^C37	,r3		; the date, at last
	call	200$			; convert it
	mov	r0	,r3		; get the date once again please
	swab	r3			; get the month to bits 2..7
	asr	r3			;/2
	asr	r3			;/2 again
	bic	#^C17	,r3		; get rid of the unwanted bits now
	dec	r3			; convert to 0..11
	asl	r3			; convert to word offset
	asl	r3			; quad offset
	add	#300$	,r3		; the address of the text
	movb	#'-	,(r1)+		; copy it over please
	movb	(r3)+	,(r1)+		; three characters please
	movb	(r3)+	,(r1)+		; three characters please
	movb	(r3)+	,(r1)+		; three characters please
	movb	#'-	,(r1)+		; copy it over please
	mov	r0	,r3		; copy the date
	bic	#^C37	,r3		; the year, at last
	add	#110	,r3		; plus the bias please
	call	200$			; convert
	clrb	@r1			; .asciz and exit
100$:	unsave	<r3,r2,r1,r0>
	return

200$:	clr	r2			; subtract 10 a few times
210$:	inc	r2			; high digit number
	sub	#12	,r3		; until we get a negative number
	tst	r3			; done yet ?
	bge	210$			; no
	dec	r2			; yes
	add	#12	,r3		; correct it please
	add	#'0	,r2		; and copy the day number please
	add	#'0	,r3		; simple
	movb	r2	,(r1)+		; copy it
	movb	r3	,(r1)+		; copy it
	return

	.nlist	bex
300$:	.ascii	/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec /
310$:	.asciz	/00-XXX-00/
	.list	bex
	.even



	.end