COMMENT ⊗   VALID 00013 PAGES
C REC  PAGE   DESCRIPTION
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 listen OLOOP oloop1 oldpup LISBAD enddat try0 try oset OLOOP done done1 timout rcvbad eftpgb eftgb1 eftgb2 eftgb3 eftgb4 eftgb5
C00037 00011	A=1
C00041 00012	REPWAT osend 
C00043 00013	send octin octin1 inerr octdon fread iascii finlp finlp1 goon finfin sndout noffin finset finlp finlp1 fineof eftppb sndbad eftpb2
C00051 ENDMK
C⊗;
	TITLE EFTP

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


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

REPEAT 0,<
pupmsg:	0				;byte(8)dest,source(16)1000
	0				;BYTE(16)PUPLENGTH(8)TCTL,PUPTYPE
	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.

>;REPEAT 0

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.

pdlen==30
pdlist:	block 	pdlen

iniblk:	13		;block for OPENs on PUP:, EFTP buffered mode
	SIXBIT/PUP/
	xwd eohdr,eihdr

eihdr:	block 3
eohdr:	block 3

ercvmb:	1		;Opcode: Listen
	0		;Status
	efsock		;Local socket (our socket)
	0		;Don't wait for connection?
	8		;Byte size irrelevant for PUP
	0		;Don't care what socket
	0		;or foreign host number

esndmb:	0		;Opcode: Connect
	0		;Status
lsock:	0		;Local socket (let system invent one)
	0		;Don't wait for connection?
	8		;Byte size irrelevant for PUP
fsock:	efsock		;Their socket number = EFTP
host:	0		;Foreign host number to connect to.

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"
	ret
	caig 	4,"9"
	jrst 	isalpn
	cail 	4,"A"
	caile 	4,"Z"
	ret
	jrst 	isalpn

rjust:	movei 	2,6
rjloop:	trnn 	1,77
	sojg 	2,[
		lsh 1,-6
		jrst rjloop]
	ret
;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,","
	caia
	jrst 	errspc
	call 	getsix
	call 	rjust
	hrrm 	1,fblock+3
	CAIN 	4,15
 	JRST 	WINXIT		;Can omit right braket
	CAIE 	4,12
	cain 	4,"]"
	JRST 	WINXIT
	JRST 	ERRSPC

winxit:	aos 	(p)
errlf:	caie 	4,12
	cain 	4,175
	ret
	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? /]
	CLRBFI
	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:
A	ASCII Mode
I	IMAGE Mode
/]
	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.
/]
	CLRBFI
	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)?/]
	 skipa
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
	ret

;error dally dloop mtadr OCTOUT
;Misc routines

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

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

REPEAT 0,<

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


;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
	ret

;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
>;REPEAT 0
cpopj1:	aos 	(p)
cpopj:	ret

REPEAT 0,<

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
	ret

>;REPEAT 0
;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
	ret


;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,
	ret

;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
	ret

;FILIN input a byte from the file (diskch) to ac1
filin:	sosg 	fbuf+2
	 IN 	diskch,	;do input, skip if eof
	  skipa	
	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
	ret

REPEAT 0,<
;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
	ret

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
	 ret
	  call 	error

>;REPEAT 0
;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
/]
	exit

;receiv listen OLOOP oloop1 oldpup LISBAD enddat try0 try oset OLOOP done done1 timout rcvbad eftpgb eftgb1 eftgb2 eftgb3 eftgb4 eftgb5

receiv: outstr	[asciz/eceive
/]

; Start listening for PUPs to acknowledge.
	setzm 	lookfl		;say no specific link
	mtape	pupch,ercvmb	;specify listen on socket 3 from anywhere.
	hrrz	1,ercvmb+1		;Get status
	jumpn	1,[outstr [asciz/Someone is already using EFTP, try again later/]
		 jrst done]
	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...

REPEAT 0,<
listen:	IN 	pupch,pupmsg	;read it in
	 SKIPA
	  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
	CALL	FILOUT
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
	JFCL
	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.
	 SKIPA
	  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

