.title	KRTREC	Receive file processing
	.ident	"V03.62"

; /62/	27-Jul-93  Billy Youdelman
;
;	dump FILLOG, as PRINTM now does this
;	use log$packets for state logging
;	provide for logfile errors
;	modify to not NAK unknown packets (noise)
;	display any possible contents of "X" packet, for Unix and C-Kermit

; /BBS/	 1-Dec-91  Billy Youdelman  V03.61
;
;	rfil.x: put "Remote server response:" here so it displays even
;	when blo <>1.  also set image=binary here so typing 8-bit
;	files doesn't die on checksum error when clrpar hoses hi bits
;
;	rfil.f: check asname here (instead of rfil.d), also fixed so
;	VMS filespecs longer than 66. bytes don't write past end of the
;	scratch buffer.  also namcvt strips VMS node::dev:[dir] here..
;
;	kill debug to TT if not running as a local Kermit
;	add support for INCOMPLETE_FILE_DISPOSITION

;	13-Oct-84  14:06:43  Brian Nelson
;
;	Copyright 1983,1984  Change Software, Inc.
;
;	This software is furnished under a license and may
;	be  used  and  copied  only in accordance with the
;	terms of such license and with  the  inclusion  of
;	the  above copyright notice.  This software or any
;	other copies thereof may not be provided or other-
;	wise made available to any other person.  No title
;	to and ownership of the software is hereby  trans-
;	ferred.
;
;	The information in this  software  is  subject  to
;	change  without notice and should not be construed
;	as a commitment by the author.


	.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	.PURGE			; /62/ hose dir search chan on error


	.sbttl	Local data

	.psect	$pdata			; /62/ consolidated this stuff here..
dejavu:	.asciz	"Duplicate packet rec'd, possible noise induced TIME_OUT"
dejatag:.asciz	", paknum: "
nojavu:	.asciz	"Ignoring invalid response or noise"
R20$:	.asciz	<bell>"Receive completed"
R21$:	.asciz	<bell>"Receive failed"
RD21$:	.byte	abt$all	,0
RD22$:	.byte	abt$cur	,0
RD24$:	.asciz	"Created file - "
RD25$:	.asciz	"You have SET FILE PROTECT thus "
RD26$:	.asciz	" can't be overwritten"
RE2$:	.asciz	"REC.SW"
RE3$:	.asciz	"Warning: Parity found in SOH byte"
RN2$:	.asciz	" renamed to "
	.even


	.psect	$code
	.sbttl	Receive file(s)		; /62/ moved this here..

c$rec::	call	opentt			; initialize the link device
	tst	r0			; /BBS/ did it work?
	bne	20$			; /BBS/ no
	tst	outopn			; is an output file already open?
	beq	10$			; no
	calls	close	,<#lun.ou>	; yes, close it up please
10$:	mov	sp	,inprogress	; /BBS/ packets are being exchanged
	calls	recsw	,<#sta.rin>	; get the file
	tst	r0			; did it work?
	bne	20$			; no
	calls	printm	,<#1,#R20$>	; /62/ yes, say so if we are local
	br	100$
20$:	calls	printm	,<#1,#R21$>	; /62/ it failed, say so if local
	inc	status			; /45/ flag for batch exit
100$:	clr	inprogress		; /BBS/ packets are now done
	call	clostt			; release the terminal
	jmp	clrcns			; /62/ flush TT input, clear r0


	.sbttl	State controller for receive file processing
	.enabl	lsb

recsw::	clr	paknum			; packet_number := 0
rec.sw::movb	@r5	,state		; load passed state
	clr	cccnt			; no ^Cs typed yet
	mov	$image	,image		; ensure correct default for mode
	movb	#defchk	,chktyp		; reset checksum type to default
	mov	#1	,chksiz		; size of default checksum
	clr	numtry			; number_trys := 0
	clr	outopn			; say nothing is open now
	clr	logini			; /62/ force display stats header
	call	rechdr			; init the stats and terminal display
	movb	rectim	,senpar+p.time	; /62/ load RECEIVE time_out value

10$:	call	recdeb			; perhaps debugging should be done
	call	reclog			; /62/ update transfer stats display
	cmp	incpar	,#1		; /56/ is it possible that parity
	bne	15$			; /56/ is messed up?
	calls	printm	,<#1,#RE3$>	; /62/ warn, but only once
	inc	incpar			; /BBS/ be sure it is only once!
