home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / modcomp / dgetli. < prev    next >
Text File  |  1987-01-25  |  5KB  |  156 lines
  1.       INTEGER FUNCTION DGETLI (ALIN,CH)
  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:  Get a line of compressed source from a disk file and
  24. C                uncompress the line, unpack it (convert to 1 char
  25. C                per word) and put a CR/EOS after the last nonblank
  26. C                character.
  27. C
  28. C     MODIFICATION HISTORY
  29. C
  30. C     BY            DATE     REASON            PROGRAMS AFFECTED
  31. C
  32. C     ****************************************************************
  33. C
  34. C     Author:  Rick Burke           Version: A.0    Date: Aug-86
  35. C
  36. C     Calling Parameters:
  37. C
  38. C     W    ALIN         - Line of text to be returned to the caller
  39. C     R    CH           - UFT number to be used for the read
  40. C
  41. C     ****************************************************************
  42. C
  43. C     Messages generated by this module :  None
  44. C
  45. C     ****************************************************************
  46. C
  47. C     Subroutines called directly :  CMR4, IAND, ISHFT
  48. C
  49. C     ****************************************************************
  50. C
  51. C     Files referenced :  None
  52. C
  53. C     ****************************************************************
  54. C
  55. C     Local variable definitions :
  56. C
  57. C     ACOUNT       - Index variable for return array
  58. C     I            - Index variable
  59. C     IEND         - End-of-file indicator
  60. C     LEN          - Length of uncompressed source line
  61. C     MLEFT        - Mask used to extract left byte of a word
  62. C     MRIGHT       - Mask used to extract right byte of a word
  63. C     CLIN(132)    - Uncompressed source read from disk
  64. C
  65. C     ****************************************************************
  66. C
  67. C     Commons referenced :  KERPAR and UFTTBL local commons
  68. C
  69. C     ****************************************************************
  70. C
  71. C     (*$END.DOCUMENT*)
  72. C
  73. C     ****************************************************************
  74. C     *                                                              *
  75. C     *         D I M E N S I O N   S T A T E M E N T S              *
  76. C     *                                                              *
  77. C     ****************************************************************
  78. C
  79.       IMPLICIT INTEGER (A-Z)
  80.       INTEGER*2   ALIN(132),   CLIN(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/KERPMC
  96. C
  97.       INCLUDE USL/UFTTBC
  98. C
  99. C     ****************************************************************
  100. C     *                                                              *
  101. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  102. C     *                                                              *
  103. C     ****************************************************************
  104. C
  105. C
  106. C     ****************************************************************
  107. C     *                                                              *
  108. C     *         D A T A   S T A T E M E N T S                        *
  109. C     *                                                              *
  110. C     ****************************************************************
  111. C
  112.       DATA        MLEFT /Z7F00/,            MRIGHT /Z007F/
  113. C
  114. C     ****************************************************************
  115. C
  116. C     Code starts here :
  117. C
  118.       DO 10 I = 1,132
  119.       ALIN(I) = 0
  120.       CLIN(I) = 0
  121.    10 CONTINUE
  122. C
  123. C----->  Read compressed source from the current file position.
  124. C
  125.       CALL CMR4 (CLIN,IEND,LEN)
  126.       IF (IEND .EQ. 1) GO TO 20
  127.       DGETLI = EOF
  128.       RETURN
  129.    20 CONTINUE
  130. C
  131. C----->  Loop to expand the data to 1 byte per word.
  132. C
  133.       DO 30 I = 1,65
  134.       ACOUNT = I * 2
  135.       ALIN(ACOUNT-1) = ISHFT (IAND (CLIN(I),MLEFT),-8)
  136.       ALIN(ACOUNT) = IAND (CLIN(I),MRIGHT)
  137.    30 CONTINUE
  138. C
  139. C----->  Remove any trailing blanks.
  140. C
  141.       DO 40 I=1,130
  142.       ACOUNT = 131 - I
  143.       IF (ALIN(ACOUNT) .NE.     0 .AND.
  144.      >    ALIN(ACOUNT) .NE. BLANK      ) GO TO 50
  145.    40 CONTINUE
  146.       ACOUNT = 0
  147.    50 CONTINUE
  148. C
  149. C----->  Add LF and EOS at the end.
  150. C
  151.       ALIN(ACOUNT+1) = LF
  152.       ALIN(ACOUNT+2) = EOS
  153.       DGETLI = OK
  154.       RETURN
  155.       END
  156.