home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
modcomp.zip
/
seof.
< prev
next >
Wrap
Text File
|
1987-01-26
|
7KB
|
210 lines
INTEGER FUNCTION SEOF (X)
C
C ****************************************************************
C
C KERMIT for the MODCOMP MAXIV operating system
C
C Compliments of:
C
C SETPOINT, Inc.
C 10245 Brecksville Rd.
C Brecksville, Ohio 44141
C
C
C KERMIT is a copyrighted protocol of Columbia Univ. The authors
C of this version hereby grant permission to copy this software
C provided that it is not used for an explicitly commercial
C purpose and that proper credit be given. SETPOINT, Inc. makes
C no warranty whatsoever regarding the accuracy of this package
C and will assume no liability resulting from it's use.
C
C ****************************************************************
C
C Abstract: Send an EOF packet to the other Kermit.
C
C MODIFICATION HISTORY
C
C BY DATE REASON PROGRAMS AFFECTED
C
C ****************************************************************
C
C Author: Rick Burke Version: A.0 Date: Sep-86
C
C Calling Parameters:
C
C R X - Dummy argument required by FORTRAN
C
C ****************************************************************
C
C Messages generated by this module : None
C
C ****************************************************************
C
C Subroutines called directly : DGETLI, MOD, PACK, POSUSL,
C PUTLIN, RPACK, SCOPY, SPACK
C
C ****************************************************************
C
C Files referenced : None
C
C ****************************************************************
C
C Local variable definitions :
C
C AONE - Index variable
C BONE - Index variable
C FOUND - Flag for existing file found
C LEN - Length of received packet
C NUM - Number of received packet
C STATUS - Status of received packet
C TEMP - Function code value from DGETLI
C TNUM - Packet number of transmitted packet
C TV1 - Temporary variable
C TV2 - Temporary variable
C TV3 - Temporary variable
C ALIN(132) - Line buffer with file name read from
C scratch partition
C FNAM(4) - Packed file name array
C
C ****************************************************************
C
C Commons referenced : KERCOM, KERPMC and UFTTBC local commons
C
C ****************************************************************
C
C (*$END.DOCUMENT*)
C
C ****************************************************************
C * *
C * D I M E N S I O N S T A T E M E N T S *
C * *
C ****************************************************************
C
IMPLICIT INTEGER (A-Z)
C
INTEGER*2 ALIN(132), FNAM(4)
C
C ****************************************************************
C * *
C * T Y P E S T A T E M E N T S *
C * *
C ****************************************************************
C
LOGICAL*2 FOUND
C
C ****************************************************************
C * *
C * C O M M O N S T A T E M E N T S *
C * *
C ****************************************************************
C
INCLUDE USL/KERCOM
INCLUDE USL/KERPMC
INCLUDE USL/UFTTBC
C
C ****************************************************************
C * *
C * E Q U I V A L E N C E S T A T E M E N T S *
C * *
C ****************************************************************
C
C
C ****************************************************************
C * *
C * D A T A S T A T E M E N T S *
C * *
C ****************************************************************
C
C
C ****************************************************************
C
C Code starts here :
C
C-----> Assume an error.
C
SEOF = BIGA
C
C-----> Check if maximum number of retries exceeded.
C
IF (NUMTRY .GT. MAXTRY) RETURN
NUMTRY = NUMTRY+1
C
C-----> Send the EOF packet.
C
AONE = 1
BONE = 1
TNUM = N
TV1 = BIGZ
TV2 = 0
TV3 = 0
CALL SPACK (TV1,TNUM,TV2,TV3)
STATUS = RPACK (LEN,NUM,RECPKT)
C
C-----> Branch if response was not a NAK.
C
IF (STATUS .NE. BIGN) GO TO 10
IF (N .NE. NUM-1) SEOF = STATE
RETURN
10 CONTINUE
C
C-----> Branch if response was not an ACK.
C
IF (STATUS .NE. BIGY) GO TO 80
IF (N .EQ. NUM) GO TO 20
SEOF = STATE
RETURN
20 CONTINUE
C
C-----> Reset the retry counter and bump the packet number.
C
NUMTRY = 0
N = MOD (N+1,64)
30 CONTINUE
C
C-----> Check whether there is another file to send.
C
SCRLUN = IUFT(2,9)
READ (SCRLUN,1000,END=35) FNAM
1000 FORMAT (4A2)
GO TO 40
35 CONTINUE
SEOF = BIGB
RETURN
40 CONTINUE
C
C-----> There is another file to send, make sure that it exists.
C
CALL POSUSL (IUFT(2,7),FNAM,FOUND)
IF (FOUND) GO TO 50
C
C------> Requested file not present.
C
IF (HOSTON .NE. NO) GO TO 30
WRITE (LOCALO,1010) FNAM
1010 FORMAT (' FILE NOT FOUND--> ',4A2)
GO TO 30
50 CONTINUE
C
C-----> We have another valid file to send.
C
DO 60 I=1,8
IWORD = FNAM((I+1)/2)
IF (MOD(I,2) .NE. 0) FILNAM(I) = ISHFT (IWORD,-8)
IF (MOD(I,2) .EQ. 0) FILNAM(I) = IAND (IWORD,4Z00FF)
IF (FILNAM(I) .EQ. 0 .OR.
> FILNAM(I) .EQ. BLANK ) GO TO 70
60 CONTINUE
I = 9
70 CONTINUE
FILNAM(I) = LF
FILNAM(I+1) = EOS
SEOF = BIGF
RETURN
80 CONTINUE
C
C-----> If there was a checksum error, try again.
C
IF (STATUS .EQ. BAD) SEOF = STATE
RETURN
END