15$:	tst	remote			; /43/ running as a server?
	bne	20$			; /43/ yep, ignore random noise
	tst	cccnt			; /36/ ^C abort?
	beq	20$			; /36/ no
	movb	#sta.cca,state		; /36/ yes, enter abort state
20$:	scan	state	,#200$		; now dispatch
	asl	r0			; based on current
	jsr	pc	,@210$(r0)	; state
	bcc	10$			; continue whilst carry remains clear

	movb	#defchk	,chktyp		; reset type of checksum to 1
	mov	#1	,chksiz		; the above checksum uses 1 byte
	save	<r0>			; save exit status
	tst	outopn			; file open from a failure?
	bpl	110$			; no
	calls	close	,<#lun.ou>	; ensure that it's closed
110$:	clr	outopn			; clear this flag to say it is..
	.purge	#lun.sr			; /62/ close dir search channel
	call	incsta			; /43/ init timer stats
	unsave	<r0>			; pop exit status code please
	return

	.save
	.psect	$pdata
200$:	.byte	sta.abo	,sta.com,sta.dat,sta.fil,sta.rin,sta.cca
	.byte	0
	.even
210$:	.word	recs.$
	.word	recs$$	,recs.c	,recs.d	,recs.f	,recs.r	,ccabort ; /62/
	.restore

	.dsabl	lsb


	.sbttl	State routines for RECSW
	.enabl	lsb			; /62/

ccabort:spack	#msg$err,paknum		; /36/ break out the sender
recs$$:	tst	outopn			; /62/ is an output file open?
	bge	80$			; /BBS/ no..
	mov	incfile	,skipfile	; /BBS/ ya, disposition to file closer
80$:	mov	sp	,r0		; abort
	br	90$

recs.$:	call	recx.$			; /62/ report invalid packet type
	br	100$			; /62/ then go back and try it again

recs.c:	clr	r0			; complete
90$:	sec				; force exit from recsw loop
	return

recs.d:	call	rdata			; receive_data
	br	100$			; /62/ pass state, keep recsw running

recs.f:	call	rfile			; receive_file
	br	100$			; /62/ pass state, keep recsw running

recs.r:	call	rinit			; receive_init
100$:	movb	r1	,state		; pass returned state
	clc				; keep recsw running
	return

	.dsabl	lsb			; /62/


	.sbttl	Received bad ACK/NAK and error handling
	.enabl	lsb			; /62/ all new..

recx.e:	calls	prerrp	,<#packet>	; received error packet, display it
	br	rabort
r$sync:	call	m$sync			; packets out of sync error
	br	rabort
r$retry:call	m$retry			; too many retries error
rabort:	movb	#sta.abo,r1		; exit please
	return

recx$$:	spack	#msg$nak,paknum		; NAK a time_out or bad checksum
	br	20$
recx.$:	mov	#nojavu	,r3		; ignore an invalid packet type
	br	10$
deja$vu:spack	#msg$ack,r3		; ACK the last packet again
deja$$:	mov	#dejavu	,r3		; dupe packet received
10$:	mov	#pcnt.r	,r1		; packet number
	mov	#spare1	,r0		; where to write ascii output
	clr	r2			; kill leading zero and spaces
	call	$cddmg			; convert 32-bit # to ascii
	clrb	@r0			; make it .asciz
	calls	printm	,<#3,r3,#dejatag,#spare1> ; say what's up
20$:	movb	state	,r1		; stay in the same state, try again
	return

	.dsabl	lsb


	.sbttl	Receive debugging and logging	; /62/ major revision..

recdeb:	mov	trace	,r0		; copy of debug status word
	bic	#^c<log$pa!log$de>,r0	; need to do this?
	beq	50$			; nope
	save	<r1,r2>
	sub	#100.	,sp		; allocate a small buffer
	mov	sp	,r1		; point to it
	mov	#RE2$	,r2		; /62/ point to "REC.SW"
	call	paksta			; get elapsed time of last transaction
	sub	sp	,r1		; get the record length
	mov	sp	,r2		; and point back to the record
	bit	#log$pa	,trace		; debugging for rec.sw?
	beq	30$			; not on
	calls	putrec	,<r2,r1,#lun.lo> ; it is on, dump it
	tst	r0			; did it work?
	beq	30$			; ya
	call	logerr			; no, handle the error
