	.title	k11rmz	overlayed RMS11 code (3.43)
	.ident	/3.43/
	.psect	$code

;	Creation: 24-Jan-86  14:06:18  Brian Nelson
;
;	Will the addition of long packet support the root is getting
;	too large.
;
;	Entry points:
;
;	delete		delete a file(s)
;	rename		rename a file(s)
;	getmcr		get mcr/ccl command line, only used ONCE
;
;
;	Copyright (C) 1986 Change Software, Inc



	.include	/IN:K11MAC.MAC/
	.library	/LB:[1,1]RMSMAC.MLB/


	.mcall	$compare,$fetch	,$parse	,$search,$set	,$store
	.mcall	fab$b	,nam$b	,$rename,$erase ,$off	,$testb



	nb$nod	=	400	; Node in file or default string (FNB in NAM)

	.enabl	gbl

	.psect	$code	,ro,i,lcl,rel,con
	.psect	rmssup	,rw,d,lcl,rel,con


	.mcall	fabof$
	.mcall	rabof$
	.mcall	xabof$

	fabof$	RMS$L
	rabof$	RMS$L
	xabof$	RMS$L




	.sbttl	rename


;	R E N A M E
;
;	input:	@r5	old filename address
;		2(r5)	new filename address
;		4(r5)	flag, lt 0 don't print the results else print a log
;
;	output:	r0	error code, zero if at least one file found
;		r1	number of files renamed



	.sbttl	the real work of rename
	.psect	$code


rename::save	<r2,r3,r4,r5>		; save temps please
	mov	#rnfab1	,r0		; point to the old name FAB
	mov	#rnfab2	,r1		; point to the new name FAB
	mov	#rnnam1	,r2		; point to the old name's NAMEBLOCK
	mov	#rnnam2	,r3		; point to the new name's NAMEBLOCK
	tst	fu$def			; do we really need a default device?
	beq	1$			; no
	$store	#sydisk,DNA,r0		; yes. Stuff the default system device
	$store	#sylen ,DNS,r0		; name and length to the source name and
	$store	#sydisk,DNA,r1		; then do the same for the new name. Put
	$store	#sylen ,DNS,r1		; the def device address and length in.

1$:	mov	r0	,r4		; save the FAB1 pointer now     ;RBD01--
	strlen	#defdir			; anything in the Kermit default dir?
	tst	r0			; if <> then use it
	beq	5$			; nothing there to use, use SY:
	$store	#defdir	,DNA,r1		; something was there, stuff it in
	$store	r0	,DNS,r1		; and the length of the default
	$store	#defdir	,DNA,r4		; something was there, stuff it in
	$store	r0	,DNS,r4		; and the length of the default
5$:	mov	r4	,r0		; restore FAB1 pointer now
	$store	#lun.sr ,LCH,r0		; stuff a logical unit number
	$store	#lun.sr ,LCH,r1		; stuff a logical unit number
	sub	#100	,sp		; allocate an ESA for old name
	$store	sp  ,ESA,r2		; and stuff the address in
	$store	#100,ESS,r2		; and the length of it please
	sub	#100	,sp		; next is the resultant string
	$store	sp  ,RSA,r2		; buffer for the old filename
	$store	#100,RSS,r2		; and the size of it please
	sub	#100	,sp		; the new filename buffer
	$store	sp  ,ESA,r3		; stuff address of the buffer
	$store	#100,ESS,r3		; and the size of it please
	clr	-(sp)			; a count of the files done so far

	mov	#rnfab1	,r1		; point to the old name FAB
	mov	#rnfab2	,r2		; point to the new name FAB
	strlen	@r5			; get the .asciz length of old
	$store	@r5 ,FNA,r1		; store the old filename address
	$store	r0  ,FNS,r1		; stuff the length of the old name
	mov	#rnfab1	,r0		; point to the old name FAB
	$parse	r0			; parse the old name please
	$compar	#0  ,STS,r0		; did the parse work out ok ?
	blt	90$			; no, exit
	strlen	2(r5)			; get the length of the new name
	$store	2(r5),FNA,r2		; stuff the new name into FNS field
	$store	r0  ,FNS,r2		; and the size of it please


