.title	KRTUTL	Mount, rename, delete, copy, paksta, asctim, etc..
	.ident	"V03.62"

; /62/	27-Jul-93  Billy Youdelman
;
;	modify asctim to output ticks, restored optional time value pointer
;	move various items here from root to save space

; /BBS/	 1-Dec-91  Billy Youdelman  V03.61
;
;	added logical disk mount using TSX+ emts
;	getrec patched to accept passed buffer_length
;	50/60Hz test added to asctim
;	cleaned up the delete, rename and copy subroutines..
;	move copy file name checking to c$copy, now shared with PRINT
;	try to mount .DEV logical disk if .DSK default fails
;	fixed COPY error handling when out file is too small

;	Copyright 1984 Change Software, Inc.
;
;	18-Jul-84  16:14:46 Brian Nelson


	.include "IN:KRTMAC.MAC"
	.iif ndf  KRTINC  .error	<; .include for IN:KRTMAC.MAC failed>
	.include "IN:KRTDEF.MAC"
	.iif ndf  MSG$DA  .error	<; .include for IN:KRTDEF.MAC failed>

	.mcall	.CSISPC	,.DELETE,.GTIM	,.RENAME


	.psect	$code
	.sbttl	The real work of MOUNT	; /BBS/ added
	.enabl	lsb

;	input:	argbuf	= entire argument string, unparsed
;		 r1	= if <> then dismount

mount::	upcase	argbuf			; upper case all args
	mov	argbuf	,r2		; pointer to LDn:
	beq	9$			; not there..
	cmpb	#'L	,(r2)+		; is first byte an "L" ?
	bne	9$			; nope..
	cmpb	#'D	,(r2)+		; is second byte a "D" ?
	bne	9$			; nope..

	cmpb	(r2)	,#':		; is there a colon after LD?
	beq	73$			; ya
	tst	r1			; /62/ dismount?
	beq	3$			; no
	tstb	(r2)			; ya, thus a
	beq	73$			; null here = unit 0
3$:	cmpb	(r2)	,#space		; is there a space delimiter?
	beq	73$			; ya
	movb	(r2)+	,r0		; get unit #, sign bit should be zero
	sub	#'7+1	,r0		; check unit is 0 - 7 only, and..
	add	#7+1	,r0		; ..turn ascii into integer
	bcs	75$			; good number crosses 0, "LD:" won't
9$:	mov	#7	,r0		; bad num, insert error code
	br	99$			; and bail out

73$:	clr	r0			; set LD unit number to 0
75$:	movb	r0	,ldunit		; save LD unit number
	add	#'0	,r0		; turn it into an ascii digit
	movb	r0	,newdk+2	; and stick that into "LDn:"

	tst	r1			; /62/ dismount this one?
	beq	71$			; no
	jmp	200$			; ya..

71$:	mov	#elfmo	,r3		; where to write .rad50 file name
	cmpb	(r2)	,#':		; is there a colon after LDn?
	bne	77$			; no
	tstb	(r2)+			; ya, bump past it..
77$:	cmpb	(r2)	,#space		; is there a space delimiter?
	bne	78$			; no
	tstb	(r2)+			; ya, bump past it..
78$:	mov	r2	,-(sp)		; save pointer
	scan	#space	,r2		; look for a trailing space
	tst	r0			; find one?
	beq	80$			; not found
	add	r2	,r0		; point one byte past the space
	clrb	-(r0)			; bump back to space and hose it
	tstb	(r0)+			; point at first char after delimiter
	cmpb	(r0)+	,#'D		; iz it a "D" ?
	bne	79$			; nope..
	cmpb	(r0)+	,#'K		; iz it a "K"
	bne	79$			; nope
	tstb	@r0			; end of the line?
	beq	7$			; ya, it's "DK"  (no colon)
	cmpb	(r0)+	,#':		; no, is it "DK:" ?  (with colon)
	bne	79$			; no, so wutever it is, it's no good
	tstb	@r0			; anything else there?
	bne	79$			; ya, thus it's a bad assign

