perm filename EFTP.OLD[S,NET] blob sn#558596 filedate 1981-01-26 generic text, type C, neo UTF8
C00001 00001
C00003 00002		TITLE EFTP
C00010 00003	getsix tloop isalpn lcheck rjust rjloop
C00011 00004	rdfile rdppm errspc winxit errlf
C00013 00005	yesno gtmode imode amode iamode GTMOD1
C00016 00006	error dally dloop mtadr OCTOUT
C00018 00007	prthst getchk getck1 chkchk cpopj1 cpopj badchk putchk
C00022 00008	dskblk filopn outopn inopn filin filout sendak
C00027 00009	start getcmd quit
C00029 00010	receiv: outstr	[asciz/eceive
C00034 00011	A=1
C00038 00012	REPWAT osend 
C00040 00013	send octin octin1 inerr octdon fread iascii finlp finlp1 goon finfin noffin
C00046 ENDMK

opdef	call 	[pushj 17,]
opdef	ret 	[popj 17,]

pup=12		; to contain address of pup for byte pointer and routines

efsock==20	;Well known socket for EFTP receive
enhadr==302	;Our host number
.pteda==30	;PUP type for EFTPData
.pteak==31	;EFTPAck
.pteen==32	;EFTPEnd
.pterr==4	;PUP type for error
.pteab==33	;EFTPAbort

pupch==1			;channel for listener
diskch==2			;channel for writing out data.

pupmsg:	0				;byte(8)dest,source(16)1000
	0				;byte(16)pupident1,pupident2
	0				;byte(8)destnet,desthost(16)destsoc1
	0				;byte(16)destsock2(8)srcnet,srchost
	0				;byte(16)srcsock1,srcsock2
	block 	=134	;rest of pup

pupout:	0				;Ethernet header slot
	block 	1			;fill in len,type
	block 	1			;fill in ID here
	block 	1			;fill in dest net,host, sock1
	byte 	(16) 0 (8) 0,enhadr	;fill in destsock2,our net address
	block 	1			;fill in our socket number
	block 	=134			;rest of pup

;Pointers to pup fields for LDB and DPB into pup pointed to by ac PUP

PUPLEN:	POINT 	16,1(pup),15		; Pup length
PUPTRN:	POINT 	8,1(pup),23		; transport control
PUPTYP:	POINT 	8,1(pup),31		; Pup type
PUPID:	POINT 	32,2(pup),31		; Pup identifier

PUPDHN:	POINT 	16,3(pup),15		; destination network/host
PUPDNT:	POINT 	8,3(pup),7		; destination network
PUPDHS:	POINT 	8,3(pup),15		; destination host
PUPDS1:	POINT 	16,3(pup),31		; destination socket (first part)
PUPDS2:	POINT 	16,4(pup),15		; destination socket (second part)

PUPSHN:	POINT 	16,4(pup),31		; source network/host
PUPSNT:	POINT 	8,4(pup),23		; source network
PUPSHS:	POINT 	8,4(pup),31		; source host
PUPSSK:	POINT 	32,5(pup),31		; source socket

PUPDAT: POINT 	8,6(pup)		;pointer to 8-bit bytes in data.
pupbdt:	point	32,6(pup)		;pointer to 32-bit bytes.

pupbl:			;LOOKUP block for pup channel
lsock:	block 	1	;our socket
fsock:	0		;fill in foreign socket
host:	0		;fill in foreign host

tmode:	0		;transfer mode for disk output. default = 0 = ASCII.
idone:	0		;flag to indicate last data pup being sent

fbuf:	block 	3
fblock: block 	4	;block for file name.

pdlist:	block 	pdlen

iniblk:	17		;block for OPENs on PUP:, dump mode
	0		;no buffers

crlf:	byte 	(7) 15,12

previd:	block 	1	;remember ID to check sequencing
lookfl:	block	1	;If zero, we are listening link and need specific lookup
lfmode: block	1	;if non-zero, add LF after CR.
rchar:	block	1	;prev. char on output, used to detect CRLF's
bitsh:	block	1	;NZ if using Lefthand 32 bits in word
;getsix tloop isalpn lcheck rjust rjloop

getsix:	setz 	1,
	movei 	2,6
	move 	3,[point 6,1]
tloop:	inchwl 	4
	cail 	4,"a"
	caile 	4,"z"
	jrst 	lcheck
	subi 	4,"a"-"A"
isalpn:	subi 	4,"A"-'A'
	sojl 	2,tloop
	idpb 	4,3
	jrst 	tloop

lcheck:	caige 	4,"0"
	caig 	4,"9"
	jrst 	isalpn
	cail 	4,"A"
	caile 	4,"Z"
	jrst 	isalpn

rjust:	movei 	2,6
rjloop:	trnn 	1,77
	sojg 	2,[
		lsh 1,-6
		jrst rjloop]
;rdfile rdppm errspc winxit errlf

; Procedure to read file names

rdfile:	setzm 	fblock
	setzm 	fblock+1
	setzm 	fblock+2
	setzm 	fblock+3
	call 	getsix
	movem 	1,fblock
	cain 	4,15
	jrst 	winxit
	caie 	4,175
	cain 	4,12
	jrst 	winxit
	caie 	4,"."
	jrst 	rdppm
	call 	getsix
	movem 	1,fblock+1
	cain 	4,15
	jrst 	winxit
	caie 	4,175
	cain 	4,12
	jrst 	winxit
rdppm:	caie 	4,"["
	jrst 	[
errspc:		outstr [asciz /Illegal File specification
		jrst errlf]
	call 	getsix
	call 	rjust
	hrlzm 	1,fblock+3
	caie 	4,"."
	cain 	4,","
	jrst 	errspc
	call 	getsix
	call 	rjust
	hrrm 	1,fblock+3
	CAIN 	4,15
 	JRST 	WINXIT		;Can omit right braket
	CAIE 	4,12
	cain 	4,"]"

winxit:	aos 	(p)
errlf:	caie 	4,12
	cain 	4,175
	inchwl 	4
	jrst 	errlf

;yesno gtmode imode amode iamode GTMOD1

;YESNO - wait for yes or no answer, ret +2 for yes, +1 for no
;Clobbers ac4
yesno:	inchrw	4
	caie 	4,"y"
	cain	4,"Y"
	 jrst 	cpopj1
	caie	4,"n"
	cain	4,"N"
	 jrst 	cpopj
	outstr 	[asciz/
Y or N? /]
	jrst 	yesno

gtmode:	setzm	lfmode		;don't convert CRLF's (in case he says image)
	setzm	bitsh		;don't shift bits (in case he says ascii)
	outstr	[asciz/Mode: /]
	inchrw 	4
	caie 	4,"i"		;see if it is an "i".
	cain 	4,"I"
	jrst 	imode		;we want image mode.
	caie 	4,"a"
	cain 	4,"A"
	jrst	amode
	OUTSTR 	[ASCIZ/Legal modes are:
	jrst 	gtmode

imode:	outstr 	[asciz /MAGE mode 
	movei 	1,10
	MOVSI	2,(<point =36,0>) ;point to 36 bit word)
rorl:	outstr	[asciz/Use Righthand or Lefthand 32 bits?/]
	inchrw	4
	caie 	4,"r"
	cain	4,"R"
	 jrst 	right
	caie	4,"l"
	cain	4,"L"
	 jrst 	left
	outstr 	[asciz/
L is probably right for anything from MAXC or some random file;
R is what you want for .DVI files.
	jrst 	rorl

left:	setom	bitsh			;if using left 32 bits, need to shift
	jrst	gtmod1		;now ready to go on.
right:	setzm	bitsh		;if usring right 32 bits, then don't shift
	jrst	gtmod1

amode:	outstr	[asciz/SCII mode
	movei 	1,0
	MOVSI	2,(<point 7,0>)	;ASCII mode: 7-bit bytes
	hrrz	3,dskblk+2	;get output buffer spec (0 if input file)
	jumpe	3,iamode	;jump if input file
	 outstr	[asciz/Convert CRLF to CR (normal to send to Altos)?/]
iamode:	 outstr [asciz/Convert CR to CRLF (normal when receiving from Altos)?/]
	setom	lfmode		;assume YES - add in LF after CR.
	call 	yesno		;skip if answer is yes
	 setzm	lfmode		;NO - don't convert
gtmod1:	outstr	crlf
	movem 	1,tmode
	MOVEM	2,fbuf+1		;store byte size in buffer header

;error dally dloop mtadr OCTOUT
;Misc routines

error:	outstr 	[asciz/Something's wrong!
	EXIT 	1,

dally:	acctim	6,	;get time and date
	hrrz	6,6	;time only
dloop:	setz 	5,	;sleep for 1/60 sec.
	SLEEP 	5,
	mtape	pupch,mtadr	;see if input waiting
	  jrst	cpopj1	;if pup received
	acctim	7,	;get new time
	hrrz	7,7
	sub	7,6	;subract old time
	camge	7,10	;see if greater than limit in ac 10
	jrst	dloop	;keep waiting
	ret		;report failure
mtadr:	4
mtstat:	block 	1	;status info returned here (not really)

; Routine to output numbers in octal
;accepts ( and clobbers ) number in ac1

OCTOUT:	IDIVI 	1,=8		; extract a digit
	PUSH 	P,2		; save it on the stack
	SKIPE 	1		; extracted all digits?
	 CALL 	OCTOUT		; no - call recursively to get next digit
	POP 	P,1		; get digit from stack
	ADDI 	1,"0"		; convert to ASCII
	OUTCHR 	1		; output on the terminal
	RET			; go for next digit or return

;prthst getchk getck1 chkchk cpopj1 cpopj badchk putchk

;Print source net#host# from PUP
prthst:	ldb 	1,pupsnt	;source net
	call 	octout
	outchr 	["#"]
	ldb 	1,pupshs	;source host
	call 	octout
	outchr 	["#"]

;Generate checksum for PUP pointed to by ac PUP, return in ac1
;Checksum is generated by "ones-complement left add-and-cycle"
;Clobbers ac's 1-4
getchk:	ldb 	4,puplen	;get pup length to ac4
	addi 	4,1		;round up for possible garbage byte
	lsh 	4,-1		;divide by two for # 16bit words
	subi 	4,1		;don't look at checksum word
	move 	3,[point 16,1(pup)]	;first word for checksum
	setz 	1,			;use to accumulate checksum
getck1:	ildb 	2,3			;get a word
	add 	1,2			;add it into ac2
	trze 	1,1b19			;zero overflow bit, skip if it wasn't set
	 aoj 	1,		;add in overflow bit to simulate 1's-complement
	lsh 	1,1			;shift bits left
	trze 	1,1b19			;skip if overflow bit not set, zero it
	 aoj 	1,			;add it in on right
	sojg 	4,getck1		;go until we are done
	cain 	1,177777		;see if -0
	setz 	1,			;make into real 0

;CHKCHK checks a checksum from ac PUP, returns +1 on failure, +2 on success.
chkchk:	ldb 	1,puplen		;get length
	addi 	1,1
	lsh 	1,-1		;#16 bit words
	addi 	1,1		;If odd then checksum is in left of next word
	idivi 	1,2		;#32 bit words to ac1, ac2=0 if left, 1 if right
	add 	1,pup		;get word with checksum in it
	hrli 	1,(<point 16,0,15>)	;point to left half
	skipe 	2				;skip if checksum is in left half
	 hrli 	1,(<point 16,0,31>)	;otherwise point to right half
	ldb 	5,1				;GET CHECKSUM (finally)
	cain 	5,177777			;skip if no checksum
	 jrst 	cpopj1
	call 	getchk			;compute data checksum to ac1
	camn 	1,5			;skip if doesn't match
cpopj1:	aos 	(p)
cpopj:	ret

badchk:	outstr 	[asciz/Bad checksum, pup ignored
	jrst 	listen	;Ignore bad checksum

;PUTCHK computes checksum and enters it in pup in (PUP)
putchk:	push 	p,2		;save it
	push 	p,3
	call 	getchk		;get checksum to ac1
	idpb 	1,3		;put it in place
	pop 	p,3
	pop 	p,2			;restore it
;dskblk filopn outopn inopn filin filout sendak

dskblk:	10	;data mode 10
	sixbit /DSK/
	block 	1		;fill in dbuf or dbuf,,0

;GETNAM gets a good filename
filopn:	outstr 	[asciz/Local file name:/]
	call 	rdfile
	 jrst 	filopn
	OPEN 	diskch,dskblk
	 call 	error

;OUTOPN	opens a file for output, getting name from user
outopn:	movsi 	1,fbuf
	movem 	1,dskblk+2
	call 	filopn
	ENTER 	diskch,fblock
	jrst 	[outstr [asciz /ENTER failed.  Re-type file specs!
		jrst outopn]
	call 	gtmode		;set up mode correctly
	OUTBUF 	diskch,

;INOPN	opens a file for input, getting name from user
inopn:	movei 	1,fbuf
	movem 	1,dskblk+2
	call 	filopn
	LOOKUP 	diskch,fblock
	jrst 	[outstr [asciz/LOOKUP failed. re-type file specs!
		jrst inopn]
	INBUF 	diskch,1
	call 	gtmode		;set up mode correctly

;FILIN input a byte from the file (diskch) to ac1
filin:	sosg 	fbuf+2
	 IN 	diskch,	;do input, skip if eof
	jrst 	cpopj	;+1 (error) return
	ildb 	1,fbuf+1
	skipe	bitsh	;skip if don't need to shift bits (reading left half or ascii mode)
	 lsh	1,-4	;shift 4 bits right from left 32 bits of 36
	jrst	cpopj1	;+2 success return

;FILOUT output a byte from ac1 to the file (DISKCH)
filout:	sosg 	fbuf+2	;decrement byte count
	 OUTPUT diskch,	;if no bytes, output buffer
	skipe	bitsh	;skip if don't need to shift bits (writing left half or ascii mode)
	 lsh	1,4	;shift bits to left side
	idpb 	1,fbuf+1	;put byte in buffer

;get ready to acknowledge pups.
rlink:	setom lookfl		;don't come here again
	movei PUP,pupmsg
	ldb 	1,pupshn		;get source host/net to ac1
	movem 	1,host			;put it in lookup block
	ldb 	2,pupssk		;get foreign socket to ac2
	movem 	2,fsock			;put it in to lookup block
	movei 	4,efsock		;Well known socket number to ac4
	movem 	4,lsock			;is our local socket.
	LOOKUP 	pupch,pupbl		;establish link
	 call 	error
	movei	PUP,pupout
	dpb	4,pupssk		;source socket in new pup
 	dpb 	1,pupdhn		;old source is new dest.
	idivi 	2,1b19			;source socket word 1 in ac2, word 2 in ac3
	dpb 	2,pupds1		;old source socket
	dpb 	3,pupds2		;in two pieces into dest. socket.
	setz 	1,
	dpb 	1,puptrn		; zero transport control
	movei PUP,pupmsg

sendak:	ldb 	3,pupid		;get ID number
	movei 	PUP,pupout	;REdefine current pup to be output one.
	dpb 	3,pupid		;put ID in new pup
	movei 	1,.pteak		;I'm an acknowledgement.
	dpb 	1,puptyp
	movei 	1,=22		;length for ACK
	dpb 	1,puplen		;put it in
	call 	putchk
	OUT 	pupch,pupout	;send it out
	  call 	error

;start getcmd quit

start:	reset
	move 	p,[iowd pdlen,pdlist]
	OPEN 	pupch,iniblk
	 call 	error

getcmd:	outchr 	["*"]		;parse command from user
	inchrw	4
	caie	4,"s"
	cain	4,"S"
	jrst 	send
	caie	4,"r"
	cain	4,"R"
	jrst	receiv
	caie	4,"q"
	cain	4,"Q"
	jrst	quit		;If not valid then give help message
	outstr	[asciz/
S -- Send from SAIL to the Ether or VAX.
R -- Receive a file from the Ether or VAX.
Q -- Quit
	jrst	getcmd		;and try again

quit:	outstr	[asciz/uit

receiv: outstr	[asciz/eceive

; Start listening for PUPs to acknowledge.
	setzm 	lookfl		;say no specific link
	LOOKUP 	pupch,[efsock	;local socket for eftp server
		-1		;any foreign host
		-1]		;foreign socket ignored
	 jrst 	[outstr [asciz/Someone is already using EFTP, try again later/]
	setom 	previd		;No ID's yet, so previous is -1

	call 	outopn		;open output file
	OUTSTR 	[asciz/ Now go to your alto and type >EFTP <yourfilename> to SAIL <CR>

;Now we should have everything set up to listen...

listen:	IN 	pupch,pupmsg	;read it in
	  call 	error
	movei 	PUP, pupmsg	;define current PUP for byte pointer, subrs
	call 	chkchk		;check checksum
	 jrst 	badchk
	outchr 	["."]
	skipn 	lookfl		;skip unless this is first rec'd pup
	 call 	rlink
	ldb 	1,puptyp		;get pup type
	cain 	1,.pteen		;if an end
	 jrst 	enddat			;go to enddat
	caie 	1,.pteda		;otherwise must be EFTPDATA
	 jrst	LISBAD			;Pup other than data or end data
	ldb 	1,pupid
	camg 	1,previd		;Skip unless this is a duplicate pup
	 jrst 	oldpup		;If this is not next seq. number, ignore it.
	movem 	1,previd		;remember previous ID
	ldb 	2,puplen		;get length
	subi 	2, =22		;get data length.
	MOVE	3,PUPDAT	;Data byte pointer for ASCII mode
	skipn	tmode		;skip if image mode
	 jrst	oloop		;jump if ascii mode
	idivi	2,4		;get # of 32 bit words
	move	3,pupbdt	;binary (32-bit) data pointer
OLOOP:	ILDB	1,3		;get a data byte
	call	filout		;send it to the output file.
	CAIN	1,15		;skip if not CR?
	 skipn	lfmode		;if zero, don't add LF
	  jrst 	oloop1		;not a CR or not adding LF's
	MOVEI	1,12		;otherwise output the LF
oloop1:	SOJG	2,OLOOP		;go until done.

oldpup:	call 	sendak		;send an acknowledgement.
	jrst 	listen

;here when a pup other than data or end of data pup is seen.
LISBAD:	CALL	BADTYP		;process peculiar pups
	JRST	LISTEN		;mustn't have been fatal error

enddat: outchr 	["!"]
	CLOSE 	diskch,
	movei	PUP,pupmsg	;pup is INPUT
	ldb	1,pupid
	movem	1,previd
try0:	call 	sendak		;send out end reply.
try:	movei 	10,=10		;wait 10 seconds
	call 	dally
	 jrst	done		;2nd end got lost, not to worry.
	IN 	pupch,pupmsg	;read in end-reply-reply, or another end.
	  call 	error
	movei 	PUP, pupmsg	;define current PUP for byte pointer, subrs
	ldb 	1,puptyp		;get pup type
	caie 	1,.pteen		;is it EFTPEND?
	 jrst	try			;if not, ignore it.
	ldb	1,pupid
	camg	1,previd		;done if this is greater ID = 2nd end
	 jrst	try0			;old end: acknowledge it and go back to waiting

done:	outstr 	[asciz/
Data transfer completed.
	UTPCLR	pupch,
	RELEASE	pupch,
	jrst	start

timout:	outstr 	[asciz/
time out/]
	jrst 	done


;returns +1 for ignore this pup
;returns +2 for retransmit something
;doesn't return in case of fatal error
BADTYP:	LDB	B,PUPLEN		;get length
	SUBI	B,=22			;get data length.
	MOVE	C,PUPDAT		;data byte pointer
	LDB	A,PUPTYP		;get the pup type again
	CAIN	A,.PTERR		;error Pup?
	CAIN	A,.PTEAB		;Abort?
	OUTSTR 	[ASCIZ/?A pup of type /]
	OUTSTR 	[ASCIZ/ from /]
	OUTSTR	[ASCIZ/ has been received, and will be discarded.

	PUSH	P,B			;the string length after the error word
	ILDB	A,C			;get the error byte
	LSH	A,8
	CAIGE	A,ABTDTN		;abort dispatch table length
	XCT	ABTDSP(A)		;Don't come back, except to die.
	PUSH	P,B			;the string length after the error word
	OUTSTR	[ASCIZ/Abort code /]
	OUTCHR	[" "]
	POP	P,B			;error string count
BADLP:	ILDB	A,C			;get a data byte
	SOJG	B,BADLP			;go until done.
	OUTSTR	[ASCIZ/Transmission terminated unsucessfully
	EXIT				;lose

;here for an ERROR PUP (Pup type = 4).  Read error code (data word =10 of packet)
ERRPUP:	LDB	A,[POINT 16,13(PUP),15]	;Get the error code.
	CAIE	A,1			;Skip if it's a checksum error
	CAIN	A,3			;Skip unless resource limit at destination
	JRST	CPOPJ1			;retransmit this pup...
	OUTSTR	[ASCIZ/Error pup, error code = /]
	ADDI	C,6			;skip 6 words of binary
	SUBI	B,=24			;account this in byte count
	JRST	BADT1			;go die

ABTDSP:	JFCL				;Abort code 0: unknown
	JFCL				;1: External Sender abort.  Unk.
	OUTSTR	[ASCIZ/File rejected.  Do not send it again.  /]
	JRST	RBUSY			;3: receiver busy abort.  try later
	OUTSTR	[ASCIZ/Out of sequence: try the whole transmission again. /]
	JFCL				;5: unknown
	OUTSTR	[ASCIZ/Not ready to receive.  Try much later.  /]
	JRST	MDELAY			;7: medium wait delay
	JRST	SUPXMT			;8: suspend transmission

RBUSY:	OUTSTR	[ASCIZ/Receiver is busy with another request.  I'll wait.
	JRST	CPOPJ1			;try again

MDELAY:	OUTSTR	[ASCIZ/Server has requested a delay. I'll wait...

SUPXMT:	OUTSTR	[ASCIZ/Server requests a suspension.  I'll dally...

;REPWAT osend 
;wait for an ack matching id in previd, sends pup again on failure

osend:	OUT 	pupch,pupout
	  call 	error
	outchr 	["."]
repwat:	movei 	10,2	;wait 1 second
	call 	dally
	 jrst 	osend
	IN 	pupch,pupmsg	;read our pup
	call	error
	movei 	PUP,pupmsg	;current pup is one just read
	ldb	1,puptyp
	caie 	1,.pteak	;is it acknowledgement
	 jrst	repwt1		;no.  must be an error or abort
	ldb 	1,pupid	;get the ID
	came 	1,previd
	 jrst 	repwat	;wrong ack, ignore it and go wait some more
	outchr 	["!"]

repwt1: call	badtyp		;non-fatal err maybe...maybenot.
	JRST	REPWAT		;wait again
	jrst	osend		;try it again.
;send octin octin1 inerr octdon fread iascii finlp finlp1 goon finfin noffin
;Send a file to an alto

send:	outstr 	[asciz/end
	call 	inopn		;open file for input
	outstr 	[asciz/Host number (octal):/]
octin:	setz 	2,		;prepare to accumulate digits
octin1:	inchrw 	1	;char to 1
	cail 	1,"0"	;error if less than "0"
	cail 	1,"8"	;or if not less than "8"
	 jrst 	inerr	;not a digit
	subi 	1,"0"
	lsh 	2,3		;shift over prev. digits
	ior 	2,1	;add in new digit
	jrst 	octin1

inerr:	cain 	1,15	;see if cr
	 jrst 	octdon
	outstr 	[asciz/That's not a number, try again:/]
	CLRBFI		;flush garbage
	jrst 	octin

octdon:	movem 	2,host	;foreign host number
	movei 	pup,pupout	;use pup output block
	dpb 	2,pupdhn	;put in block
	movei 	1,efsock	;well known socket number
	movem 	1,fsock
	dpb 	1,pupds2	;low order socket number
	setz 	1,
	dpb 	1,pupds1	;high order socket number = 0

	timer 	1,	;get real time in 1/60th sec
	pjob 	2,		;our job number
	lsh 	1,7		;move over time
	ior 	1,2		;OR in job number
	movem 	1,lsock	;our socket number
;This gives us a unique socket number to use for sending.
	dpb 	1,pupssk
	LOOKUP 	pupch,pupbl	;set up link our socket to 0#host#20
	 call 	error
	movei 	1,.pteda	;EFTPData type pup
	dpb 	1,puptyp
	setz 	1,
	dpb 	1,puptrn	;zero transport ctl
	setom 	1,previd	;previous id = -1 to say none

fread:	movei 	PUP,pupout	;use output pup
	MOVE	2,PUPDAT	;Data byte pointer for ASCII mode
	movei	5,=512		;max number of 8-bit bytes
	skipn	tmode
	 jrst	iascii		;jump if ascii mode
	movei	5,=128		;max number of 32-bit bytes
	move	2,pupbdt	;binary (32-bit) data pointer
iascii:	setz 	3,		;count bytes written
	setzm 	idone	;say not done yet
	setzm	rchar	;clear prev. char
finlp:	call 	filin	;get a char
	 jrst 	[aos idone	;say we are done
		jrst finfin]
	move	4,rchar	;get prev. char. to ac4
	movem	1,rchar	;save away this char.
	cain	1,12	;skip if not LF
	 skipn	lfmode	;lfmode not 0 - special LF processing
	  jrst  finlp1	;not LF or no special: go on.
; Come here outputting a LF, if following a CR we will ignore it.
	cain	4,15	;skip unless CR
	 jrst 	finlp	;this LF follows a CR and we are converting CRLF to LF, so ignore it.
finlp1:	idpb 	1,2     ;put char just read in the pup
	aoj 	3,		;keep byte count
goon:	came 	3,5	;skip if no space left in pup
	 jrst 	finlp
finfin:	jumpe	3,noffin	;no data bytes in last pup
	skipe	tmode		;if in IMAGE mode
	imuli	3,4		;change word count to byte count
	addi 	3,=22	;account overhead
	dpb 	3,puplen	;put in length
	aos 	1,previd	;increment ID for pup
	dpb 	1,pupid	;put it in pup
sndout:	call 	putchk	;put in checksum
			;Now pup is all ready to send
	call 	osend	;send out pup and wait for reply
	skipn 	idone	;skip if this pup was last
	 jrst  	fread	;no, so go send more data
noffin:	CLOSE	diskch,
	movei 	PUP,pupout
	movei 	1,.pteen
	dpb 	1,puptyp
	movei 	1,=22
	dpb 	1,puplen	;EFTPEnd, no data
	aos 	1,previd
	dpb 	1,pupid	;next ID number
	call 	putchk
	call 	osend	;send out end and wait for reply
	movei 	PUP,pupout
	aos 	1,previd
	dpb 	1,pupid	;2nd end has next id number, all else the same
	OUT 	pupch,pupout	;send it out
	 jrst 	done	;all finished
	call 	error

end	start