10$:	mov	#rnfab1	,r0		; point to the old name FAB
	mov	#rnfab2	,r1		; point to the new name FAB
	mov	#rnnam1	,r2		; point to the old name's NAMEBLOCK
	mov	#rnnam2	,r3		; point to the new name's NAMEBLOCK
	$set	#fb$fid,FOP,r0		; set explicit search please
	$search	r0			; do a directory lookup please
	$compar	#0  ,STS,r0		; did the lookup work ?
	blt	90$			; oops, it didn't work
	$fetch	r4  ,RSA,r2		; get the resultant address
	$store	r4  ,DNA,r1		; set this as default
	$fetch	r4  ,RSL,r2		; get the resultant length
	$store	r4  ,DNS,r1		; set the default length
	$rename	r0,,,r1			; rename input as output
	$compar	#0  ,sts,r0		; error?
	blt	90$			; yes, exit please
	inc	@sp			; no errors, count that file
	tst	4(r5)			; should we print the results ?
	bmi	10$			; no
	call	200$			; yes
	br	10$			; go back for more please


90$:	mov	@sp	,r1		; return # files renamed
	dec	(sp)+			; did we get any work done ?
	bge	100$			; yes
	$fetch	r0  ,STS,r0		; no, get the error code
	cmp	r0	,#ER$NMF	; no files, was it NO MORE FILES ?
	bne	110$			; no
	mov	#ER$FNF	,r0		; yes, change it to FILE NOT FOUND
	br	110$			; and exit

100$:	clr	r0			; success exit, no errors

110$:	add	#3*100	,sp		; pop the buffers
	unsave	<r5,r4,r3,r2>		; pop registers now
	return


200$:	print	#300$
	movb	o$rsl(r2),r0
	print	o$rsa(r2),r0
	print	#310$
	movb	o$esl(r3),r0
	print	o$esa(r3),r0
	print	#320$
	return

	.enabl	lc
300$:	.asciz	/File /
310$:	.asciz	/ renamed to /
320$:	.byte	cr,lf,0
	.even





	.sbttl	delete a file(s)

;	input:	@r5	address of filename spec
;		2(r5)	if eq -1, don't print the results out
;			       0, print on terminal
;			      >0, write to lun in 2(r5)
;
;	output:	r0	RMS error code
;		r1	number of files renamed
;
;
;	internal register usage
;
;	r0	RMS error STS
;	r1	pointer to the FAB for this operation
;	r2	pointer to the NAM block for this operation
;	r3	number of files deleted
;	r5	pointer to the argument list


delete::save	<r2,r3,r4>		; save registers we may overwrite
	clr	r3			; files_deleted := 0
	mov	#rnfab1	,r1		; point to the fab we use       ;RBD01--
	tst	fu$def			; do we need a default device name?
	beq	1$			; no
	$store	#sydisk ,DNA,r1		; yes, please stuff the correct defs
	$store	#sylen  ,DNS,r1		; simple
1$:	strlen	#defdir			; anything in the Kermit default dir?
	tst	r0			; if <> then use it
	beq	5$			; nothing there to use, use SY:
	$store	#defdir	,DNA,r1		; something was there, stuff it in
	$store	r0	,DNS,r1		; and the length of the default
5$:	$store	#lun.sr,LCH,r1		; a channel number to use for delete
	$off	#fb$fid,FOP,r1		; we want an implicit $SEARCH
	mov	#rnnam1	,r2		; also point to the NAME block
	sub	#200	,sp		; allocate result name string
	$store	sp  ,RSA,r2		; set up the pointer to name string
	$store	#200,RSS,r2		; and set the size of the string
	sub	#200	,sp		; allocate result expanded name string
	$store	sp  ,ESA,r2		; set up the pointer to expanded name
	$store	#200,ESS,r2		; and set the size of the string
	$store	#ER$FNM ,STS,r1		; preset a bad filename error
	strlen	@r5			; get the length of the filename
	tst	r0			; anything left at all ?
	beq	90$			; no, fake a bad filename please
	$store	r0  ,FNS,r1		; stuff the filename size in please
	$store	@r5 ,FNA,r1		; stuff the filename address into FAB
	$parse	r1			; try to parse the filename now
	$compar	#0  ,STS,r1		; did the parse of the name work ?
	blt	90$			; no, exit and return STS in r0
10$:	$erase	r1			; parse worked, try to delete it
	$compar	#0  ,STS,r1		; did the erase work out ok ?
	blt	90$			; no
	inc	r3			; count the file as being deleted
	call	200$			; do any echoing now please
	br	10$			; next please

