home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / modcomp / pack. < prev    next >
Text File  |  2020-01-01  |  5KB  |  137 lines
  1.       SUBROUTINE PACK (ALIN,BLIN)
  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:  Pack the INTEGER array ALIN into the array BLIN
  24. C                with the right side of the byte ending with a
  25. C                BLANK, in case there are an odd number of bytes.
  26. C
  27. C     MODIFICATION HISTORY
  28. C
  29. C     BY            DATE     REASON            PROGRAMS AFFECTED
  30. C
  31. C     ****************************************************************
  32. C
  33. C     Author:  Rick Burke           Version: A.0    Date: Aug-86
  34. C
  35. C     Calling Parameters:
  36. C
  37. C     R    ALIN         - Array to be packed
  38. C     W    BLIN         - Packed array to be returned to the user
  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 : IAND, IOR, ISHFT
  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     ACOUNT       - Index pointer into ALIN
  57. C     BCOUNT       - Index pointer into BLIN
  58. C     LEFT         - Symbolic constant for LEFT byte
  59. C     RIGHT        - Symbolic constant for RIGHT byte
  60. C     WHICHS       - Indicator for left/right side to be processed
  61. C
  62. C     ****************************************************************
  63. C
  64. C     Commons referenced :  KERPAR local common
  65. C
  66. C     ****************************************************************
  67. C
  68. C     (*$END.DOCUMENT*)
  69. C
  70. C     ****************************************************************
  71. C     *                                                              *
  72. C     *         D I M E N S I O N   S T A T E M E N T S              *
  73. C     *                                                              *
  74. C     ****************************************************************
  75. C
  76.       IMPLICIT INTEGER (A-Z)
  77.       INTEGER*2   ALIN(1),     BLIN(1)
  78. C
  79. C     ****************************************************************
  80. C     *                                                              *
  81. C     *         T Y P E   S T A T E M E N T S                        *
  82. C     *                                                              *
  83. C     ****************************************************************
  84. C
  85. C
  86. C     ****************************************************************
  87. C     *                                                              *
  88. C     *         C O M M O N   S T A T E M E N T S                    *
  89. C     *                                                              *
  90. C     ****************************************************************
  91. C
  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.       DATA        LEFT /0/,    RIGHT /1/
  108. C
  109. C     ****************************************************************
  110. C
  111. C     Code starts here :
  112. C
  113.       WHICHS = LEFT
  114.       ACOUNT = 1
  115.       BCOUNT = 1
  116. C
  117.       BLIN(1) = 4Z2020
  118.       IF (ALIN(ACOUNT) .EQ. LF) GO TO 40
  119. C
  120. C----->  Pack the output line, until LF char is reached.
  121. C
  122.    10 CONTINUE
  123.       IF (WHICHS .NE. LEFT) GO TO 20
  124.       BLIN(BCOUNT) = IOR (ISHFT (ALIN(ACOUNT),8),4Z0020)
  125.       WHICHS = RIGHT
  126.       GO TO 30
  127.    20 CONTINUE
  128.       BLIN(BCOUNT) = IOR (IAND (BLIN(BCOUNT),4ZFF00),ALIN(ACOUNT))
  129.       BCOUNT = BCOUNT + 1
  130.       WHICHS = LEFT
  131.    30 CONTINUE
  132.       ACOUNT = ACOUNT + 1
  133.       IF (ALIN(ACOUNT) .NE. LF) GO TO 10
  134.    40 CONTINUE
  135.       RETURN
  136.       END
  137.