home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / XSCHEME2.ZIP / xsio.c < prev    next >
C/C++ Source or Header  |  1990-01-08  |  2KB  |  109 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. /* xlputc - put a character to a file or stream */
  58. xlputc(fptr,ch)
  59.   LVAL fptr; int ch;
  60. {
  61.     FILE *fp;
  62.  
  63.     /* count the character */
  64.     ++xlfsize;
  65.  
  66.     /* check for output to nil */
  67.     if (fptr == NIL)
  68.     ;
  69.  
  70.     /* otherwise, check for terminal output or file output */
  71.     else {
  72.     fp = getfile(fptr);
  73.     if (fp == stdout || fp == stderr)
  74.         ostputc(ch);
  75.     else if ((getpflags(fptr) & PF_BINARY) != 0)
  76.         osbputc(ch,fp);
  77.     else
  78.         osaputc(ch,fp);
  79.     }
  80. }
  81.  
  82. /* xlflush - flush the input buffer */
  83. int xlflush()
  84. {
  85.     osflush();
  86. }
  87.  
  88. /* stdputstr - print a string to *standard-output* */
  89. stdputstr(str)
  90.   char *str;
  91. {
  92.     xlputstr(getvalue(s_stdout),str);
  93. }
  94.  
  95. /* errprint - print to *error-output* */
  96. errprint(expr)
  97.   LVAL expr;
  98. {
  99.     xlprin1(expr,getvalue(s_stderr));
  100.     xlterpri(getvalue(s_stderr));
  101. }
  102.  
  103. /* errputstr - print a string to *error-output* */
  104. errputstr(str)
  105.   char *str;
  106. {
  107.     xlputstr(getvalue(s_stderr),str);
  108. }
  109.