home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / modcomp / recsw. < prev    next >
Text File  |  2020-01-01  |  6KB  |  169 lines
  1.       INTEGER FUNCTION RECSW (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:  Receive a file or group of files from the
  24. C                other Kermit.
  25. C
  26. C     MODIFICATION HISTORY
  27. C
  28. C     BY            DATE     REASON            PROGRAMS AFFECTED
  29. C
  30. C
  31. C     ****************************************************************
  32. C
  33. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  34. C
  35. C     Calling Parameters:
  36. C
  37. C          X        - REQUIRED BY FORTRAN
  38. C
  39. C     ****************************************************************
  40. C
  41. C     Messages generated by this module :  None
  42. C
  43. C     ****************************************************************
  44. C
  45. C     Subroutines called directly : RINIT , RDATA , RFILE , PUTLIN
  46. C                                   SPACK , BKFILE , AVFILE
  47. C
  48. C     ****************************************************************
  49. C
  50. C     Files referenced :  None
  51. C
  52. C     ****************************************************************
  53. C
  54. C     Local variable definitions :
  55. C
  56. C     UFTFIL       UFT# FOR THE FILE NAMES SCRATCH
  57. C     UFTDAT       UFT# FOR THE FILE DATA SCRATCH
  58. C
  59. C     ****************************************************************
  60. C
  61. C     Commons referenced :  KERCOM, KERPMC, UFTTBL, XBYTE local commons
  62. C
  63. C     ****************************************************************
  64. C
  65. C     (*$END.DOCUMENT*)
  66. C
  67. C     ****************************************************************
  68. C     *                                                              *
  69. C     *         D I M E N S I O N   S T A T E M E N T S              *
  70. C     *                                                              *
  71. C     ****************************************************************
  72. C
  73.       IMPLICIT INTEGER (A-Z)
  74. C
  75.       INTEGER*2   FILNM(50)
  76. C
  77. C     ****************************************************************
  78. C     *                                                              *
  79. C     *         T Y P E   S T A T E M E N T S                        *
  80. C     *                                                              *
  81. C     ****************************************************************
  82. C
  83. C
  84. C     ****************************************************************
  85. C     *                                                              *
  86. C     *         C O M M O N   S T A T E M E N T S                    *
  87. C     *                                                              *
  88. C     ****************************************************************
  89. C
  90.       INCLUDE USL/KERCOM
  91.       INCLUDE USL/KERPMC
  92.       INCLUDE USL/UFTTBC
  93.       COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
  94. C
  95. C     ****************************************************************
  96. C     *                                                              *
  97. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  98. C     *                                                              *
  99. C     ****************************************************************
  100. C
  101. C
  102. C     ****************************************************************
  103. C     *                                                              *
  104. C     *         D A T A   S T A T E M E N T S                        *
  105. C     *                                                              *
  106. C     ****************************************************************
  107. C
  108.       DATA UFTFIL / 5 /
  109.       DATA UFTDAT / 8 /
  110. C
  111. C     ****************************************************************
  112. C
  113. C     Code starts here :
  114. C
  115.       STATUS=YES
  116.       STATE=BIGR
  117.       XNEW=YES
  118.       XCOUNT=1
  119.       N=0
  120.       NUMTRY=0
  121. C
  122.   100 CONTINUE
  123. C
  124.       IF(STATUS.NE.YES)GO TO 9000
  125. C                                                   !READ A DATA PACKET
  126.                IF(STATE.NE.BIGD)GO TO 200
  127.                   STATE=RDATA(X)
  128.                   GO TO 1000
  129.   200          CONTINUE
  130. C                                                   !READ A SINIT PACKET
  131.                IF(STATE.NE.BIGR)GO TO 300
  132.                   STATE=RINIT(X)
  133.                   GO TO 1000
  134.   300          CONTINUE
  135. C                                                   !READ A FILE HEADER
  136.                IF(STATE.NE.BIGF)GO TO 400
  137.                   STATE=RFILE(FILNM)
  138.                   IF (STATE .EQ. BIGD) CALL CMWI4 (IUFT(2,UFTDAT),40)
  139.                   GO TO 1000
  140.   400          CONTINUE
  141. C                                                   !FILE TRANSFER DONE
  142.                IF(STATE.NE.BIGC)GO TO 500
  143.                   RECSW=YES
  144. C
  145.                   IF (HOSTON .EQ. YES) CALL TERMIN (IUFT(1,4),.FALSE.)
  146.                   RETURN
  147.   500           CONTINUE
  148. C                                                   !WE GOT AN ERROR
  149.                 IF(STATE.NE.BIGA)GO TO 1000
  150.                        RECSW=NO
  151.                        TV1=BIGE
  152.                        TV2=N
  153.                        TV3=0
  154.                        TV4=0
  155. C                                                 !SEND AN ERROR PACKET
  156.                        CALL SPACK(TV1,TV2,TV3,TV4)
  157. C                                                  BACK UP SCRATCH TO GET
  158. C                                                   RID OF JUNK
  159.                    CALL BKFILE(IUFT(1,UFTDAT))
  160.                    CALL AVFILE(IUFT(1,UFTDAT))
  161.                    RETURN
  162.  1000           CONTINUE
  163. C
  164.                 GO TO 100
  165. C
  166.  9000 CONTINUE
  167.       RETURN
  168.       END
  169.