7$:	mov	sp	,dkflag		; set flag to make it DK:
	br	80$			; and continue

79$:	mov	#er$dk	,r0		; logical assign not supported..
	tst	(sp)+			; pop now useless pointer
	br	120$			; bail out

80$:	clr	dfflag			; init try default extents flag
	mov	(sp)+	,r2		; recover pointer to csi input string
	calls	fparse	,<r2,#srcnam>	; make "DK:name.dsk"="DEV:name.dsk"
	mov	#srcnam	,r0		; pass pointer to docsi
	call	docsi			; see if it'll fly
	bcs	120$			; oops, err mapped by docsi
	tst	-(r3)			; is there an extent??
	bne	88$			; ya..
	mov	sp	,dfflag		; flag to try .DSK and .DEV defaults
	mov	#^rDSK	,@r3		; and insert default .DSK extent
88$:	mov	#mntemt	,r0		; load emt args to
	emt	375			; attempt to mount specified device
	bcc	110$			; no problem
	movb	@#errbyt,r0		; get the mount error
	movb	ldunit	,disunit	; prep to dump bogus logical device
	cmp	#3	,r0		; is LDn already in use?
	bne	95$			; no
	mov	#dismnt	,r0		; ya, load args to
	emt	375			; dump it then mount new one
	bcc	88$			; it worked

	movb	@#errbyt,r0		; it didn't work, get the error
	cmp	#3	,r0		; is LDn already in use?
	bne	88$			; no
95$:	cmp	#6	,r0		; file not found?
	bne	99$			; no
	mov	r0	,-(sp)		; ya, save the error code
	mov	#dismnt	,r0		; don't leave not avail dev lurking
	emt	375			; no errors possible here..
	mov	(sp)+	,r0		; recover the error code

	tst	dfflag			; couldn't find .DSK default?
	beq	99$			; no
	mov	#^rDEV	,@r3		; ya, now try .DEV extent
	clr	dfflag			; but only try it once
	br	88$			; go back for .DEV attempt

99$:	asl	r0			; error mapping uses word indexing
	mov	mnterr(r0),r0		; simple
	br	120$
110$:	tst	dkflag			; make this mount DK?
	beq	117$			; no
	strcpy	#defdir	,#newdk		; /62/ ya, copy "LDn:" to defdir
	clr	dkflag			; and reset flag

117$:	clr	r0			; no errors
120$: ;	mov	r0	,-(sp)		; save any error
;	mov	#nocache,r0		; don't leave anything cached
;	emt	375			; no errors possible here..
;	mov	(sp)+	,r0		; restore saved error
	return

200$:	movb	ldunit	,disunit	; prep to dump logical disk
	mov	#dismnt	,r0		; load dismount emt arguments
	emt	375			; dump it
	bcc	217$			; it worked
	cmpb	@#errbyt,#3		; didn't happen, which error?
	bne	217$			; ignore error other than channel open
	mov	#ld$bsy	,r0		; pointer to appropriate error msg
	br	120$			; and bail out

217$:	mov	#defdir	,r0		; string to check
	mov	#newdk	,r1		; what it can no longer be
	mov	#5	,r2		; number of bytes to compare
220$:	cmpb	(r0)+	,(r1)+		; check one, bump for next time
	bne	117$			; no match
	sob	r2	,220$		; match, try next one
	strcpy	#defdir	,#dkname	; /62/ dismounted DK, so goto HOME dir
	br	117$			; done..

	.save
	.psect	$pdata
mntemt:	.byte	lun.ld ,163		; mount a logical device..
ldunit:	.byte	0 ,0			; read/write
elfmop:	.word	elfmo			; pointer to .rad50 file name
elfmo:	.word	0 ,0 ,0 ,0		; .rad50 file name lives here
dfflag:	.word	0			; try default extents (.DSK,.DEV) flag
dismnt:	.byte	3 ,135			; dump the LDn assign for..
disunit:.byte	0 ,0			; ..this unit number
dkflag:	.word	0			; assign this mount DK if set
;nocache:.byte	2 ,135			; dismount the world,
;	.word	0			; cache wise..
newdk:	.asciz	"LDn:"			; defdir string is loaded from here
	.even
	.restore

	.dsabl	lsb


	.sbttl	The real work of RENAME

