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

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.