	.title	K11RTU	copy,rename and delete for RT11, no wildcarding
	.ident	/2.20/

;	Copyright (C) 1984 Change Software, Inc.
;
;	18-Jul-84  16:14:46 Brian Nelson
;
;	If wildcarding is added, this MUST be moved from
;	the overlay it's in into the root.


	.mcall	.csispc	,.delete,.dstat	,.fetch	,.rename


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

	.enabl	gbl
	.psect	$code
	.save
	.psect	rendat	,rw,d,lcl,rel,con

defext:	.word	0,0,0,0,0
renlst:	.blkw	12
rtdsta:	.blkw	5
	.restore



	topmem	=	50
	errbyt	=	52
	star	=	132500



	.sbttl	the real work of rename


;	input:	@r5	first filename, .asciz
;		2(r5)	second filename, .asciz
;		4(r5)	if ge 0, print a log of files renamed

rename::save	<r2,r3,r4>		; save these please
	clr	r4			; no files renamed as of yet
	mov	#renlst	,r3		; where to build the .rename list
	mov	@r5	,r0		; string address
	call	docsi			; do the first one
	bcs	100$			; oops
	mov	2(r5)	,r0		; now do the second filename
	call	docsi			; ok
	bcs	100$			; oops
	mov	#renlst	,r1		; check for wildcarding
	mov	@r1	,10(r1)		; first, force same device name
	mov	#4*2	,r2		; eight words to check for wildcards
10$:	cmp	(r1)+	,#star		; a wildcard today ?
	beq	80$			; yes, die
	sob	r2	,10$		; no, check the next one please
	mov	renlst	,r0		; get the device name
	call	devload			; get device loaded if need be
	bcs	100$			; it did not work
	.rename	#rtwork,#lun.in,#renlst	; do the rename please
	bcs	90$			; oops
	call	200$			; log it please
	mov	#1	,r4		; one file renamed
	clr	r0			; no errors
	br	100$			; and exit

80$:	mov	#er$wld	,r0		; no wildcarding today
	br	100$			; exit

90$:	movb	@#errbyt,r0		; map the .rename error
	asl	r0			; times 2 as always
	mov	renerr(r0),r0		; simple

100$:	mov	r4	,r1		; return rename count
	beq	120$			; never got any files, exit
	cmp	r0	,#er$nmf	; no more files error?
	beq	110$			; yes, say no errors
	cmp	r0	,#er$fnf	; same goes for file not found
	bne	120$			; exit
110$:	clr	r0			; no errors
120$:	unsave	<r4,r3,r2>		; pop these and exit
	return



	.sbttl	log for the rt11 rename command

200$:	tst	4(r5)			; print a log of this out
	bmi	210$			; nothing to do
	print	@r5			; no wildcarding simplifies things
	print	#290$			; more
	print	2(r5)			; next
	print	#295$			;
210$:	return


290$:	.asciz	/ renamed to /
295$:	.byte	cr,lf,0
	.even
	

	.sbttl	the real work of delete


;	input:	@r5	first filename, .asciz
;		2(r5)	second filename, .asciz
;		4(r5)	if ge 0, print a log of files renamed

delete::save	<r2,r3,r4>		; save these please
	clr	r4			; no files renamed as of yet
	mov	#renlst	,r3		; where to build the .rename list
	mov	@r5	,r0		; string address
	call	docsi			; do the first one
	bcs	100$			; oops
	mov	#renlst	,r1		; check for wildcarding
	mov	#4	,r2		; four words to check for wildcards
10$:	cmp	(r1)+	,#star		; a wildcard today ?
	beq	80$			; yes, die
	sob	r2	,10$		; no, check the next one please
	mov	renlst	,r0		; get the device name
	call	devload			; get device loaded if need be
	bcs	100$			; it did not work
	.delete	#rtwork,#lun.in,#renlst	; do the delete please
	bcs	90$			; oops
	call	200$			; log it please
	mov	#1	,r4		; one file renamed
	clr	r0			; no errors
	br	100$			; and exit

80$:	mov	#er$wld	,r0		; no wildcarding today
	br	100$			; exit

90$:	movb	@#errbyt,r0		; map the .rename error
	asl	r0			; times 2 as always
	mov	renerr(r0),r0		; simple

100$:	mov	r4	,r1		; return rename count
	beq	120$			; never got any files, exit
	cmp	r0	,#er$nmf	; no more files error?
	beq	110$			; yes, say no errors
	cmp	r0	,#er$fnf	; same goes for file not found
	bne	120$			; exit
