!
!	Name:  XRECV
!
!	Function:  This is the receive module for the XMODEM protocol
!	support on the AlphaMicro.  XTRANS provides the transmit support.
!	First, the receiver sends a NAK sequence to tell the sender to 
!	begin transmission.  Then the sender starts sending blocks.  Each
!	block consists of 1) SOH; 2) block number; 3) complemented block
!	number; 4) 128 data bytes; and 5) a one-byte checksum.  The
!	receiver responds with an ACK or a NAK depending on whether or
!	not the block was successfully received.  If not, it is resent.
!	If so, the next block is sent.  When the entire file has been
!	sent, the sender sends an EOT to which the receiver responds with
!	an ACK.  This program may be interrupted by hitting CTL-C three
!	times in a row.
!
!	Author:  Tom Dahlquist
!
!	Edit History:
!	  When   Who What
!	01/17/85 TAD Written (from MRECV).
!	01/24/85 TAD Allow either three DEL's or CTL-C's to kill it.
!	05/09/85 TAD Use CMPCRC to compute CRC.
!
!	The following is a map of one block as transmitted by XMODEM.
!	First is an SOH, then the block number, then the
!	inverted block number, then 128 data bytes, then the checksum.
!
	MAP1 IO'BLOCK
		MAP2 RCV'BLOCK'COUNT,B,1
		MAP2 NOT'BLOCK'COUNT,B,1
		MAP2 IO'REC,X,128
		MAP2 RCV'CHECK'SUM,B,1

	MAP1 IN'CHR,X,1
	MAP1 TEST'CHR,X,1
	MAP1 OPTION,F
	MAP1 LENGTH,F
	MAP1 OUT'CHR,X,1
	MAP1 DISK'FSPEC,S,25
	MAP1 IN'UNIT,F,,0
	MAP1 OUT'UNIT,F,,0
	MAP1 DISK'UNIT,F,,3
	MAP1 ERROR'UNIT,F,,4
!	MAP1 COM'FSPEC,S,24
	MAP1 SOH,X,1,CHR$(1)
	MAP1 CTRLC,X,1,CHR$(3)
	MAP1 DEL,X,1,CHR$(255)
	MAP1 EOT,X,1,CHR$(4)
	MAP1 ACK,X,1,CHR$(6)
	MAP1 NAK,X,1,CHR$(21)
	MAP1 ESCAPE,X,1,CHR$(27)
	MAP1 CHECK'SUM,B,1
	MAP1 BLOCK'LENGTH,F,,128
	MAP1 BLOCK'COUNT,F,,1		! must be B,1 to wrap around correctly
	MAP1 TEMP'COUNT,B,1
	MAP1 NAK'COUNT,F
	MAP1 I,F
	MAP1 J,F
	MAP1 TEN'SECS,F,,10
	MAP1 EOT'FOUND,F
	MAP1 DATA'ERROR,F
	MAP1 PREV'BLOCK,F
	MAP1 DEBUG,F
	MAP1 TRUE,F,,-1
	MAP1 FALSE,F,,0
	MAP1 TIMER,F
	MAP1 MODE,B,2,1
	MAP1 LOCK1,B,2,59999
	MAP1 LOCK2,B,2,0
	MAP1 DIR'FILE,S,25,"SYSOP.NEW"
	MAP1 LINES(6),S,80
	MAP1 INITIALS,S,4