;	input:	 (r5)	= first file name, .asciz
;		2(r5)	= second file name, .asciz

rename::save	<r2,r3>
	call	check2			; /BBS/ check file names
	tst	r0			; /BBS/ ok?
	bne	120$			; /BBS/ no
	clr	r1			; /BBS/ init # of files renamed count
	mov	#renlst	,r3		; where to build the .rename list
	mov	#srcnam	,r0		; string address
	call	docsi			; do the first one
	bcs	120$			; /BBS/ oops
	mov	#filnam	,r0		; now do the second file name
	call	docsi			; ok
	bcs	120$			; /BBS/ oops
	mov	renlst	,r0		; get the device name
	calls	fetch	,<r0>		; /62/ try to fetch the handler
	tst	r0			; /62/ did it work?
	bne	120$			; /62/ no
	.rename	#rtwork,#lun.in,#renlst	; do the rename please
	bcc	110$			; /BBS/ ok..
	movb	@#errbyt,r0		; map the rename error
	asl	r0			; word indexing
	mov	renerr(r0),r0		; simple
	br	120$

110$:	mov	#1	,r1		; /BBS/ only one file renamed here..
	clr	r0			; no errors
120$:	unsave	<r3,r2>
	return

	.save
	.psect	rendat	,rw,d,lcl,rel,con
renlst:	.word	0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ; rename list is built here
	.restore


	.sbttl	The real work of DELETE
	.enabl	lsb

;	input:	 (r5)	= file name, .asciz

delete::save	<r3>
	call	check1			; /BBS/ check file name
	tst	r0			; /BBS/ ok?
	bne	120$			; /BBS/ no
	mov	#renlst	,r3		; where to build the .delete list
	mov	#srcnam,r0		; string address
	call	docsi			; do the first one
	bcs	120$			; /BBS/ oops
	mov	renlst	,r0		; get the device name
	calls	fetch	,<r0>		; /62/ try to fetch the handler
	tst	r0			; /62/ did it work?
	bne	120$			; /62/ no
	.delete	#rtwork,#lun.ou,#renlst	; /BBS/ do the delete using lun.ou
	bcc	110$			; /BBS/ ok..
	movb	@#errbyt,r0		; map the delete error
	asl	r0			; word indexing
	mov	renerr(r0),r0		; rename errors are the same as delete
	br	120$			; /BBS/ bail out..

110$:	clr	r0			; no errors
120$:	unsave	<r3>
	return


	.sbttl	The real work of COPY	; /BBS/ heavily modified..
	.enabl	lsb

	PROT	= 100000		; /62/ protected file bit

;	input:	 (r5)	= input file name
;		2(r5)	= output file name

copy::	save	<r2,r3,r4>
	clr	r2			; number of blocks = 0
	call	check2			; check file names
	tst	r0			; ok?
	bne	1$			; /62/ no
	calls	open	,<#srcnam,#lun.in,#binary> ; get the input file
	tst	r0			; did it work?
	beq	2$			; /62/ ya
1$:	br	120$			; /62/ no, simple exit then

2$:	mov	#lun.out,r0		; /62/ output file channel
	asl	r0			; /62/ word indexing
	mov	lokdate	,date.a(r0)	; /62/ save create date
	mov	loktime	,time.a(r0)	; /62/ and time
	clr	prot.a(r0)		; /62/ preset as unprotected file
	bit	#prot	,lokstat	; /62/ protected?
	beq	3$			; /62/ nope..
	inc	prot.a(r0)		; /62/ ya

3$:	mov	#lun.in	,r1		; input file channel
	asl	r1			; word indexing
	mov	sizof(r1),at$len	; pass input file size to file opener
	calls	create	,<#filnam,#lun.out,#binary> ; create destination file
	tst	r0			; did it work?
	bne	purge			; no