110$:	clr	r0			; no errors
120$:	unsave	<r4,r3,r2>		; pop these and exit
	return


200$:	tst	2(r5)			; print a log of this out
	bmi	210$			; nothing to do
	print	@r5			; no wildcarding simplifies things
	print	#290$			; more
210$:	return


290$:	.asciz	/ deleted/<cr><lf>
	.even




	.sbttl	parse device and filename


;	parse the filename(s)
;
;	input:	r0	address of filename
;		r3	pointer to result of parse

docsi:	save	<r1,r2>
	sub	#40.*2	,sp		; allocate a local filename buffer
	mov	sp	,r1		; and a pointer to it please
	mov	r0	,r2		; check for a ':' in the string
	scan	#':	,r2		; if there is no colon then insert
	tst	r0			; the defdir please
	bne	310$			; we found a colon in the string
	mov	#defdir	,r0		; no device was in the string so put
305$:	movb	(r0)+	,(r1)+		; in
	bne	305$			; next please
	dec	r1			; backup to the null we just copied
	
310$:	movb	(r2)+	,(r1)+		; copy it to the csi buffer
	bne	310$			; until a null byte is found.
	movb	#'=	,-1(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	320$			; it's ok
	mov	(r1)+	,(r3)+		; copy the device and filename
	mov	(r1)+	,(r3)+		; copy the device and filename
	mov	(r1)+	,(r3)+		; copy the device and filename
	mov	(r1)+	,(r3)+		; copy the device and filename
	add	#40.*2	,sp		; restore the stack
	clc				; no errors
	br	330$

320$:	movb	@#errbyt,r0		; get the error mapping for .csispc
	asl	r0			; index to word offsets
	mov	csierr(r0),r0		; simple
	add	#40.*2	,sp		; restore the stack
	sec				; flag the error and exit
330$:	unsave	<r2,r1>
	return



	.sbttl	get device driver loaded if need be

;	DEVLOAD
;
;	input:	r0	device name
;	output:	r0	error code if carry is set


devload:calls	fetch	,<r0>
	tst	r0			; did it work ?
	bne	90$			; no
	clc				; yes
	return
90$:	sec				; no
	return				; exit



	.sbttl	copy command

copy::	save	<r2,r3>			; save temp registers please
	clr	r2			; number of blocks = 0
	mov	#1000	,r3		;
	calls	open	,<@r5,#lun.in,#binary> ; get the input file
	tst	r0			; did it work?
	bne	110$			; no, simple exit then
	calls	create	,<2(r5),#lun.out,#binary> ; create the destination
	tst	r0			; did it work ?
	bne	100$			; no, close the input file now

10$:	calls	getc	,<#lun.in>	; get the next ch from the file
	tst	r0			; did it work ?
	bne	20$			; no, check for eof condition
	calls	putc	,<r1,#lun.ou>	; yes, copy to output file
	tst	r0			; did that work ?
	bne	20$			; no
	sob	r3	,10$		; next ch please
	inc	r2			; blocks := succ( blocks )
	mov	#1000	,r3		; copy the next block now
	br	10$			; back for more now please

20$:	cmp	r0	,#er$eof	; normal exit should be eof
	bne	30$			; it's not
	clr	r0			; clear error codes
30$:	save	<r0>			; save error code
	calls	close	,<#lun.in>	; close input file
	calls	close	,<#lun.ou>	; close output file
	unsave	<r0>			; restore error code and exit
	br	120$			; and exit

100$:	calls	close	,<#lun.in>	; close input if output create failed
110$:					;
120$:	mov	r2	,r1		; return number of blocks and exit
	unsave	<r3,r2>
	return






	.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.



ascdat::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

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



	.sbttl	get the ascii time 
	.mcall	.gtim

;	input:	@r5	buffer address for .asciz string