30$:	tst	remote			; running locally? /BBS/ moved here
	bne	40$			; no
	bit	#log$de	,trace		; ya, is terminal debugging on?
	beq	40$			; no
	wrtall	r2			; ya, print it
	.newline
40$:	add	#100.	,sp		; pop local buffer
	unsave	<r2,r1>
50$:	return


	.sbttl	Receive file initialization
	.enabl	lsb

rinit:	inc	numtry			; check for retry count
	cmp	numtry	,initry		; been here too often?
	blos	10$			; no
	 jmp	r$retry			; /62/ log/send the reason for abort

10$:	rpack	r2 ,r3	,#packet,#maxlng ; /62/ get the next packet please
	scan	r1	,#200$		; look for the packet type
	asl	r0			; word indexing
	jmp	@210$(r0)		; /62/ dispatch to it

	.save
	.psect	$pdata
200$:	.byte	msg$err	,msg$snd,timout	,badchk
	.byte	0
	.even
210$:	.word	recx.$				; /62/
	.word	recx.e	,rini.s	,recx$$	,recx$$	; /62/
	.restore

	.dsabl	lsb


	.sbttl	Process response to RINIT

rini.s:	calls	rpar	,<#packet,r2>	; send_init  get other side's init
	calls	spar	,<#packet>	; parameters, then fill with ours
	spack	#msg$ack,paknum,sparsz,#packet ; and ship that back to sender
	clr	numtry			; retry_count := 0
	incm64	paknum			; paknum := (paknum+1) mod 64
	movb	#sta.fil,r1		; state := file_receive
	jmp	inirepeat		; /62/ initialize repeat processing


	.sbttl	Receive file header
	.enabl	lsb

rfile:	inc	numtry			; check for retry count
	cmp	numtry	,maxtry		; been here too often?
	blos	5$			; no
	 jmp	r$retry			; /62/ log why we aborted please

5$:	call	clratr			; ensure attribute stuff is cleared
	movb	conpar+p.chkt,chktyp	; time to use new checksum
	movb	chktyp	,chksiz		; compute the checksum size also
	sub	#'0	,chksiz		; simple
	mov	$image	,image		; ensure correct default for mode
	tst	xgottn			; already get the "X" packet?
	beq	10$			; no
	movb	#sta.typ,r1		; yes, fake that we already got it
	br	20$
10$:	rpack	r2 ,r3	,#packet,#maxlng ; /62/ get the next packet please
20$:	scan	r1	,#200$		; look for the packet type
	asl	r0			; word indexing
	jmp	@210$(r0)		; /62/ and dispatch to it

	.save
	.psect	$pdata
200$:	.byte	msg$bre	,msg$err,msg$fil,msg$snd,msg$tex,msg$eof
	.byte	timout	,badchk
	.byte	0
	.even
210$:	.word	recx.$						; /62/
	.word	rfil.b	,recx.e	,rfil.f	,rfil.s	,rfil.x	,rfil.z	; /62/
	.word	recx$$	,recx$$					; /62/
	.restore

	.dsabl	lsb


	.sbttl	Process response to RFILE

rfil.b:	cmp	r3	,paknum		; break_transmission (EOT)
	beq	10$			; ensure break is for current packet
	 jmp	r$sync			; /62/ it's not, we are out of sync

10$:	spack	#msg$ack,paknum		; ACK the break
	movb	#sta.com,r1		; and return state as complete
	return


	.sbttl	Receive file name	; 18-Apr-84 10:24:45  Brian Nelson

;	Move the actual file create to RDATA so we can create
;	the output file after all attribute packets have come.
;	Thus, when we get the first DATA packet is when we go
;	and create the file.

rfil.f:	cmp	r3	,paknum		; file name
	beq	10$			; ensure correct packet number
	 jmp	r$sync			; /62/ log the reason for this abort

10$:	calls	bufunp	,<#packet,#spare1> ; /BBS/ use buff that's long enough
	calls	namcvt	,<#spare1,#packet> ; /BBS/ maybe strip node::dev:[dir]
	calls	fixfil	,<#packet,#srcnam> ; fix invalid chars/trunc for RT-11
	mov	#asname	,r1		; /62/ point to possible new name
	tstb	(r1)			; /62/ renaming this time?
	bne	13$			; /62/ ya, go say so..
	mov	#srcnam	,r1		; /62/ no, point to old file name
	tst	r0			; was the old file name ok?
	beq	15$			; /62/ yes