9$:	mov	#1000	,r3		; init 512. byte counter (1 block)
10$:	calls	getc	,<#lun.in>	; get the next char from the file
	tst	r0			; did it work?
	bne	inerr			; no, check for EOF condition
	calls	putc	,<r1,#lun.ou>	; yes, copy to output file
	tst	r0			; did that work?
	bne	outerr			; no
	sob	r3	,10$		; next char please
	inc	r2			; blocks := succ(blocks)
	br	9$			; copy the next block now

inerr:	cmp	r0	,#er$eof	; normal exit should be EOF
	bne	purge			; it's not
	calls	close	,<#lun.ou>	; try to close output file
	save	<r0>			; save error code
	beq	33$			; no error, go close in file
	br	31$			; error, go dump bad file first

outerr:	cmp	r0	,#er$eof	; out file full?
	bne	purge			; no, it's something else
	mov	#er$ful	,r0		; ya, say not enuff free space..

purge:	save	<r0>			; save error
	calls	close	,<#lun.ou>	; flush buffer, close out file
31$:	calls	delete	,<#filnam>	; then dump it, it's no good now
33$:	calls	close	,<#lun.in>	; close input file
	unsave	<r0>			; restore error code

120$:	mov	r2	,r1		; return number of blocks copied
	unsave	<r4,r3,r2>
	return

	.dsabl	lsb


	.sbttl	Parse device and file name

;	input:	 r0	= address of file name
;		 r3	= pointer to result of parse

docsi:	save	<r1>
	sub	#40.*2	,sp		; allocate a local file name buffer
	mov	sp	,r1		; and a pointer to it please

310$:	movb	(r0)+	,(r1)+		; /BBS/ 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
	mov	(r1)+	,(r3)+		; device
	mov	(r1)+	,(r3)+		; and
	mov	(r1)+	,(r3)+		; file name
	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	<r1>
	return

	.save
	.psect	rendat	,rw,d,lcl,rel,con
defext:	.word	0 ,0 ,0 ,0		   ; .csispc default extents
	.restore


	.sbttl	Check file name(s)
	.enabl	lsb

check2:	calls	fparse	,<2(r5),#filnam> ; /BBS/ added this..
	tst	r0			; ok?
	bne	120$			; no
	calls	iswild	,<#filnam>	; check second file name
	tst	r0			; wild?
	bne	120$			; ya..
check1:	calls	fparse	,<@r5,#srcnam>	; check first file name
	tst	r0			; ok?
	bne	120$			; no
	calls	iswild	,<#srcnam>	; return with
120$:	return				; any error will be in r0

	.dsabl	lsb


	.sbttl	Like bufemp, but return data to a buffer

;	input:	  (r5)	= source buffer, .asciz
;	output:	 2(r5)	= destination buffer
;		   r0	= zero (no errors are possible)
;		   r1	= string length
;
;	No 8-bit prefixing will be done.  This routine
;	used for decoding strings received for generic
;	commands to the server.

bufunp::save	<r2,r3,r4,r5>
	mov	@r5	,r2		; input record address
	clr	r3			; length := 0
	mov	2(r5)	,r4		; resultant string

10$:	clr	r0			; get the next character
	bisb	(r2)+	,r0		; into a convenient place
	beq	100$			; all done
	bic	#^c177	,r0		; /53/ always seven bit data
	mov	#1	,r5		; /53/ assume character not repeated
	tst	dorpt			; /53/ repeat processing off?
	beq	20$			; /53/ yes, ignore
	cmpb	r0	,rptquo		; /53/ is this a repeated char?
	bne	20$			; /53/ no, normal processing
	clr	r5			; /BBS/ init to copy repeat count!
	bisb	(r2)+	,r5		; /53/ yes, get the repeat count
	bic	#^c177	,r5		; /53/ always seven bit data
	unchar	r5	,r5		; /53/ get the value
	tst	r5			; /53/ good data
	bgt	15$			; /53/ yes
	mov	#1	,r5		; /53/ no, fix it
15$:	clr	r0			; /53/ avoid sign extension
	bisb	(r2)+	,r0		; /53/ now get the real data
	bic	#^c177	,r0		; /53/ always seven bit data