90$:	$fetch	r0  ,STS,r1		; get the error code out please
	mov	r3	,r1		; return the # of files deleted
	cmp	r0	,#ER$NMF	; error is no more files ?
	bne	95$			; no
	mov	#ER$FNF	,r0		; yes, make it into file not found
	tst	r3			; ever delete any files at all ?
	beq	100$			; no, leave the error as FNF
	clr	r0			; yes, at least one file deleted
	br	100$			; bye
95$:	tst	r0			; error code > 0
	bmi	100$			; no
	clr	r0			; yes, make the error STS zero then
100$:	add	#200*2	,sp		; pop local buffers please
	unsave	<r4,r3,r2>		; pop temps and exit
	return



	.sbttl	printing routines for DELETE



180$:	tst	2(r5)			; print out an initial header
	beq	190$			; yes, but to the terminal
	bmi	195$			; not at all, please
	strlen	#300$			; no, put it out to disk please
	calls	putrec	,<#300$,r0,2(r5)>; dump the record to disk
	br	195$			; and exit
190$:	print	#300$			; dump the header to the terminal
195$:	return				; bye


200$:	cmp	r3	,#1		; deleted anything as of yet ?
	bne	210$			; yes
	call	180$			; no, dump a header out please
210$:	clr	r0			; get set to get the string length
	bisb	o$rsl(r2),r0		; get the string length
	beq	250$			; nothing was there to print ?????
	tst	2(r5)			; echo files deleted to terminal ?
	beq	240$			; yes, echo to tt:
	bmi	250$			; no, don't echo at all
	calls	putrec	,<o$rsa(r2),r0,2(r5)>; echo to a file that's open
	br	250$
240$:	print	o$rsa(r2),r0		; print the filename out to tt:
	print	#310$
250$:	return

300$:	.asciz	<cr><lf>/Files deleted:/<cr><lf>
310$:	.byte	cr,lf,0
	.even



	.sbttl	get mcr/ccl (rsts) command line and remove task name

	.mcall	gmcr$	,dir$
	.psect	mcrbuf	,rw,d,lcl,rel,con

gmcr:	gmcr$

	.psect	$code

;	G M C R
;
;	output:	@r5	the command line less the task name, .asciz
;		r0	the length of whats left
;			NOTE:     blank insertion ----+			 +SSH
;						      V			 +SSH
;			      @takefil will parse to @ takefile...	 +SSH
;			      which allows KER @TAKEFIL to work.	 +SSH

getmcr::save	<r1,r2,r3>		; just for kicks, save these	 /SSH
	clr	r3			; clear the "space flag"	 +SSH
	mov	@r5	,r2		; point to the resultant command
	clrb	@r2			; insure .asciz
	dir$	#gmcr			; get the command line
	movb	@#$dsw	,r0		; get the length of it
	ble	90$			; nothing
	mov	#gmcr+g.mcrb,r1
10$:	cmpb	@r1	,#40		; look for the space delimiting
	beq	20$			; the task name from the command
	inc	r1			; line. did not find it, keep looking
	sob	r0	,10$		; keep trying
	br	90$			; nothing
20$:	inc	r1			; found the space, skip past it
	dec	r0			; whats left of it
	ble	90$			; nothing
	clr	-(sp)			; a length counter today
30$:	tst	r3			; is the space flag set ?	 +SSH
	bne	32$			; yes, go check for " " char	 +SSH
	cmpb	(r1),#'@		; no, check for "@" char	 +SSH
	bne	33$			; no @ char, just continue 	 +SSH
	inc	r3			; yes an @, so set space flag	 +SSH
	br	33$			; and continue with copy	 +SSH
32$:	clr	r3			; clear the space flag		 +SSH
	cmpb	(r1),#40		; char after @ is a space ?	 +SSH
	beq	33$			; yes, continue with copy	 +SSH
	movb	#40	,(r2)+		; no, insert a space char	 +SSH
	inc	@sp			;     increment count		 +SSH
33$:	movb	(r1)+	,(r2)+		; copy next char to buffer
	inc	@sp			; length := succ( length )
	sob	r0	,30$		; next byte please
	mov	(sp)+	,r0		; return the command length
	mov	@r5	,r2		; restore pointer to the returned string
	calls	cvt$$	,<r2,r0,#50>	; remove leading spaces, upper case it
	add	r0	,r2		; insure .asciz
	clrb	@r2			; simple
	br	100$			; bye

90$:	clr	r0			; nothing
100$:	unsave	<r3,r2,r1>		; pop used registers and exit
	return

	.end
