home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / modcomp / spack. < prev    next >
Text File  |  2020-01-01  |  6KB  |  173 lines
  1.       SUBROUTINE SPACK (XTYPE,NUM,LEN,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:  SEND THIS PACKET TO THE REMOTE KERMIT
  24. C
  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     R    XTYPE     - DATA PACKET TYPE
  38. C     R    NUM       - PACKET SEQUENCE NUMBER (MODULO 64)
  39. C     R    LEN       - LENGTH IN WORDS OF XDATA
  40. C     R    XDATA     - DATA PORTION OF PACKET
  41. C
  42. C     ****************************************************************
  43. C
  44. C     Messages generated by this module :  None
  45. C
  46. C     ****************************************************************
  47. C
  48. C     Subroutines called directly :  TOCHAR, TPUTCH
  49. C
  50. C     ****************************************************************
  51. C
  52. C     Files referenced :  None
  53. C
  54. C     ****************************************************************
  55. C
  56. C     Local variable definitions :
  57. C
  58. C     BUFFER  - SCRATCH TO PIECE TOGETHER THE WHOLE PACKET
  59. C     CH      - UFT # TO OUTPUT TO
  60. C     CHKSUM  - BLOCK CHECKSUM
  61. C     COUNT   - RUNNING COUNT OF HOW MANY CHARACTERS IN PACKET
  62. C
  63. C     ****************************************************************
  64. C
  65. C     Commons referenced :  KER and KERPAR
  66. C
  67. C     ****************************************************************
  68. C
  69. C     (*$END.DOCUMENT*)
  70. C
  71. C     ****************************************************************
  72. C     *                                                              *
  73. C     *         D I M E N S I O N   S T A T E M E N T S              *
  74. C     *                                                              *
  75. C     ****************************************************************
  76. C
  77.       IMPLICIT INTEGER (A-Z)
  78. C
  79.       INTEGER*2   XDATA(1),    BUFFER(132)
  80. C
  81. C     ****************************************************************
  82. C     *                                                              *
  83. C     *         T Y P E   S T A T E M E N T S                        *
  84. C     *                                                              *
  85. C     ****************************************************************
  86. C
  87. C
  88. C     ****************************************************************
  89. C     *                                                              *
  90. C     *         C O M M O N   S T A T E M E N T S                    *
  91. C     *                                                              *
  92. C     ****************************************************************
  93. C
  94.       INCLUDE USL/KERCOM
  95.       INCLUDE USL/KERPMC
  96. C
  97. C     ****************************************************************
  98. C     *                                                              *
  99. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  100. C     *                                                              *
  101. C     ****************************************************************
  102. C
  103. C
  104. C     ****************************************************************
  105. C     *                                                              *
  106. C     *         D A T A   S T A T E M E N T S                        *
  107. C     *                                                              *
  108. C     ****************************************************************
  109. C
  110. C
  111. C     ****************************************************************
  112. C
  113. C     Code starts here :
  114. C
  115. C
  116. C
  117. C                                   !THIS IS THE CHANNEL TO SEND PACKET
  118. C                                   !OUT ON, START WITH THE FIRST BYTE
  119.       CH=RMTOUT
  120.       I=1
  121. C
  122.   100 CONTINUE
  123. C                                     !SEND OUT PADCHAR IF NEEDED
  124.       IF(I.GT.PAD)GO TO 200
  125.          CALL TPUTCH(PADCHAR,CH)
  126.          I=I+1
  127.          GO TO 100
  128.   200 CONTINUE
  129. C                                     !BUILD UP THE PACKET
  130.       COUNT=1
  131.       BUFFER(COUNT)=SOH
  132.       COUNT=COUNT+1
  133.       CHKSUM=TOCHAR(LEN+3)
  134.       BUFFER(COUNT)=TOCHAR(LEN+3)
  135.       COUNT=COUNT+1
  136.       CHKSUM=CHKSUM+TOCHAR(NUM)
  137.       BUFFER(COUNT)=TOCHAR(NUM)
  138.       COUNT=COUNT+1
  139.       CHKSUM=CHKSUM+XTYPE
  140.       BUFFER(COUNT)=XTYPE
  141.       COUNT=COUNT+1
  142. C
  143. C                                    !COPY THE CONTENT OF PACKET INFORMA
  144.       IF (LEN .LT. 1) GO TO 310
  145.       DO 300 I=1,LEN
  146. C                                    !CALCULATE THE CHECKSUM
  147.          BUFFER(COUNT)=XDATA(I)
  148.          COUNT=COUNT+1
  149.          CHKSUM=CHKSUM+XDATA(I)
  150.   300 CONTINUE
  151.   310 CONTINUE
  152. C
  153.       TV1=IAND(CHKSUM,192)
  154.       TV2=TV1/64
  155.       TV3=TV2+CHKSUM
  156.       CHKSUM=IAND(TV3,63)
  157.       BUFFER(COUNT)=TOCHAR(CHKSUM)
  158.       COUNT=COUNT+1
  159.       BUFFER(COUNT)=EOL
  160.       BUFFER(COUNT+1)=EOS
  161.       COUNT=1
  162.       CH=RMTOUT
  163. C
  164. C                                                !SEND OUT THE PACKET
  165.   400 CONTINUE
  166.       IF(BUFFER(COUNT).EQ.EOS)GO TO 500
  167.          CALL TPUTCH(BUFFER(COUNT),CH)
  168.          COUNT=COUNT+1
  169.          GO TO 400
  170.   500 CONTINUE
  171.       RETURN
  172.       END
  173.