>;REPEAT 0
	movei	1,=8
	skipn	tmode		;skip if image mode
	 jrst	oset		;jump if ascii mode
	movei	1,=32
oset:	dpb	1,[point 6,eihdr+1,11]
OLOOP:	call	eftpgb		;get a data byte
	  jrst	done		;  EOF
	call	filout		;send it to the output file.
	CAIN	1,15		;skip if not CR?
	 skipn	lfmode		;if zero, don't add LF
	  jrst 	oloop		;not a CR or not adding LF's
	MOVEI	1,12		;otherwise output the LF
	CALL	FILOUT
	jrst	oloop		;go until done.

done:	CLOSE 	diskch,
	outstr 	[asciz/
Data transfer completed./]
done1:	RELEASE	pupch,
	outstr 	[asciz/
/]
	CLRBFI
	jrst	start

timout:	outstr 	[asciz/
time out/]
rcvbad:	releas	diskch,3
	jrst	done1

eftpgb:	sosle	eihdr+2		;Any bytes left?
	  jrst	eftgb5		;  Yes, use them
	in	pupch,		;Get another buffer from Ether
	  jrst	eftgb2		;  No errors
	stato	pupch,20000	;EOF?
	  jrst	eftgb1		;  No, some other error
	stato	pupch,747600	;Any other random bits?
	  popj	p,		; 
eftgb1:	outstr	[asciz/Error reading from Ethernet.  Status = /]
	getsts	pupch,1
	call	octout
	jrst	rcvbad

eftgb2:	move	1,eihdr		;get buffer header
	add	1,1(1)		;Find last word in buffer
	move	1,1(1)		;Get that word
	andi	1,7		;look at low order bits (faster than LDB)
	jumpe	1,eftgb5	;Last word contains no strays
	trne	1,4
	  skipa 1,[4]		; 7 means 4-1 unused bytes
	trne	1,2		;3 means 3-1 unused bytes
	  subi	1,1
	movn	1,1
	skipn	tmode		;Binary?
	  jrst	eftgb4		;  No, don't worry
	push	p,1
	ldb	1,[point 6,eihdr+1,11]	;Check byte size
	cain	1,8		;Is this OK?
	  jrst	eftgb3		;  Yes, byte mode is correct.
	outstr	[asciz/We recieved a packet which didn't end on a word boundary.
/]
	skipe	bitsh		;Any hope?
	  jrst[	outstr[asciz/Cannot proceed in this mode./]
		jrst rcvbad ]
	outstr	[asciz/Continue writing as 8-bit binary instead? /]
	call	yesno
	  jrst	rcvbad
	movei	1,8
	dpb	1,eihdr+1
	dpb	1,fbuf+1
	movei	1,4
	imulm	1,eihdr+2
	imulm	1,fbuf+2
eftgb3:	pop	p,1		;Restore offset to byte count
eftgb4:	addm 	1,eihdr+2	;update count to account for fill bytes
eftgb5:	ildb	1,eihdr+1	;Get character
	aos	(p)		;and take a skip return
	popj	p,

A=1
B=2
C=3
D=4

repeat 0,<

;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?
	 JRST	ERRPUP
	CAIN	A,.PTEAB		;Abort?
	 JRST	ABTPUP
	OUTSTR 	[ASCIZ/?A pup of type /]
	LDB	A,PUPTYP
	CALL	OCTOUT
	OUTSTR 	[ASCIZ/ from /]
	CALL	PRTHST
	OUTSTR	[ASCIZ/ has been received, and will be discarded.
/]
	RET

ABTPUP:	SUBI	B,2
	PUSH	P,B			;the string length after the error word
	ILDB	A,C			;get the error byte
	ILDB	B,C
	LSH	A,8
	ADD	A,B
	POP	P,B
	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 /]
	CALL	OCTOUT
	OUTCHR	[" "]
	POP	P,B			;error string count
BADT1:	JUMPLE	B,BADT2
BADLP:	ILDB	A,C			;get a data byte
	OUTCHR	A
	SOJG	B,BADLP			;go until done.
