home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / modcomp / dgetch. < prev    next >
Text File  |  2020-01-01  |  5KB  |  139 lines
  1.       INTEGER FUNCTION DGETCH (XCHAR,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 character from the disk file
  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    XCHAR        - THE CHARACTER YOU GOT
  37. C     R    CH           - THE CHANNEL TO READ ON
  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 :  DGETLIN
  46. C
  47. C     ****************************************************************
  48. C
  49. C     Files referenced :  None
  50. C
  51. C     ****************************************************************
  52. C
  53. C     Local variable definitions :
  54. C
  55. C     ****************************************************************
  56. C
  57. C     Commons referenced :  XBYTE and KER local commons
  58. C
  59. C     ****************************************************************
  60. C
  61. C     (*$END.DOCUMENT*)
  62. C
  63. C     ****************************************************************
  64. C     *                                                              *
  65. C     *         D I M E N S I O N   S T A T E M E N T S              *
  66. C     *                                                              *
  67. C     ****************************************************************
  68. C
  69.       IMPLICIT INTEGER*2 (A-Z)
  70. C
  71. C     ****************************************************************
  72. C     *                                                              *
  73. C     *         T Y P E   S T A T E M E N T S                        *
  74. C     *                                                              *
  75. C     ****************************************************************
  76. C
  77. C
  78. C     ****************************************************************
  79. C     *                                                              *
  80. C     *         C O M M O N   S T A T E M E N T S                    *
  81. C     *                                                              *
  82. C     ****************************************************************
  83. C
  84.       COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
  85.       INCLUDE USL/KERPMC
  86. C
  87. C     ****************************************************************
  88. C     *                                                              *
  89. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  90. C     *                                                              *
  91. C     ****************************************************************
  92. C
  93. C
  94. C     ****************************************************************
  95. C     *                                                              *
  96. C     *         D A T A   S T A T E M E N T S                        *
  97. C     *                                                              *
  98. C     ****************************************************************
  99. C
  100. C
  101. C     ****************************************************************
  102. C
  103. C     Code starts here :
  104. C
  105.       IF(XEOF.NE.YES)GO TO 100
  106.          DGETCH=EOF
  107.          RETURN
  108.   100 CONTINUE
  109.       IF(XNEW.NE.YES)GO TO 1000
  110.          X=DGETLIN(XLIN,CH)
  111.          IF(X.NE.EOF)GO TO 800
  112.             DGETCH=EOF
  113.             XEOF=YES
  114.             RETURN
  115.   800    CONTINUE
  116.             IF(XLIN(1).NE.LF)GO TO 900
  117.                XNEW=YES
  118.                DGETCH=OK
  119.                XCHAR=LF
  120.                RETURN
  121.   900       CONTINUE
  122.                XNEW=NO
  123.                DGETCH=OK
  124.                XCHAR=XLIN(1)
  125.                XCOUNT=2
  126.                RETURN
  127.  1000 CONTINUE
  128.           IF(XLIN(XCOUNT).NE.LF)GO TO 1100
  129.              XNEW=YES
  130.              DGETCH=OK
  131.              XCHAR=LF
  132.              RETURN
  133.  1100      CONTINUE
  134.               DGETCH=OK
  135.               XCHAR=XLIN(XCOUNT)
  136.               XCOUNT=XCOUNT+1
  137.               RETURN
  138.       END
  139.