!
!	Get the filename.  Try to ensure that it is a valid AMOS filename
!	and that nothing by that name already exists.
!
GET'FILENAME:
	INPUT LINE "Filename to save as (six letters or less):  ",DISK'FSPEC
	DISK'FSPEC=UCS(DISK'FSPEC)
	IF DISK'FSPEC[-2,-1]="/D" THEN &
		DISK'FSPEC=DISK'FSPEC[1,-3] : &
		OPEN #99,"XRECV.LST",OUTPUT : &
		?#99,"XRECV ERROR LISTING" : &
		DEBUG=TRUE
	I=INSTR(1,DISK'FSPEC,".")
	J=LEN(DISK'FSPEC)
	IF I=0 GOTO NO'PERIOD
	IF I>7 GOTO TOO'LONG
	IF J-I>3 GOTO BAD'EXT
	GOTO CHECK'FILENAME
NO'PERIOD:
	IF J>6 GOTO TOO'LONG
	DISK'FSPEC=DISK'FSPEC+".DAT"
CHECK'FILENAME:
	LOOKUP DISK'FSPEC,I
	IF I=0 GOTO FILENAME'OK
	?"Sorry, that filename already exists!"
	GOTO GET'FILENAME
TOO'LONG:
	?"Didn't I say six letters or less?"
	GOTO GET'FILENAME
BAD'EXT:
	?"Sorry, filename extension can only be three letters in length!"
	GOTO GET'FILENAME
FILENAME'OK:
	?"Saving file as ";DISK'FSPEC;"..."
!
!	Get the two lines of description.  Try to make sure that he at
!	least enters something.
!
	?"Please enter up to six lines of description:"
	FOR I=1 TO 6
	GET'LINE:
		INPUT LINE ">",LINES(I)
		IF LINES(I)="" THEN &
			IF I=1 THEN &
				?"Come on, you must know SOMETHING about this file!" : &
				GOTO GET'LINE &
			ELSE &
				I=6
	NEXT	
!
!	Now, add our four lines of data to the description file.  Use
!	XLOCK to make sure no one else is writing to it.
!
	?"One moment please...writing description to directory."
	XCALL XLOCK,MODE,LOCK1,LOCK2
	LOOKUP DIR'FILE,I
	IF I=0 THEN &
		OPEN #98,DIR'FILE,OUTPUT &
	ELSE &
		OPEN #98,DIR'FILE,APPEND
	?#98,DISK'FSPEC
 	XCALL XMEM,17,INITIALS
	?#98,INITIALS
	FOR I=1 TO 6
		IF LINES(I)#"" THEN &
			?#98,LINES(I) &
		ELSE &
			I=6
	NEXT
	CLOSE #98
	MODE=2
	XCALL XLOCK,MODE,LOCK1,LOCK2
!
!	OK, let's go.  Put us into data mode, flush the input buffer,
!	wait for 10 seconds, and send a NAK.
!
	?"OK, please go to the FILE menu and use SEND to begin the transmission."
	XCALL IMG
	OPEN #DISK'UNIT, DISK'FSPEC, OUTPUT
!	INPUT LINE "Communications trmdef?",COM'FSPEC
!	COM'FSPEC = ""
!	OPEN #IN'UNIT, "TRM:"+COM'FSPEC, INPUT
!	OPEN #OUT'UNIT, "TRM:"+COM'FSPEC, OUTPUT

	OPTION=0
FLUSH'BUFFER:
	CALL GET'ONE
	IF LENGTH#0 GOTO FLUSH'BUFFER

	TIMER=TIME+10
TIME'LOOP:
	IF TIME<TIMER GOTO TIME'LOOP
!
!	Start with the receiver (us) sending a NAK, and
!	end with the sender sending an EOT which we acknowledge with
!	an ACK.
!
	BLOCK'COUNT=1
	CALL NAK'IT
SEG'LOOP:
	CALL GET'BLOCK
	IF DATA'ERROR THEN &
		CALL NAK'IT : &
		GOTO SEG'LOOP
	IF EOT'FOUND THEN &
		OUT'CHR=ACK : &
		CALL SEND'ONE : &
       		END
	OPTION=10
	CALL GET'ONE
	IF LENGTH=0 GOTO TIMEOUT2
	GOTO SEG'LOOP
!
!	Receive one data block.  The sequence is SOH, block #, inverted
!	block #, 128 data bytes, and one byte checksum.  If any of these
!	isn't what it should be, we set a data error flag.  We should also
!	timeout if a couple of seconds passes between bytes, but we currently
!	don't.  If the first character we receive is a CTL-C, we abort.
!	If the first character is an EOT, we set a flag and return.
!	Note that due to the way NAK'IT works, the first character has
!	already been received and is in IN'CHR when this routine is
!	called.
!	I think that we should also be checking for one or two other 
!	control characters, but I don't know what they are.
!
GET'BLOCK:
	DATA'ERROR=FALSE
	EOT'FOUND=FALSE
	PREV'BLOCK=FALSE
	IF IN'CHR = CTRLC THEN &
		CALL CTRLC'ABORT : &
		RETURN
	IF IN'CHR = DEL THEN &
		CALL DEL'ABORT : &
		RETURN
	IF IN'CHR = EOT THEN &
		EOT'FOUND=TRUE : &
		RETURN
	IF IN'CHR <> SOH GOTO SET'ERROR
	XCALL TIMEIN,2,IO'BLOCK,LENGTH
	IF LENGTH#131 GOTO SET'ERROR
	TEMP'COUNT=BLOCK'COUNT		! take MOD 256...
	IF RCV'BLOCK'COUNT = TEMP'COUNT GOTO COUNT'OK
	TEMP'COUNT=BLOCK'COUNT-1
	IF RCV'BLOCK'COUNT # TEMP'COUNT GOTO SET'ERROR
	PREV'BLOCK=TRUE
COUNT'OK:
	IF 255-NOT'BLOCK'COUNT <> RCV'BLOCK'COUNT GOTO SET'ERROR
	IF DEBUG THEN &
		?#99,"GOT DATA BLOCK"
!	CHECK'SUM = 0
!	FOR I = 1 TO BLOCK'LENGTH
!	CHECK'SUM = CHECK'SUM+ASC(IO'REC[I;1])
!	NEXT
	XCALL CMPCRC,IO'REC,CHECK'SUM
	IF RCV'CHECK'SUM <> CHECK'SUM GOTO SET'ERROR
	IF NOT PREV'BLOCK THEN &
		PRINT #DISK'UNIT, IO'REC; : &
		BLOCK'COUNT = BLOCK'COUNT+1
	OUT'CHR=ACK
	CALL SEND'ONE
	RETURN

SET'ERROR:
	DATA'ERROR=TRUE
	RETURN
!
!	Send a NAK and wait for something to come.  If it doesn't come
!	within ten seconds, send another NAK.  Check the input buffer and 
!	wait for two seconds after receiving anything before sending the 
!	first NAK, to allow the input stream to clear.  If we send six
!	NAK's with no reply, die.
!
NAK'IT:
	XCALL TIMEIN,1,IN'CHR,LENGTH
	IF LENGTH#0 GOTO NAK'IT
	NAK'COUNT=0
NAK'LOOP:
	OUT'CHR=NAK
	CALL SEND'ONE
	NAK'COUNT=NAK'COUNT+1
	OPTION=10
	CALL GET'ONE
	IF LENGTH#0 RETURN
	IF NAK'COUNT=7 GOTO TIMEOUT2
	GOTO NAK'LOOP
!
!	Send one character.
!
GET'ONE:
	XCALL TIMEIN,OPTION,IN'CHR,LENGTH
	IF DEBUG AND LENGTH#0 THEN &
		?#99,ASC(IN'CHR)
	RETURN
!
!	Get one input character.

SEND'ONE:
	?#OUT'UNIT,OUT'CHR;
	IF DEBUG THEN &
		?#99,"-";ASC(OUT'CHR)
	RETURN
!
!	If CTL-C received, just die.
!
DEL'ABORT:
	TEST'CHR=DEL
	GOTO TEST'ABORT
CTRLC'ABORT:
	TEST'CHR=CTRLC
TEST'ABORT:
	DATA'ERROR=TRUE
	OPTION=2
	FOR I=1 TO 2
	CALL GET'ONE
	IF LENGTH=0 OR IN'CHR#TEST'CHR RETURN
	NEXT
	IF DEBUG THEN &
		?#99,"ENDING DUE TO OPERATOR"
	CALL KILL'FILE
	END
!
!	Miscellaneous timeouts.
!
TIMEOUT2:
	?"I'm sorry, but your computer has stopped sending me information."
	?"If your computer seems OK to you, please try again."
	?"If this happens repeatedly, please notify the SYSOP."
	CALL KILL'FILE
	END
!
!	Kill the output file.
!
KILL'FILE:
	CLOSE #DISK'UNIT
	KILL DISK'FSPEC
	RETURN