13$:	calls	printm	,<#3,#spare1,#RN2$,r1> ; /62/ no, display the change

15$:	upcase	r1			; /BBS/ be sure it's ok for RT-11
	calls	fparse	,<r1,#filnam>	; /BBS/ parse and fill in defaults
	clrb	asname			; /BBS/ one shot for alternate name
	tst	r0			; /42/ successful parse?
	bne	100$			; /42/ no
	tst	outopn			; output already open as if from
	bpl	20$			; a NAK or something?
	calls	close	,<#lun.ou>	; yes, close it please
20$:	clr	outopn			; flag it's closed
	spack	#msg$ack,paknum		; please ACK the file header packet
	clr	numtry			; and init the current retry count
	incm64	paknum			; paknum := (paknum+1) mod 64
	movb	#sta.dat,r1		; return data
	return

100$:	calls	syserr	,<r0,#errtxt>	; /42/ no, get the system error text
	calls	error	,<#3,#errtxt,#aspace,r1> ; /BBS/ include bad name
	jmp	rabort			; /62/ abort


rfil.s:	inc	numtry			; send_init, must have lost ours
	cmp	numtry	,maxtry		; tried this too many times?
	blos	10$			; no
	 jmp	r$retry			; /62/ log the reason for the abort

10$:	mov	paknum	,r1		; does this packet=(paknum+63) mod 64?
	dec	r1			; /62/ if this packet was the one sent
	bge	11$			; /62/ the last time, we must reACK
	mov	#63	,r1		; /62/ that packet and remain
11$:	cmp	r3	,r1		; /62/ in the current state
	bne	20$			; no
	 calls	spar	,<#packet>	; ya, reload parameters and
	 spack	#msg$ack,r3,sparsz,#packet ; resend our send_init stuff
	 jmp	deja$$			; /62/ warn dupe packet occurred

20$:	 jmp	r$sync			; /62/ log reason for this event


rfil.x:	cmp	r3	,paknum		; "X" packets come here for processing
	beq	10$			; ensure correct packet number
	 jmp	rabort			; /62/ it wasn't, abort

10$:	mov	sp	,xmode		; flag this is an extended reply
	message	<Remote server response:>,cr ; /BBS/ do here instead of rem.x
	.newline			; /62/ format display
	tst	r2			; /62/ length of data in packet buffer
	beq	20$			; /62/ nothing there
	cmp	r2	,#sp1size	; /62/ length within buffer boundary?
	blos	15$			; /62/ ya
	mov	#sp1size,r2		; /62/ no, but it is now..
15$:	add	#packet	,r2		; /62/ physical addr of next free byte
	clrb	(r2)			; /62/ null terminate for bufemp
	calls	bufunp	,<#packet,#spare1> ; /62/ unpack repeat encoded chars
	wrtall	#spare1			; /62/ then print the data
	.newline			; /62/
20$:	spack	#msg$ack,paknum		; ACK the file name
	clr	outlun			; not a real file, output is to TT
	clr	outopn			; nothing is open for output
	calls	open	,<#0,#lun.kb,#text> ; /BBS/ init TT output buffer
	mov	#binary	,image		; /BBS/ force 8-bit for remote type..
	clr	numtry			; and init the current retry count
	incm64	paknum			; paknum := (paknum+1) mod 64
	movb	#sta.dat,r1		; return data
	return


rfil.z:	inc	numtry			; end_of_file?
	cmp	numtry	,maxtry		; tried this too many times?
	blos	10$			; no
	 jmp	r$retry			; /62/ log the reason for this event

10$:	mov	paknum	,r1		; does this packet=(paknum+63) mod 64?
	dec	r1			; /62/ if this packet was the one sent
	bge	11$			; /62/ the last time, we must reACK
	mov	#63	,r1		; /62/ that packet and remain
11$:	cmp	r3	,r1		; /62/ in the current state
	bne	20$			; not the last one after all
	 jmp	deja$vu			; /62/ reACK, warn dupe pkt occurred