20$:	cmpb	r0	,senpar+p.qctl	; is this a quoted character?
	bne	30$			; no
	clr	r0			; yes, get the next character
	bisb	(r2)+	,r0		; must be one you know
	clr	r1			; must avoid sign extension here
	bisb	r0	,r1		; check low 7 bits against quote
	bic	#^c177	,r1		; drop 7..15
	cmpb	r1	,senpar+p.qctl	; if ch <> myquote
	beq	30$			;  then
	ctl	r0	,r0		;   ch := ctl(ch)

30$:	movb	r0	,(r4)+		; copy the byte over now
	inc	r3			; length := succ(length)
	sob	r5	,30$		; /53/ perhaps data was repeated
	br	10$			; next character please

100$:	clrb	@r4			; make the string .asciz
	mov	r3	,r1		; return the length
	clr	r0			; fake no errors please
	unsave	<r5,r4,r3,r2>
	return


	.sbttl	Calculate time used to send last packet	; /62/ all new..
	.enabl	lsb

paksta::mov	r2	,-(sp)		; save ptr to "REC.SW" or "SEN.SW"
	mov	pkrate+4,-(sp)		; save to test for first time through
	mov	pkrate+0,pkrate+4	; start of last packet time hi word
	mov	pkrate+2,pkrate+6	; and time lo word
	.gtim	#rtwork	,#pkrate	; get start time of next packet
	tst	(sp)+			; first pass on this transaction?
	bge	5$			; no
	mov	#131$	,r2		; ya, kick off with a newline..
	br	30$			; ..by jumping in here
5$:	mov	#110$	,r2		; point to "TOD "
	call	101$			; copy into output string
	calls	asctim	,<r1,#pkrate>	; make it ascii, insert in buff
	add	#11.	,r1		; bump past time just written
	mov	#120$	,r2		; point to "  "
	call	101$			; copy into output string
	mov	clkflg	,r0		; pass clock rate
	call	L10012			; write same to out string
	mov	#123$	,r2		; point to "Hz   Elapsed_Time "
	call	101$			; copy into output string
	mov	pkrate+2,-(sp)		; time now low word
	mov	pkrate+0,-(sp)		; and high word
	sub	pkrate+6,2(sp)		; subtract time then low word
	sbc	(sp)			; watch the carry
	sub	pkrate+4,(sp)		; now do the high word
	bge	10$			; didn't cross midnight
	add	#6656.	,2(sp)		; did, low word of # ticks in 24 hours
	adc	(sp)			; add carry to 32-bit hi word
	add	#79.	,(sp)		; hi word of # ticks in 24 hours
10$:	mov	sp	,r2		; pointer to time data on stack
	calls	asctim	,<r1,r2>	; make it ascii, insert in buff
	cmp	(sp)+	,(sp)+		; pop duration buffer
	add	#11.	,r1		; bump past time just written
	mov	#130$	,r2		; point to <cr><lf><cr><lf>
30$:	call	101$			; copy into output string
	mov	(sp)+	,r2		; get ptr to "REC.SW" or "SEN.SW"
	call	101$			; copy into output string
	mov	#140$	,r2		; point to ".SW = STA."
	call	101$			; copy into output string
	scan	state	,#150$		; look for a match
	asl	r0			; word indexing
	mov	160$(r0),r2		; to corresponding text
101$:	movb	(r2)+	,(r1)+		; copy some text..
	bne	101$			; until we find a null
	dec	r1			; backup over it
	return

	.save
	.psect	$pdata
110$:	.asciz	"TOD "
120$:	.asciz	"  "
123$:	.asciz	"Hz   Elapsed_Time: "
130$:	.ascii	<cr><lf>		; two newlines from here
131$:	.asciz	<cr><lf>
140$:	.asciz	" = STA."

150$:	.byte	STA.CCA	,STA.ABO,STA.BRK,STA.COM,STA.DAT,STA.FIL
	.byte	STA.ATR	,STA.INI,STA.RIN,STA.SIN,STA.TYP,STA.EOF
	.byte	0
	.even
