home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / xscheme / xsio.c < prev    next >
Encoding:
C/C++ Source or Header  |  1989-01-29  |  2.5 KB  |  137 lines
  1. /* xsio - xscheme i/o routines */
  2. /*    Copyright (c) 1988, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xscheme.h"
  7.  
  8. /* global variables */
  9. FIXTYPE xlfsize;
  10.  
  11. /* external variables */
  12. extern LVAL s_stdin,s_stdout,s_stderr,s_unbound;
  13.  
  14. /* xlgetc - get a character from a file or stream */
  15. int xlgetc(fptr)
  16.   LVAL fptr;
  17. {
  18.     FILE *fp;
  19.     int ch;
  20.  
  21.     /* check for input from nil */
  22.     if (fptr == NIL)
  23.     ch = EOF;
  24.  
  25.     /* otherwise, check for a buffered character */
  26.     else if (ch = getsavech(fptr))
  27.     setsavech(fptr,'\0');
  28.  
  29.     /* otherwise, check for terminal input or file input */
  30.     else {
  31.     fp = getfile(fptr);
  32.     if (fp == stdin || fp == stderr)
  33.         ch = ostgetc();
  34.     else if ((getpflags(fptr) & PF_BINARY) != 0)
  35.         ch = osbgetc(fp);
  36.     else
  37.         ch = osagetc(fp);
  38.     }
  39.  
  40.     /* return the character */
  41.     return (ch);
  42. }
  43.  
  44. /* xlungetc - unget a character */
  45. xlungetc(fptr,ch)
  46.   LVAL fptr; int ch;
  47. {
  48.     /* check for ungetc from nil */
  49.     if (fptr == NIL)
  50.     ;
  51.     
  52.     /* otherwise, it must be a file */
  53.     else
  54.     setsavech(fptr,ch);
  55. }
  56.  
  57. /* xlpeek - peek at a character from a file or stream */
  58. int xlpeek(fptr)
  59.   LVAL fptr;
  60. {
  61.     int ch;
  62.  
  63.     /* check for input from nil */
  64.     if (fptr == NIL)
  65.     ch = EOF;
  66.  
  67.     /* otherwise, get the next file character and save it */
  68.     else {
  69.     ch = xlgetc(fptr);
  70.     setsavech(fptr,ch);
  71.     }
  72.  
  73.     /* return the character */
  74.     return (ch);
  75. }
  76.  
  77. /* xlputc - put a character to a file or stream */
  78. xlputc(fptr,ch)
  79.   LVAL fptr; int ch;
  80. {
  81.     FILE *fp;
  82.  
  83.     /* count the character */
  84.     ++xlfsize;
  85.  
  86.     /* check for output to nil */
  87.     if (fptr == NIL)
  88.     ;
  89.  
  90.     /* otherwise, check for terminal output or file output */
  91.     else {
  92.     fp = getfile(fptr);
  93.     if (fp == stdout || fp == stderr)
  94.         ostputc(ch);
  95.     else if ((getpflags(fptr) & PF_BINARY) != 0)
  96.         osbputc(ch,fp);
  97.     else
  98.         osaputc(ch,fp);
  99.     }
  100. }
  101.  
  102. /* xlflush - flush the input buffer */
  103. int xlflush()
  104. {
  105.     osflush();
  106. }
  107.  
  108. /* stdprint - print to *standard-output* */
  109. stdprint(expr)
  110.   LVAL expr;
  111. {
  112.     xlprin1(expr,getvalue(s_stdout));
  113.     xlterpri(getvalue(s_stdout));
  114. }
  115.  
  116. /* stdputstr - print a string to *standard-output* */
  117. stdputstr(str)
  118.   char *str;
  119. {
  120.     xlputstr(getvalue(s_stdout),str);
  121. }
  122.  
  123. /* errprint - print to *error-output* */
  124. errprint(expr)
  125.   LVAL expr;
  126. {
  127.     xlprin1(expr,getvalue(s_stderr));
  128.     xlterpri(getvalue(s_stderr));
  129. }
  130.  
  131. /* errputstr - print a string to *error-output* */
  132. errputstr(str)
  133.   char *str;
  134. {
  135.     xlputstr(getvalue(s_stderr),str);
  136. }
  137.