home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / modcomp / sfile. < prev    next >
Text File  |  2020-01-01  |  6KB  |  199 lines
  1.       INTEGER FUNCTION SFILE (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 the file name to the other Kermit
  24. C
  25. C     MODIFICATION HISTORY
  26. C
  27. C
  28. C     BY            DATE     REASON            PROGRAMS AFFECTED
  29. C
  30. C     ****************************************************************
  31. C
  32. C     Author:  Rick Burke           Version: A.0    Date: Sep-86
  33. C
  34. C     Calling Parameters:
  35. C
  36. C     R    X            - Dummy argument required by FORTRAN
  37. C
  38. C     ****************************************************************
  39. C
  40. C     Messages generated by this module :  None
  41. C
  42. C     ****************************************************************
  43. C
  44. C     Subroutines called directly :  BUFILL, MOD, PUTLIN, RPACK,
  45. C                                    SCOPY, SPACK
  46. C
  47. C     ****************************************************************
  48. C
  49. C     Files referenced :  None
  50. C
  51. C     ****************************************************************
  52. C
  53. C     Local variable definitions :
  54. C
  55. C     AONE         - Index variable
  56. C     BONE         - Index variable
  57. C     LEN          - Length of file name
  58. C     NUM          - Packet number of received data
  59. C     STATUS       - Status of the recieved packet
  60. C     TNUM         - Packet number of transmitted data
  61. C     TV1          - Temporary variable
  62. C     ALIN(132)    - Line buffer for file name
  63. C
  64. C     ****************************************************************
  65. C
  66. C     Commons referenced :  KER, KERPAR, and XBYTE local commons
  67. C
  68. C     ****************************************************************
  69. C
  70. C     (*$END.DOCUMENT*)
  71. C
  72. C     ****************************************************************
  73. C     *                                                              *
  74. C     *         D I M E N S I O N   S T A T E M E N T S              *
  75. C     *                                                              *
  76. C     ****************************************************************
  77. C
  78.       IMPLICIT INTEGER (A-Z)
  79. C
  80.       INTEGER*2 ALIN(132)
  81. C
  82. C     ****************************************************************
  83. C     *                                                              *
  84. C     *         T Y P E   S T A T E M E N T S                        *
  85. C     *                                                              *
  86. C     ****************************************************************
  87. C
  88. C
  89. C     ****************************************************************
  90. C     *                                                              *
  91. C     *         C O M M O N   S T A T E M E N T S                    *
  92. C     *                                                              *
  93. C     ****************************************************************
  94. C
  95.       INCLUDE USL/KERCOM
  96.       INCLUDE USL/KERPMC
  97.       INCLUDE USL/UFTTBC
  98. C
  99.       COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
  100. C
  101. C     ****************************************************************
  102. C     *                                                              *
  103. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  104. C     *                                                              *
  105. C     ****************************************************************
  106. C
  107. C
  108. C     ****************************************************************
  109. C     *                                                              *
  110. C     *         D A T A   S T A T E M E N T S                        *
  111. C     *                                                              *
  112. C     ****************************************************************
  113. C
  114. C
  115. C     ****************************************************************
  116. C
  117. C     Code starts here :
  118. C
  119. C----->  Assume an error.
  120. C
  121.        SFILE = BIGA
  122. C
  123. C------>  Maximum no. of retries exceeded?
  124. C
  125.       IF (NUMTRY .GT. MAXTRY) RETURN
  126.       NUMTRY = NUMTRY+1
  127. C
  128. C----->  Calculate the length of the file name.
  129. C
  130.       LEN = 1
  131.    10 CONTINUE
  132.       IF (FILNAM(LEN) .EQ. EOS) GO TO 20
  133.       LEN = LEN + 1
  134.       GO TO 10
  135.    20 CONTINUE
  136.       LEN = LEN - 2
  137. C
  138. C----->  If we are running locally then display the file name.
  139. C
  140.       IF (HOSTON .NE. NO .OR.
  141.      >    NUMTRY .GT.  1     ) GO TO 30
  142.       DO 25 I=1,LEN
  143.       ALIN(I) = ISHFT (FILNAM(I),8)
  144.    25 CONTINUE
  145.       WRITE (LOCALO,1000) (ALIN(I),I=1,LEN)
  146.  1000 FORMAT (' SENDING FILE--> ',8A1)
  147.       WRITE (LOCALO,1010)
  148.  1010 FORMAT (/)
  149.    30 CONTINUE
  150. C
  151. C----->  Send the file name packet.
  152. C
  153.       TNUM = N
  154.       TV1 = BIGF
  155.       CALL SPACK (TV1,TNUM,LEN,FILNAME)
  156.       STATUS = RPACK (LEN,NUM,RECPKT)
  157. C
  158. C----->  Branch if the packet was not NAKed.
  159. C
  160.       IF (STATUS .NE. BIGN) GO TO 40
  161.       IF (N .EQ. NUM-1) RETURN
  162.       SFILE = STATE
  163.       RETURN
  164.    40 CONTINUE
  165. C
  166. C----->  Branch if the packet was not ACKed.
  167. C
  168.       IF (STATUS .NE. BIGY) GO TO 60
  169. C
  170. C----->  Branch if packet number was OK.
  171. C
  172.       IF (N .EQ. NUM) GO TO 50
  173.       SFILE = STATE
  174.       RETURN
  175.    50 CONTINUE
  176. C
  177. C----->  Reset retry counter and bump packet number.
  178. C
  179.       NUMTRY = 0
  180.       N = MOD (N+1,64)
  181. C
  182. C----->  Get ready to begin sending the data.
  183. C
  184.       XNEW = YES
  185.       XCOUNT = 1
  186.       XEOF = NO
  187.       CALL CMRI4 (IUFT(2,7),40)
  188.       SIZE = BUFILL (PACKET)
  189.       IF (SIZE .EQ. EOF) RETURN
  190.       SFILE = BIGD
  191.       RETURN
  192.    60 CONTINUE
  193. C
  194. C----->  Handle a checksum error or unexpected packet type.
  195. C
  196.       IF (STATUS .EQ. BAD) SFILE = STATE
  197.       RETURN
  198.       END
  199.