BADT2:	OUTSTR	CRLF
	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 = /]
	CALL	OCTOUT
	OUTSTR	[ASCIZ/  /]
	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
ABTDTN==.-ABTDSP

RBUSY:	OUTSTR	[ASCIZ/Receiver is busy with another request.  I'll wait.
/]
	MOVEI	A,12
	SLEEP	A,
	JRST	CPOPJ1			;try again

MDELAY:	OUTSTR	[ASCIZ/Server has requested a delay. I'll wait...
/]
	MOVEI	A,50
	SLEEP	A,
	JRST	CPOPJ1

SUPXMT:	OUTSTR	[ASCIZ/Server requests a suspension.  I'll dally...
/]
	MOVEI	A,24
	SLEEP	A,
	JRST	CPOPJ1

>;repeat 0

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

REPEAT 0,<

osend:	OUT 	pupch,pupout
	 skipa
	  call 	error
	outchr 	["."]
repwat:	movei 	10,2	;wait 1 second
	call 	dally
	 jrst 	osend
	IN 	pupch,pupmsg	;read our pup
	SKIPA
	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 	["!"]
	ret

repwt1: call	badtyp		;non-fatal err maybe...maybenot.
	JRST	REPWAT		;wait again
	jrst	osend		;try it again.

>;REPEAT 0
;send octin octin1 inerr octdon fread iascii finlp finlp1 goon finfin sndout noffin finset finlp finlp1 fineof eftppb sndbad eftpb2
;Send a file to an alto

send:	outstr 	[asciz/end
/]
	call 	inopn		;open file for input
	outstr 	[asciz/Host number (octal):/]
	call	octin

send2:	cain 	1,15	;see if cr
	 jrst 	hstdon
	caie	1,"#"
	 jrst	badhst
	jumpe	2,send2		;Ignore leading #
	push	p,2		;Save network number
	call	octin
	exch	1,(p)		;Save terminator, get network number
	lsh	1,8		;Shift network number into position
	add	2,1		;add host number
	pop	p,1		;Get back terminator
	cain	1,15
	  jrst	hstdon
	caie	1,"#"		;Socket, perhaps
	  jrst	badhst
	push	 p,2		;Save net/host number
	call	octin
	cain	1,15
	  jrst[	move 1,2
		pop p,2
		jrst gotskt]
	pop	p,2
badhst:	outstr 	[asciz/That's not a number, try again:/]
	CLRBFI		;flush garbage
	jrst 	send

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"
	 popj 	p,	;not a digit
	subi 	1,"0"
	lsh 	2,3		;shift over prev. digits
	ior 	2,1	;add in new digit
	jrst 	octin1

hstdon:	movei 	1,efsock	;well known socket number
gotskt:	movem 	2,host	;foreign host number
	movem 	1,fsock
REPEAT 0,<
	movei 	pup,pupout	;use pup output block
	dpb 	2,pupdhn	;put in block
	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
>;REPEAT 0

	mtape	pupch,esndmb
	hrrz	1,esndmb+1		;Get status
	jumpe	1,finbeg
	outstr	[asciz/Failed to open connection; perhaps already in use? /]
	jrst	done1

finbeg:	movei	1,8
	skipn	tmode
	  jrst	finset
	movei	1,=32
finset:	dpb	1,[point 6,eohdr+1,11]
	setzm	rchar	;clear prev. char
finlp:	call 	filin	;get a char
	 jrst 	fineof		;say we are done
	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:	call	eftppb
	jrst 	finlp

fineof:	close	pupch,	;no data bytes in last pup
	CLOSE	diskch,
	jrst	done

eftppb:	sosle	eohdr+2
	  jrst	eftpb2
	out	pupch,
	  jrst	eftpb2
	outstr	[asciz/Ethernet output error. Status = /]
	getsts	pupch,1
	call	octout
sndbad:	releas	pupch,3		;blast the connection
	jrst	done1

eftpb2:	idpb	1,eohdr+1
	popj	p,

end	start