20$:	 jmp	r$retry			; /62/ log the reason for this please


	.sbttl	Receive file data
	.enabl	lsb

;	R D A T A
;
;	output:	paknum	= packet number
;		packet	= data just received
;		 r1	= returned state

rdata:	inc	numtry			; abort of retry count is too large
	cmp	numtry	,maxtry		; been here too many times?
	blos	10$			; no
	 jmp	r$retry			; /62/ log/send error message about it

10$:	rpack	r2 ,r3  ,#packet,#maxlng ; /62/ get the next incoming packet
	scan	r1	,#200$		; look for the packet type & dispatch
	asl	r0			; to the correct routine, ie, a crude
	jmp	@210$(r0)		; /62/ case statement

	.save
	.psect	$pdata
200$:	.byte	msg$atr	,msg$dat,msg$err,msg$fil,msg$tex,msg$eof
	.byte	timout	,badchk
	.byte	0
	.even
210$:	.word	recx.$						; /62/
	.word	rdat.a	,rdat.d	,recx.e	,rdat.f	,rdat.x	,rdat.z	; /62/
	.word	recx$$	,recx$$					; /62/
	.restore

	.dsabl	lsb

	.sbttl	Process response to RDATA

rdat.a:	cmp	r3	,paknum		; case "A"
	beq	40$			; correct packet number?
	inc	numtry			; no, see if retry limit expired
	cmp	numtry	,maxtry		; if so, return abort
	blos	20$			; no
	 jmp	r$retry			; /62/ yes, log/send the reason

20$:	mov	paknum	,r1		; does this packet=(paknum+63) mod 64?
	dec	r1			; /62/ if this packet was the one sent
	bge	21$			; /62/ the last time, we must reACK
	mov	#63	,r1		; /62/ that packet and remain
21$:	cmp	r3	,r1		; /62/ in the current state
	bne	30$			; not the last packet
	 jmp	deja$vu			; /62/ reACK, warn dupe pkt occurred

30$:	 jmp	rabort			; /62/ abort, must be way out of sync

40$:	calls	r$attr	,<#packet>	; process the received attributes
	tst	r0			; was this successful?
	bne	30$			; /62/ no, bail out
	spack	#msg$ack,paknum		; ya, ACK it
	clr	numtry			; numtry := 0
	incm64	paknum			; increment packet number mod 64
	movb	state	,r1		; retain current state
	return


rdat.d:	tst	xmode			; do we need to create the file
	bne	1$			; no
	tst	outopn			; did we already open the file?
	bne	1$			; yes, please don't try again then
	tst	filprot			; protect existing files?
	beq	2$			; no
	clr	index			; /62/ reset lookup's file counter
	calls	lookup,<#filnam,#srcnam> ; /62/ does file exist already?
	tst	r0			; /62/ well?
	bne	2$			; /62/ no
	.purge	#lun.sr			; /62/ ya, hose dir search channel
	calls	printm	,<#3,#RD25$,#filnam,#RD26$> ; /62/ ya, say so..
	spack	#msg$ack,paknum,#1,#RD22$ ; /62/ send an ACK with "X" in data
	incm64	paknum			; increment packet number mod 64
	clr	numtry			; /48/
	mov	#1	,outopn		; never really opened it up
	movb	#sta.dat,r1		; switch to data state
	return

1$:	br	10$			; 10$ is otherwise too far away..

2$:	mov	#filnam	,r4		; /36/ setup address of file
	calls	create	,<r4,#lun.ou,image> ; /36/ now create it
	mov	#lun.ou	,outlun		; set a real lun for output
	tst	r0			; did the file create work?
	beq	5$			; yes
	calls	syserr	,<r0,#errtxt>	; no, get the system error text
	calls	error	,<#3,#errtxt,#aspace,r4> ; /BBS/ add space here
	jmp	rabort			; /62/ abort

5$:	calls	printm	,<#2,#RD24$,r4>	; /62/ log to terminal
	mov	#-1	,outopn		; flag output as being open

10$:	cmp	r3	,paknum		; case "D"
	beq	40$			; correct packet number?
	inc	numtry			; no, see if retry limit expired
	cmp	numtry	,maxtry		; if so, return abort
	blos	20$			; no
	 jmp	r$retry			; /62/ log/send notice of error