160$:	.word	999$
	.word	700$	,710$	,720$	,730$	,740$	,750$
	.word	760$	,770$	,780$	,790$	,800$	,810$

700$:	.asciz	"CCA  ^C Abort"
710$:	.asciz	"ABO  Abort"
720$:	.asciz	"BRK  Break Link"
730$:	.asciz	"COM  Transaction Complete"
740$:	.asciz	"DAT  Data"
750$:	.asciz	"FIL  File Name"
760$:	.asciz	"ATR  Attributes"
770$:	.asciz	"INI  Server Init"
780$:	.asciz	"RIN  Receive Init"
790$:	.asciz	"SIN  Send Init"
800$:	.asciz	"TYP  Extended Reply"
810$:	.asciz	"EOF  End of File"
999$:	.asciz	"BAD  Unknown State"
	.even
	.restore

	.dsabl	lsb


	.sbttl	Print received error packet on terminal
	.enabl	lsb

;	P R E R R P
;
;	input:	 (r5)	= address of .asciz string to print

prerrp::tst	remote			; /BBS/ if running as remote..
	bne	100$			; /BBS/ ..there's no term to type this
	tstb	(r5)			; /62/ anything to print?
	beq	100$			; /62/ no
	tst	logini			; /BBS/ need a .newline if this is set
	beq	7$			; /BBS/ no, this line is clean
	.newline			; start on a fresh line
7$:	wrtall	#200$			; a prefix line
	wrtall	@r5			; the actual error message
	.newline
	clr	logini			; ensure logging header is retyped
100$:	return

	.save
	.psect	$pdata
200$:	.asciz	"Error message from remote:"<cr><lf>  ; /62/
	.even
	.restore

	.dsabl	lsb


	.sbttl	Get time of day		; /62/ use cvttim to include ticks

;	input:	 (r5)	= buffer address for .asciz string
;		2(r5)	= if <>, location of time value to process	; /62/

asctim::save	<r0,r1,r2,r3>
	mov	2(r5)	,r3		; /62/ was a pointer passed?
	bne	15$			; /62/ ya, do it instead of curr. time
	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
	cmp	(sp)+	,(sp)+		; /62/ pop here, save a couple words..
15$:	mov	(r3)+	,hitime		; /62/ hi word for divide
	mov	(r3)	,lotime		; /62/ and lo word
	push	r5			; /62/ save this pointer
	mov	#timemt,r5		; /62/ give cvttim its arguments
	call	cvttim			; /62/ convert to hrs/mins/secs/ticks
	pop	r5			; /62/ restore pointer
	mov	@r5	,r1		; buffer address please
	mov	hours	,r3		; convert hours to ascii
	call	i2toa			; simple
	movb	#':	,(r1)+		; a delimiter
	mov	mins	,r3		; the minutes next please
	call	i2toa			; simple
	movb	#':	,(r1)+		; and a delimiter please
	mov	secs	,r3		; /62/ pass seconds to i2toa
	call	i2toa			; and convert to ascii
	movb	#'.	,(r1)+		; /62/ use a dot delimiter
	mov	ticks	,r3		; /62/ pass ticks to i2toa
	call	i2toa			; /62/ convert to ascii
	clrb	@r1			; all done, make it .asciz
	unsave	<r3,r2,r1,r0>
	return

	.save
	.psect	$rwdata	,rw,d,lcl,rel,con
hitime:	.word	0			; /62/ high word of time
lotime:	.word	0			; /62/ low word
hours:	.word	0			; /62/ output integer hours
mins:	.word	0			; /62/ minutes
secs:	.word	0			; /62/ seconds
ticks:	.word	0			; /62/ ticks
timemt:	.byte	5			; /62/ number of arguments
	.byte	0			; /62/ reserved
	.word	hitime			; /62/ cvttim input time address
	.word	hours			; /62/ hours address
	.word	mins			; /62/ mins
	.word	secs			; /62/ secs
	.word	ticks			; /62/ ticks
	.restore

	.end