asctim::save	<r0,r1,r2,r3>		; save all registers that we use
	cmp	-(sp)	,-(sp)		; allocate two word buffer
	mov	sp	,r3		; and point to the small buffer
	.gtim	#rtwork	,r3		; and get the time, ticks past midnite
	mov	(r3)+	,r1		; get set to divide to get seconds
	mov	(r3)+	,r2		; setup for $ddiv
	mov	#60.*60.,r0		; at last
	call	ddiv			; double precision divide
	mov	r0	,-(sp)		; save ticks since last minute
	mov	#60.	,r0		; and get hours in r2, minutes in r0
	call	ddiv			; simple to do
	mov	@r5	,r1		; buffer address please
	mov	r2	,r3		; convert hours to ascii
	call	200$			; simple
	movb	#':	,(r1)+		; a delimiter
	mov	r0	,r3		; the minutes next please
	call	200$			; simple
	movb	#':	,(r1)+		; and a delimiter please
	mov	(sp)+	,r2		; now get the seconds extracted please
	mov	r1	,-(sp)		; save buffer pointer please
	clr	r1			; may as well use $ddiv
	mov	#60.	,r0		; simple
	call	ddiv			; simple to do
	mov	(sp)+	,r1		; restore buffer pointer
	mov	r2	,r3		; and convert to ascii
	call	200$			; do it
	clrb	@r1			; all done, make it .asciz and exit
	cmp	(sp)+	,(sp)+		; pop the two word buffer
	unsave	<r3,r2,r1,r0>		; pop registers we used and exit
	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





	.sbttl	double precision divide

;	Double precision divide (from RSX syslib)
;
;	input:	r2	=	low  order of dividend
;		r1	=	high order of dividend
;		r0	=	divisor
;
;	output:	r2	=	low  order of quotient
;		r1	=	high order of quotient
;		r0	=	remainder


ddiv:	mov	r3,-(sp)		; save r3
	mov	#40,r3			; set iteration count in r3
	mov	r0,-(sp)		; put divisor on the stack
	clr	r0			; set the remainder to zero
10$:	asl	r2			; shift the entire divedend
	rol	r1			; ...
	rol	r0			; ... to left and into remainder
	cmp	r0,(sp)			; is remainder greater than divisor
	blo	20$			; no, skip to iteration control
	sub	(sp),r0			; yes, subtract divisor out please
	inc	r2			; increment the quotient
20$:	dec	r3			; repeat please
	bgt	10$			; not done
	tst	(sp)+			; pop divisor
	mov	(sp)+,r3		; restore r3 and exit
	return				; bye




	.sbttl	read a record from a sequential file


;	G E T R E C
;
;	getrec( %loc buffer, %val channel_number )
;
;	input:	@r5	address of user buffer, at least 80 bytes
;		2(r5)	channel number
;
;	output:	r0	rms sts
;		r1	record size
;
;	Read the next record from a disk file.  Assumes that the
;	user  has supplied a buffer of 132 characters to  return
;	the record to.
;
;	We really don't need GETREC for RT11 Kermit. It was used
;	in the RMS11 version (for RSXM/M+ and RSTS) only in con-
;	junction with GETC to fake RMS single character i/o. The
;	only  two places it  is called from is for  the TYPE and
;	HELP commands (C$TYPE and C$HELP).
;	GETREC assumes text (stream ascii) file only.


	.iif ndf, FF , FF = 14
	.iif ndf, CR , CR = 15
	.iif ndf, LF , LF = 12

getrec::save	<r2,r3,r4>		; save registers we may need
	clr	r4			; recordsize := 0
	mov	@r5	,r3		; the recordbuffer address
	mov	#132.	,r2		; max size of a record to read
	clr	r1			; nothing read as of yet

10$:	cmpb	r1	,#ff		; exit if ch = form_feed
	beq	30$			;
	mov	2(r5)	,r0		; the channel number to use
	call	getcr0			; read the next character now
	tst	r0			; did it work ?
	bne	100$			; no
	cmpb	r1	,#cr		; exit if ch = carriage_return
	beq	30$			;
	cmpb	r1	,#'z&37		; exit if ch = control_z
	beq	30$			;
	cmpb	r1	,#lf		; ignore line feeds
	beq	10$			;
	inc	r4			; length := succ(length)
	movb	r1	,(r3)+		; yes, stuff the character in
	sob	r2	,10$		; up until maxrec size
	mov	#er$rtb	,r0		; too much data, return maxsize
	br	100$			; error


30$:	cmpb	r1	,#'z&37		; we get here on reading a record
	bne	40$			; terminator
	mov	#er$eof	,r0		; control z means end of file
	clr	r1			; no data is there at all
	br	100$
40$:	mov	r4	,r1		; return the record length
	br	100$			; all done if ff or lf	

100$:	unsave	<r4,r3,r2>		; pop registers we saved
	return				; bye

	.end
