home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / modcomp.zip / rpack. < prev    next >
Text File  |  1987-01-26  |  7KB  |  207 lines
  1.       INTEGER FUNCTION RPACK (LEN,NUM,XDATA)
  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:  Read a packet from 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
  32. C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
  33. C
  34. C     Calling Parameters:
  35. C
  36. C     W  LEN       - LENGTH OF PACKET
  37. C     W  NUM       - PACKET SEQUENCE NUMBER
  38. C     W  XDATA     - THE PACKET
  39. C
  40. C     ****************************************************************
  41. C
  42. C     Messages generated by this module :  None
  43. C
  44. C     ****************************************************************
  45. C
  46. C     Subroutines called directly :  GETLIN, UNCHAR
  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      CHKSUM  - CALCULATED VALUE OF CHECKSUM
  57. C      GAPTRY  - # OF TIMES WE'VE LOOKED FOR PACKET STARTING WIT SOH
  58. C      MGAPTRY - MAXIMUM ALLOWED VALUE OF GAPTRY
  59. C      XTYPE   - CODE FOR TYPE OF PACKET
  60. C
  61. C     ****************************************************************
  62. C
  63. C     Commons referenced :  KER, KERPAR
  64. C
  65. C     ****************************************************************
  66. C
  67. C     (*$END.DOCUMENT*)
  68. C
  69. C     ****************************************************************
  70. C     *                                                              *
  71. C     *         D I M E N S I O N   S T A T E M E N T S              *
  72. C     *                                                              *
  73. C     ****************************************************************
  74. C
  75.       IMPLICIT INTEGER (A-Z)
  76.       INTEGER*2   XDATA(1),    BUFFER(132)
  77. C
  78. C     ****************************************************************
  79. C     *                                                              *
  80. C     *         T Y P E   S T A T E M E N T S                        *
  81. C     *                                                              *
  82. C     ****************************************************************
  83. C
  84. C
  85. C     ****************************************************************
  86. C     *                                                              *
  87. C     *         C O M M O N   S T A T E M E N T S                    *
  88. C     *                                                              *
  89. C     ****************************************************************
  90. C
  91.       INCLUDE USL/KERCOM
  92.       INCLUDE USL/KERPMC
  93. C
  94. C     ****************************************************************
  95. C     *                                                              *
  96. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  97. C     *                                                              *
  98. C     ****************************************************************
  99. C
  100. C
  101. C     ****************************************************************
  102. C     *                                                              *
  103. C     *         D A T A   S T A T E M E N T S                        *
  104. C     *                                                              *
  105. C     ****************************************************************
  106. C
  107. C
  108. C     ****************************************************************
  109. C
  110. C     Code starts here :
  111. C
  112. C                                     !THIS IS THE INPUT CHANNEL TO READ
  113. C                                     !A PACKET FROM
  114.       CH=4
  115.       GAPTRY=1
  116.       MGAPTRY=2
  117.       CHKSUM=0
  118. C
  119. C     READ ME A PACKET THAT BEGINS WITH A SOH AND ENDS WITH MYEOL
  120. C
  121.   100 CONTINUE
  122. C
  123.       IF(GAPTRY.GT.MGAPTRY)GO TO 9000
  124. C                                          !GET A PACKET WITHOUT WAITING
  125. C                                          !FOR A PROMPT
  126.          IF(IBMON .NE. YES)STATUS=GETLIN(BUFFER,CH)
  127. C
  128. C                                           IF TIMEOUT, LOOP
  129. C
  130.          IF(STATUS .EQ. BAD)GO TO 1000
  131. C
  132.          COUNT=1
  133. C
  134. C        SKIPS ALL OTHER CHARACTERS UNTIL WE SEE ONE WITH A SOH IN IT
  135. C
  136.   200    CONTINUE
  137. C
  138.          IF((BUFFER(COUNT).EQ.SOH).OR.(BUFFER(COUNT).EQ.EOS))GO TO 300
  139. C                                          !WAIT FOR A SOH OR EOS
  140.             COUNT=COUNT+1
  141.             GO TO 200
  142.   300    CONTINUE
  143. C                                          !WE GOT THE SOH
  144.          IF(BUFFER(COUNT).NE.SOH)GO TO 1000
  145. C
  146. C           WE GOT A LINE THAT BEGINS WITH A SOH
  147. C
  148.             K=COUNT+1
  149.             CHKSUM=BUFFER(K)
  150. C                                          !GET THE LENGTH OF THE PACKET
  151.             LEN=UNCHAR(BUFFER(K))-3
  152.             K=K+1
  153.             CHKSUM=CHKSUM+BUFFER(K)
  154. C                                          !GET THE SEQUENCE NUMBER OF
  155. C                                          !THE FRAME PACKET
  156.             NUM=UNCHAR(BUFFER(K))
  157.             K=K+1
  158. C                                          !GET THE DATA TYPE
  159.             XTYPE=BUFFER(K)
  160.             CHKSUM=CHKSUM+BUFFER(K)
  161.             K=K+1
  162. C
  163. C           GET THE DATA
  164. C
  165. C           ZERO OUT THE XDATA ARRAY
  166.             DO 400 I=1,132
  167.                XDATA(I)=0
  168.   400       CONTINUE
  169.             IF (LEN .LT. 1) GO TO 510
  170.             DO 500 J=1,LEN
  171.                XDATA(J)=BUFFER(K)
  172.                CHKSUM=CHKSUM+BUFFER(K)
  173.                K=K+1
  174.                COUNT=J
  175.   500       CONTINUE
  176.   510       CONTINUE
  177. C
  178.             XDATA(COUNT+1)=EOS
  179.             T=BUFFER(K)
  180. C
  181. C           CALCULATE THE CHECKSUM OF THE INCOMING PACKET
  182. C
  183.             TV1=IAND(CHKSUM,192)
  184.             TV2=TV1/64
  185.             TV3=CHKSUM+TV2
  186.             CHKSUM=IAND(TV3,63)
  187. C
  188. C           DOES THE CHECKSUM MATCH?
  189. C
  190.             IF(CHKSUM.EQ.UNCHAR(T))GO TO 600
  191. C                                          !BAD CHECKSUM
  192.                RPACK=BAD
  193.                RETURN
  194.   600       CONTINUE
  195.                 RPACK=XTYPE
  196.                 RETURN
  197.  1000    CONTINUE
  198. C
  199. C        WE GOT THE EOS, THE PACKET HAS NO SOH, READ ANOTHER ONE
  200. C
  201.          GAPTRY=GAPTRY+1
  202.          GO TO 100
  203.  9000 CONTINUE
  204.       RPACK=BAD
  205.       RETURN
  206.       END
  207.