home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / modcomp / seof. < prev    next >
Text File  |  2020-01-01  |  7KB  |  210 lines
  1.       INTEGER FUNCTION SEOF (X)
  2. C
  3. C     ****************************************************************
  4. C
  5. C              KERMIT for the MODCOMP MAXIV operating system
  6. C
  7. C        Compliments of:
  8. C
  9. C                         SETPOINT, Inc.
  10. C                      10245 Brecksville Rd.
  11. C                      Brecksville, Ohio 44141
  12. C
  13. C
  14. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  15. C      of this version hereby grant permission to copy this software
  16. C      provided that it is not used for an explicitly commercial
  17. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  18. C      no warranty whatsoever regarding the accuracy of this package
  19. C      and will assume no liability resulting from it's use.
  20. C
  21. C     ****************************************************************
  22. C
  23. C     Abstract:  Send an EOF packet to the other Kermit.
  24. C
  25. C     MODIFICATION HISTORY
  26. C
  27. C     BY            DATE     REASON            PROGRAMS AFFECTED
  28. C
  29. C     ****************************************************************
  30. C
  31. C     Author:  Rick Burke           Version: A.0    Date: Sep-86
  32. C
  33. C     Calling Parameters:
  34. C
  35. C     R    X            - Dummy argument required by FORTRAN
  36. C
  37. C     ****************************************************************
  38. C
  39. C     Messages generated by this module :  None
  40. C
  41. C     ****************************************************************
  42. C
  43. C     Subroutines called directly :  DGETLI, MOD, PACK, POSUSL,
  44. C                                    PUTLIN, RPACK, SCOPY, SPACK
  45. C
  46. C     ****************************************************************
  47. C
  48. C     Files referenced :  None
  49. C
  50. C     ****************************************************************
  51. C
  52. C     Local variable definitions :
  53. C
  54. C     AONE         - Index variable
  55. C     BONE         - Index variable
  56. C     FOUND        - Flag for existing file found
  57. C     LEN          - Length of received packet
  58. C     NUM          - Number of received packet
  59. C     STATUS       - Status of received packet
  60. C     TEMP         - Function code value from DGETLI
  61. C     TNUM         - Packet number of transmitted packet
  62. C     TV1          - Temporary variable
  63. C     TV2          - Temporary variable
  64. C     TV3          - Temporary variable
  65. C     ALIN(132)    - Line buffer with file name read from
  66. C                    scratch partition
  67. C     FNAM(4)      - Packed file name array
  68. C
  69. C     ****************************************************************
  70. C
  71. C     Commons referenced :  KERCOM, KERPMC and UFTTBC local commons
  72. C
  73. C     ****************************************************************
  74. C
  75. C     (*$END.DOCUMENT*)
  76. C
  77. C     ****************************************************************
  78. C     *                                                              *
  79. C     *         D I M E N S I O N   S T A T E M E N T S              *
  80. C     *                                                              *
  81. C     ****************************************************************
  82. C
  83.       IMPLICIT INTEGER (A-Z)
  84. C
  85.       INTEGER*2 ALIN(132),     FNAM(4)
  86. C
  87. C     ****************************************************************
  88. C     *                                                              *
  89. C     *         T Y P E   S T A T E M E N T S                        *
  90. C     *                                                              *
  91. C     ****************************************************************
  92. C
  93.       LOGICAL*2   FOUND
  94. C
  95. C     ****************************************************************
  96. C     *                                                              *
  97. C     *         C O M M O N   S T A T E M E N T S                    *
  98. C     *                                                              *
  99. C     ****************************************************************
  100. C
  101.       INCLUDE USL/KERCOM
  102.       INCLUDE USL/KERPMC
  103.       INCLUDE USL/UFTTBC
  104. C
  105. C     ****************************************************************
  106. C     *                                                              *
  107. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  108. C     *                                                              *
  109. C     ****************************************************************
  110. C
  111. C
  112. C     ****************************************************************
  113. C     *                                                              *
  114. C     *         D A T A   S T A T E M E N T S                        *
  115. C     *                                                              *
  116. C     ****************************************************************
  117. C
  118. C
  119. C     ****************************************************************
  120. C
  121. C     Code starts here :
  122. C
  123. C----->  Assume an error.
  124. C
  125.       SEOF = BIGA
  126. C
  127. C----->  Check if maximum number of retries exceeded.
  128. C
  129.       IF (NUMTRY .GT. MAXTRY) RETURN
  130.       NUMTRY = NUMTRY+1
  131. C
  132. C----->  Send the EOF packet.
  133. C
  134.       AONE = 1
  135.       BONE = 1
  136.       TNUM = N
  137.       TV1 = BIGZ
  138.       TV2 = 0
  139.       TV3 = 0
  140.       CALL SPACK (TV1,TNUM,TV2,TV3)
  141.       STATUS = RPACK (LEN,NUM,RECPKT)
  142. C
  143. C----->  Branch if response was not a NAK.
  144. C
  145.       IF (STATUS .NE. BIGN) GO TO 10
  146.       IF (N .NE. NUM-1) SEOF = STATE
  147.       RETURN
  148.    10 CONTINUE
  149. C
  150. C----->  Branch if response was not an ACK.
  151. C
  152.       IF (STATUS .NE. BIGY) GO TO 80
  153.       IF (N .EQ. NUM) GO TO 20
  154.       SEOF = STATE
  155.       RETURN
  156.    20 CONTINUE
  157. C
  158. C----->  Reset the retry counter and bump the packet number.
  159. C
  160.       NUMTRY = 0
  161.       N = MOD (N+1,64)
  162.    30 CONTINUE
  163. C
  164. C----->  Check whether there is another file to send.
  165. C
  166.       SCRLUN = IUFT(2,9)
  167.       READ (SCRLUN,1000,END=35) FNAM
  168.  1000 FORMAT (4A2)
  169.       GO TO 40
  170.    35 CONTINUE
  171.       SEOF = BIGB
  172.       RETURN
  173.    40 CONTINUE
  174. C
  175. C----->  There is another file to send, make sure that it exists.
  176. C
  177.       CALL POSUSL (IUFT(2,7),FNAM,FOUND)
  178.       IF (FOUND) GO TO 50
  179. C
  180. C------>  Requested file not present.
  181. C
  182.       IF (HOSTON .NE. NO) GO TO 30
  183.       WRITE (LOCALO,1010) FNAM
  184.  1010 FORMAT (' FILE NOT FOUND--> ',4A2)
  185.       GO TO 30
  186.    50 CONTINUE
  187. C
  188. C----->  We have another valid file to send.
  189. C
  190.       DO 60 I=1,8
  191.       IWORD = FNAM((I+1)/2)
  192.       IF (MOD(I,2) .NE. 0) FILNAM(I) = ISHFT (IWORD,-8)
  193.       IF (MOD(I,2) .EQ. 0) FILNAM(I) = IAND (IWORD,4Z00FF)
  194.       IF (FILNAM(I) .EQ.     0 .OR.
  195.      >    FILNAM(I) .EQ. BLANK     ) GO TO 70
  196.    60 CONTINUE
  197.       I = 9
  198.    70 CONTINUE
  199.       FILNAM(I) = LF
  200.       FILNAM(I+1) = EOS
  201.       SEOF = BIGF
  202.       RETURN
  203.    80 CONTINUE
  204. C
  205. C----->  If there was a checksum error, try again.
  206. C
  207.       IF (STATUS .EQ. BAD) SEOF = STATE
  208.       RETURN
  209.       END
  210.