!
!       Name:  MRECV
!
!       Function:  This is the receive module for the MacTerminal protocol
!       support on the AlphaMicro.  MTRANS provides the transmit support.
!       This protocol is similar to and uses the same as XMODEM protocol.
!       First, the sender sends an escape sequence to tell the receiver to go
!       into receive mode.  Then it sends the file information block in standard
!       XMODEM format, then an EOT.  Then XMODEM protocol is used twice, all
!       the way from the beginning NAK from the receiver to the ending
!       EOT from the sender and ACK from receiver; the first time the data
!       fork is sent; then the resource fork.
!       This version also adds four lines to a temporary directory file.
!       The first line is the filename; the second is the initials of the
!       uploader; the third and fourth are two lines of description.
!
!       Author:  Tom Dahlquist
!
!       Edit History:
!         When   Who What
!       11/08/84 TAD Written (from XRECV).
!       01/16/84 TAD Two fixes to improve reliability.  1) Ignore EOT if
!                       block count isn't right; 2) ignore CTL-C unless
!                       he hits three of them in a row.
!       01/24/85 TAD Use DEL or CTL-C to kill it.
!       05/09/85 TAD Use CMPCRC to compute CRC.
!
!       The following is a map of one block as transmitted by XMODEM or
!       Macterminal.  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
!
!       This is the map of the file information block sent by MacTerminal.
!       The filler byte sent after the SOH, block #, inverted block # has
!       been kept as the first byte of the block for simplicity, since the
!       AlphaMicro doesn't really care about alignment.
!
       MAP1 FILE'INFO,@IO'REC
               MAP2 FILL1,X,1          ! first filler byte
               MAP2 FNAME,X,64         ! MacIntosh file name
               MAP2 FTYPE,S,4          ! file type
               MAP2 FCREATE,S,4        ! file creator
               MAP2 FFLAGS,B,2         ! file flags
               MAP2 FLOC,B,4           ! location in folder
               MAP2 FFOLDER,B,2        ! file folder
               MAP2 LOCKED,B,2         ! locked flags
               MAP2 DSIZE,X,4          ! size of data fork
               MAP2 RSIZE,X,4          ! size of resource fork
               MAP2 FLCRDAT,B,4        ! creation date
               MAP2 FLMDDAT,B,4        ! modification date
               MAP2 FILL2,X,29         ! filler

       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,24
       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$(127)
       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 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
       MAP1 NUM'BLOCKS,F
       MAP1 TEMP1,X,4
       MAP1 TEMP1X(4),X,1,@TEMP1
       MAP1 TEMP2,X,4
       MAP1 TEMP2X(4),X,1,@TEMP2
       MAP1 TEMP'SIZE,B,4,@TEMP2
       MAP1 SIZED,F
       MAP1 SIZER,F
       MAP1 SIZE,F
!
!       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
       IF UCS(DISK'FSPEC[-2,-1])="/D" THEN &
               DISK'FSPEC=DISK'FSPEC[1,-3] : &
               OPEN #99,"MRECV.LST",OUTPUT : &
               ?#99,"MRECV ERROR LISTING" : &
               DEBUG=TRUE
       DISK'FSPEC=UCS(DISK'FSPEC)
       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+".MAC"
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 our input buffer,
!       and wait for the ESCape, "a" that the sender sends to begin the
!       transmission.  If we don't get the ESCape in 60 seconds, we
!       timeout.
!
       ?"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

       OPTION=60
       CALL GET'ONE
       IF LENGTH=0 GOTO TIMEOUT1
       IF IN'CHR=ESCAPE GOTO OK1
       IF DEBUG THEN &
               ?#99,"FIRST CHARACTER RECEIVED NOT ESCAPE"
       GOTO DIE
OK1:
       OPTION=10
       CALL GET'ONE
       IF LENGTH=0 GOTO TIMEOUT1
       IF IN'CHR="a" GOTO OK2
       IF DEBUG THEN &
               ?#99,"SECOND CHARACTER RECEIVED NOT a"
       GOTO DIE
OK2:
       OUT'CHR=ACK
       CALL SEND'ONE
       OPTION=10
       CALL GET'ONE
       IF LENGTH=0 GOTO TIMEOUT2
       CALL GET'BLOCK                  ! get header block...
       IF NOT EOT'FOUND GOTO OK3
       IF DEBUG THEN &
               ?#99,"EOT FOUND WHILE WAITING FOR FIB"
       GOTO DIE
OK3:
       IF NOT DATA'ERROR GOTO OK4
       IF DEBUG THEN &
               ?#99,"DATA ERROR ON FIRST BLOCK"
       GOTO DIE
OK4:
       OPTION=10
       CALL GET'ONE                    ! must be EOT...
       IF LENGTH=0 GOTO TIMEOUT2
       IF IN'CHR=EOT GOTO OK5          ! currently, no retransmission
                                       ! of file information block...
       IF DEBUG THEN &
               ?#99,"EOT NOT FOUND AFTER FIRST BLOCK"
       GOTO DIE
OK5:
       OUT'CHR=ACK
       CALL SEND'ONE

       TEMP1=DSIZE
       CALL MASSAGE
       SIZED=TEMP'SIZE
       TEMP1=RSIZE
       CALL MASSAGE
       SIZER=TEMP'SIZE
       SIZE=SIZED
       CALL SEGMENT
       SIZE=SIZER
       CALL SEGMENT
       END                             ! presumably successful completion.
!
!       Receive one fork of the file.  This amounts to a complete XMODEM
!       transmission, starting with the receiver (us) sending a NAK, and
!       ending with the sender sending an EOT which we acknowledge with
!       an ACK.  Note that a fork may be null, in which case all we
!       receive is the EOT.
!
SEGMENT:
       BLOCK'COUNT=1
       NUM'BLOCKS=INT(SIZE/128)
       IF NUM'BLOCKS*128#SIZE THEN NUM'BLOCKS=NUM'BLOCKS+1
       CALL NAK'IT
SEG'LOOP:
       CALL GET'BLOCK
       IF DATA'ERROR THEN &
               CALL NAK'IT : &
               GOTO SEG'LOOP
       IF NOT EOT'FOUND GOTO NOT'EOT
       IF BLOCK'COUNT#NUM'BLOCKS+1 THEN &
               CALL NAK'IT : &
               GOTO SEG'LOOP
       OUT'CHR=ACK
       CALL SEND'ONE
       RETURN
NOT'EOT:
       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 = DEL THEN &
               CALL DEL'ABORT : &
               RETURN
       IF IN'CHR=CTRLC THEN &
               CALL CTRLC'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
!
!       Since first block can't be retransmitted, just die if any error.
!
DIE:
       OUT'CHR=NAK
       CALL SEND'ONE
       CALL KILL'FILE
       END
!
!       If DEL or 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
!
!       Didn't receive the starting sequence.
!
TIMEOUT1:
       ?"Sorry, I haven't received what I'm expecting from your Macintosh."
       ?"Are you sure you have XModem and MacTerminal selected in the"
       ?"FILE TRANSFER SETTINGS menu?"
       CALL KILL'FILE
       END
!
!       Miscellaneous timeouts.
!
TIMEOUT2:
       ?"I'm sorry, but your Macintosh has stopped sending me information."
       ?"If your Mac 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
!
!       Make Mac length fields understandable to AM.
!
MASSAGE:
       FOR I=1 TO 4
       TEMP2X(5-I)=TEMP1X(I)
       NEXT
       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.