home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / xlispsrc / xlio.c < prev    next >
C/C++ Source or Header  |  1988-02-11  |  4KB  |  212 lines
  1. /* xlio - xlisp i/o routines */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* external variables */
  9. extern LVAL s_stdin,s_stdout,s_stderr,s_debugio,s_traceout,s_unbound;
  10. extern int xlfsize;
  11.  
  12. /* xlgetc - get a character from a file or stream */
  13. int xlgetc(fptr)
  14.   LVAL fptr;
  15. {
  16.     LVAL lptr,cptr;
  17.     FILE *fp;
  18.     int ch;
  19.  
  20.     /* check for input from nil */
  21.     if (fptr == NIL)
  22.     ch = EOF;
  23.  
  24.     /* otherwise, check for input from a stream */
  25.     else if (ustreamp(fptr)) {
  26.     if ((lptr = gethead(fptr)) == NIL)
  27.         ch = EOF;
  28.     else {
  29.         if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr))
  30.         xlfail("bad stream");
  31.         sethead(fptr,lptr = cdr(lptr));
  32.         if (lptr == NIL)
  33.         settail(fptr,NIL);
  34.         ch = getchcode(cptr);
  35.     }
  36.     }
  37.  
  38.     /* otherwise, check for a buffered character */
  39.     else if (ch = getsavech(fptr))
  40.     setsavech(fptr,'\0');
  41.  
  42.     /* otherwise, check for terminal input or file input */
  43.     else {
  44.     fp = getfile(fptr);
  45.     if (fp == stdin || fp == stderr)
  46.         ch = ostgetc();
  47.     else
  48.         ch = osagetc(fp);
  49.     }
  50.  
  51.     /* return the character */
  52.     return (ch);
  53. }
  54.  
  55. /* xlungetc - unget a character */
  56. xlungetc(fptr,ch)
  57.   LVAL fptr; int ch;
  58. {
  59.     LVAL lptr;
  60.     
  61.     /* check for ungetc from nil */
  62.     if (fptr == NIL)
  63.     ;
  64.     
  65.     /* otherwise, check for ungetc to a stream */
  66.     if (ustreamp(fptr)) {
  67.     if (ch != EOF) {
  68.         lptr = cons(cvchar(ch),gethead(fptr));
  69.         if (gethead(fptr) == NIL)
  70.         settail(fptr,lptr);
  71.         sethead(fptr,lptr);
  72.     }
  73.     }
  74.     
  75.     /* otherwise, it must be a file */
  76.     else
  77.     setsavech(fptr,ch);
  78. }
  79.  
  80. /* xlpeek - peek at a character from a file or stream */
  81. int xlpeek(fptr)
  82.   LVAL fptr;
  83. {
  84.     LVAL lptr,cptr;
  85.     int ch;
  86.  
  87.     /* check for input from nil */
  88.     if (fptr == NIL)
  89.     ch = EOF;
  90.  
  91.     /* otherwise, check for input from a stream */
  92.     else if (ustreamp(fptr)) {
  93.     if ((lptr = gethead(fptr)) == NIL)
  94.         ch = EOF;
  95.     else {
  96.         if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr))
  97.         xlfail("bad stream");
  98.         ch = getchcode(cptr);
  99.     }
  100.     }
  101.  
  102.     /* otherwise, get the next file character and save it */
  103.     else {
  104.     ch = xlgetc(fptr);
  105.     setsavech(fptr,ch);
  106.     }
  107.  
  108.     /* return the character */
  109.     return (ch);
  110. }
  111.  
  112. /* xlputc - put a character to a file or stream */
  113. xlputc(fptr,ch)
  114.   LVAL fptr; int ch;
  115. {
  116.     LVAL lptr;
  117.     FILE *fp;
  118.  
  119.     /* count the character */
  120.     ++xlfsize;
  121.  
  122.     /* check for output to nil */
  123.     if (fptr == NIL)
  124.     ;
  125.  
  126.     /* otherwise, check for output to an unnamed stream */
  127.     else if (ustreamp(fptr)) {
  128.     lptr = consa(cvchar(ch));
  129.     if (gettail(fptr))
  130.         rplacd(gettail(fptr),lptr);
  131.     else
  132.         sethead(fptr,lptr);
  133.     settail(fptr,lptr);
  134.     }
  135.  
  136.     /* otherwise, check for terminal output or file output */
  137.     else {
  138.     fp = getfile(fptr);
  139.     if (fp == stdout || fp == stderr)
  140.         ostputc(ch);
  141.     else
  142.         osaputc(ch,fp);
  143.     }
  144. }
  145.  
  146. /* xlflush - flush the input buffer */
  147. int xlflush()
  148. {
  149.     osflush();
  150. }
  151.  
  152. /* stdprint - print to *standard-output* */
  153. stdprint(expr)
  154.   LVAL expr;
  155. {
  156.     xlprint(getvalue(s_stdout),expr,TRUE);
  157.     xlterpri(getvalue(s_stdout));
  158. }
  159.  
  160. /* stdputstr - print a string to *standard-output* */
  161. stdputstr(str)
  162.   char *str;
  163. {
  164.     xlputstr(getvalue(s_stdout),str);
  165. }
  166.  
  167. /* errprint - print to *error-output* */
  168. errprint(expr)
  169.   LVAL expr;
  170. {
  171.     xlprint(getvalue(s_stderr),expr,TRUE);
  172.     xlterpri(getvalue(s_stderr));
  173. }
  174.  
  175. /* errputstr - print a string to *error-output* */
  176. errputstr(str)
  177.   char *str;
  178. {
  179.     xlputstr(getvalue(s_stderr),str);
  180. }
  181.  
  182. /* dbgprint - print to *debug-io* */
  183. dbgprint(expr)
  184.   LVAL expr;
  185. {
  186.     xlprint(getvalue(s_debugio),expr,TRUE);
  187.     xlterpri(getvalue(s_debugio));
  188. }
  189.  
  190. /* dbgputstr - print a string to *debug-io* */
  191. dbgputstr(str)
  192.   char *str;
  193. {
  194.     xlputstr(getvalue(s_debugio),str);
  195. }
  196.  
  197. /* trcprin1 - print to *trace-output* */
  198. trcprin1(expr)
  199.   LVAL expr;
  200. {
  201.     xlprint(getvalue(s_traceout),expr,TRUE);
  202. }
  203.  
  204. /* trcputstr - print a string to *trace-output* */
  205. trcputstr(str)
  206.   char *str;
  207. {
  208.     xlputstr(getvalue(s_traceout),str);
  209. }
  210.  
  211.  
  212.