20$:	mov	paknum	,r1		; does this packet=(paknum+63) mod 64?
	dec	r1			; /62/ if this packet was the one sent
	bge	21$			; /62/ the last time, we must reACK
	mov	#63	,r1		; /62/ that packet and remain
21$:	cmp	r3	,r1		; /62/ in the current state
	bne	30$			; not the last packet
	 jmp	deja$vu			; /62/ reACK, warn dupe pkt occurred

30$:	 jmp	r$sync			; /62/ log/send the reason for abort

40$:	add	r2	,charin+2	; /43/ stats
	adc	charin+0		; /43/ in 32. bits please
	calls	bufemp	,<#packet,r2>	; correct packet, get the data out
	tst	r0			; did bufemp return any errors?
	beq	41$			; no
	calls	syserr	,<r0,#errtxt>	; ya, lookup error msg text
	calls	error	,<#1,#errtxt>	; send error packet or display err msg
	jmp	100$			; /62/ take the abort exit please

41$:	tst	xmode			; /62/ amidst an extended reply?
	beq	43$			; /62/ no
	mov	trace	,r1		; /62/ copy of debug status word
	bic	#^c<log$de!log$rp>,r1	; /62/ hose all except TT options
	beq	43$			; /62/ not now debugging to terminal
	.newline			; /62/ using TT, put next in the clear
43$:	tst	remote			; are we a local Kermit today?
	bne	70$			; no, just ACK normally
	tst	cccnt			; we are local. check for control
	bne	60$			; c abort for this file please
	call	chkabo			; check for abort via ^X and ^Z
	cmpb	r0	,#abt$err&37	; ^E aborts NOW
	beq	60$			; yes, abort please
	cmpb	r0	,#abt$all&37	; did the user type a ^Z?
	beq	50$			; yes
	cmpb	r0	,#abt$cur&37	; no, what about a ^X then?
	beq	45$			; /56/ yes
	cmpb	r0	,#'A&37		; /56/ ^A stats?
	bne	70$			; /56/ no
	tst	xmode			; /BBS/ don't do this
	bne	70$			; /BBS/ within an extended reply
	call	cs$in			; /56/ yes, print stats
	br	70$			; /56/ and exit

45$:	spack	#msg$ack,paknum,#1,#RD22$ ; /62/ ^X typed, send "X" in data
	br	501$
50$:	spack	#msg$ack,paknum,#1,#RD21$ ; /62/ ^Z typed, ACK with "Z" data
501$:	tst	xmode			; /BBS/ is an output file open?
	bne	80$			; /BBS/ no..
	mov	incfile	,skipfile	; /BBS/ pass desired incomplete file
	br	80$			; /BBS/ disposition to file closer

70$:	spack	#msg$ack,paknum		; ACK it
80$:	clr	numtry			; numtry := 0
	incm64	paknum			; increment packet number mod 64
	movb	#sta.dat,r1		; switch to data state
	return

60$:	spack	#msg$err,paknum		; break the sender out please
	clr	cccnt			; /36/ clear ^C flag
100$:	mov	#sta.abo,r1		; abort for some reason
	return


rdat.f:					; "F", got a file header
rdat.x:					; "X", also handle extended reply
	inc	numtry			; see if retry limit expired
	cmp	numtry	,maxtry		; if so, return abort
	blos	10$			; no
	 jmp	r$retry			; /62/ yes, log/send the reason

10$:	mov	paknum	,r1		; does this packet=(paknum+63) mod 64?
	dec	r1			; /62/ if this packet was the one sent
	bge	11$			; /62/ the last time, we must reACK
	mov	#63	,r1		; /62/ that packet and remain
11$:	cmp	r3	,r1		; /62/ in the current state
	bne	20$			; not the last packet
	 jmp	deja$vu			; /62/ reACK, warn dupe pack occurred

20$:	 jmp	r$sync			; /62/ log/send the reason for abort


rdat.z:	cmp	paknum	,r3		; end_of_file
	beq	10$			; if not correct packet return abort
	 jmp	r$sync			; /62/ log/send the reason for abort

10$:	mov	#lun.ou	,r2		; assume that we close a disk file
	tst	outopn			; real output or to the terminal
	beq	18$			; /BBS/ must be the terminal
	bgt	30$			; open was aborted via fileprotection

	cmpb	#eof$dis,packet		; /BBS/ real file, other side discard?
	bne	20$			; /BBS/ no
	mov	incfile	,skipfile	; /BBS/ ya, keep or dump it as is SET
	br	20$

