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