18$:	clr	r2			; it's the console terminal
20$:	calls	close	,<r2>		; do the close now
30$:	call	clratr			; attributes no longer valid
	clr	outopn			; flag it
	spack	#msg$ack,r3		; ACK the EOF packet
	clr	numtry			; /48/ then re-init retry counter
	incm64	paknum			; paknum := (paknum+1) mod 64
	movb	#sta.fil,r1		; back to receive file state
	clr	xgottn			; don't have an X packet anymore
	return


	.sbttl	Dump a buffer out to disk	; /62/ moved this here..

;	B U F E M P
;
;	input:	  (r5)	= buffer address
;		 2(r5)	= length
;	output:	   r0	= if <>, error code

bufemp:	mov	@r5	,r2		; input record address
	mov	2(r5)	,r3		; string length
	clr	r0			; ensure no error for a null packet

10$:	tst	r3			; anything left in the record?
	ble	100$			; no
	clr	r0			; get the next character
	bisb	(r2)+	,r0		; into a convenient place
	dec	r3			; chcount--

	mov	#1	,r4		; repeat_count = 1
	tst	dorpt			; are we doing repeat count stuff?
	beq	30$			; no
	cmpb	r0	,rptquo		; yes, is it the agreed upon prefix?
	bne	30$			; no
	dec	r3			; chcount--
	clr	r4			; yes, get the next character then
	bisb	(r2)+	,r4		; and decode it into a number
	bic	#^c177	,r4		; ensure no parity bits are hanging
	unchar	r4	,r4		; simple to do
	clr	r0			; now prime with the next character
	bisb	(r2)+	,r0		; so we can check for other types of
	dec	r3			; quoting to be done
	tst	r4			; ensure the count is legitimate
	bgt	30$			; it's ok
	mov	#1	,r4		; it's fubar, fix it

30$:	clr	set8bit			; assume we don't have to set bit 7
	tst	do8bit			; must we do 8-bit unprefixing?
	beq	60$			; no
	cmpb	r0	,ebquot		; yes, is this the 8-bit prefix?
	bne	60$			; no
	mov	sp	,set8bit	; yes, send a flag to set the bit
	clr	r0			; and get the next character
	bisb	(r2)+	,r0		; without sign extension
	dec	r3			; one less character left in buffer

60$:	cmpb	r0	,conpar+p.qctl	; is this a quoted character?
	bne	70$			; no
	clr	r0			; yes, get the next character
	bisb	(r2)+	,r0		; must be one you know
	dec	r3			; chcount := pred(chcount)
	clr	r1			; must avoid sign extension here
	bisb	r0	,r1		; check low 7 bits against quote
	bic	#^c177	,r1		; drop bits 7..15
	cmpb	r1	,conpar+p.qctl	; if ch <> myquote
	beq	70$			;  then
	cmpb	r1	,#77		;   if   (ch & 177) >= ctl(del)
	blo	70$			;    and (ch & 177) <= ctl(del)+40
	cmpb	r1	,#137		;	then
	bhi	70$			;	  ch = ctl(ch)
	ctl	r0	,r0

70$:	tst	set8bit			; do we need to set the high bit?
	beq	74$			; no
	bisb	#200	,r0		; yes, set the bit on please
74$:	mov	r0	,-(sp)		; save copy of char to output
75$:	mov	#lun.ou	,r1		; channel_number := lun.out
	tst	outopn			; is there really something open?
	bne	80$			; yes, put the data to it
	clr	r1			; no, direct the output to a terminal
	tst	tsxsav			; running under TSX?
	beq	80$			; no
	cmpb	@sp	,m.tsxr		; ya, is it TSX lead-in char?
	beq	88$			; ya, don't output to TT
80$:	mov	@sp	,r0		; restore the character to write out
	call	putcr0			; and do it
	tst	r0			; /62/ did it work?
	bne	100$			; /62/ nope..
88$:	add	#1	,filein+2	; stats /62/ r0 is clear in case end..
	adc	filein+0		; 32. bits worth
	sob	r4	,75$		; duplicate the character if need be
	tst	(sp)+			; pop the stack where we saved char
	br	10$			; next character please

100$:	return

	.end