home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / windows / c / xlisp21w / sources / xlio.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-03  |  6.1 KB  |  240 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_stdout,s_stderr,s_debugio,s_traceout;
  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.     FILEP 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)) != 0)
  40.         setsavech(fptr,'\0');
  41.  
  42.     /* otherwise, check for terminal input or file input */
  43.     else {
  44.         fp = getfile(fptr);
  45.         if (fp == CLOSED)   /* TAA MOD -- give error */
  46.             xlfail("can't read closed stream");
  47.         else if (fp == CONSOLE)
  48.             /* TAA MOD -- revamped for redirecting */
  49.             ch = ostgetc();
  50.         else {
  51.             if ((fptr->n_sflags & S_FORREADING) == 0)
  52.                 xlerror("can't read write-only file stream", fptr);
  53.             if ((fptr->n_sflags & S_READING) == 0) {
  54.                 /* possible direction change*/
  55.                 if (fptr->n_sflags & S_WRITING) {
  56.                     OSSEEKCUR(fp,0L);
  57.                 }
  58.                 fptr->n_sflags |= S_READING;
  59.                 fptr->n_sflags &= ~S_WRITING;
  60.             }
  61.             ch = OSGETC(fp);
  62.         }
  63.     }
  64.  
  65.     /* return the character */
  66.     return (ch);
  67. }
  68.  
  69. /* xlungetc - unget a character */
  70. VOID xlungetc(fptr,ch)
  71.   LVAL fptr; int ch;
  72. {
  73.     LVAL lptr;
  74.  
  75.     /* check for ungetc from nil, or ungetc of EOF */
  76.     if (fptr == NIL || ch == EOF)
  77.         ;
  78.  
  79.     /* otherwise, check for ungetc to a stream */
  80.     else if (ustreamp(fptr)) {
  81.         lptr = cons(cvchar(ch),gethead(fptr));
  82.         if (gethead(fptr) == NIL)
  83.             settail(fptr,lptr);
  84.         sethead(fptr,lptr);
  85.     }
  86.  
  87.     /* otherwise, it must be a file */
  88.     else
  89.         setsavech(fptr,ch);
  90. }
  91.  
  92. /* xlpeek - peek at a character from a file or stream */
  93. int xlpeek(fptr)
  94.   LVAL fptr;
  95. {
  96.     LVAL lptr,cptr;
  97.     int ch;
  98.  
  99.     /* check for input from nil */
  100.     if (fptr == NIL)
  101.         ch = EOF;
  102.  
  103.     /* otherwise, check for input from a stream */
  104.     else if (ustreamp(fptr)) {
  105.         if ((lptr = gethead(fptr)) == NIL)
  106.             ch = EOF;
  107.         else {
  108.             if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr))
  109.                 xlfail("bad stream");
  110.             ch = getchcode(cptr);
  111.         }
  112.     }
  113.  
  114.     /* otherwise, get the next file character and save it */
  115.     else {
  116.         ch = xlgetc(fptr);
  117.         if (ch != EOF) setsavech(fptr,ch);  /* TAA MOD -- don't save EOF! */
  118.     }
  119.  
  120.     /* return the character */
  121.     return (ch);
  122. }
  123.  
  124. /* xlputc - put a character to a file or stream */
  125. VOID xlputc(fptr,ch)
  126.   LVAL fptr; int ch;
  127. {
  128.     LVAL lptr;
  129.     FILEP fp;
  130.  
  131.     /* count the character */
  132.     ++xlfsize;
  133.  
  134.     /* check for output to nil */
  135.     if (fptr == NIL)
  136.         ;
  137.  
  138.     /* otherwise, check for output to an unnamed stream */
  139.     else if (ntype(fptr) == USTREAM) {  /* TAA MOD, was ustreamp() */
  140.         lptr = consa(cvchar(ch));
  141.         if (gettail(fptr)!=NIL)
  142.             rplacd(gettail(fptr),lptr);
  143.         else
  144.             sethead(fptr,lptr);
  145.         settail(fptr,lptr);
  146.     }
  147.  
  148.     /* otherwise, check for terminal output or file output */
  149.     else {
  150.         fp = getfile(fptr);
  151.         if (fp == CLOSED)   /* TAA MOD -- give error */
  152.             xlfail("can't write closed stream");
  153.         if (fp == CONSOLE)  /* TAA MOD -- for redirecting */
  154.             ostputc(ch);
  155.         else {
  156.             if ((fptr->n_sflags & S_FORWRITING) == 0)
  157.                 xlerror("can't write read-only file stream", fptr);
  158.             if ((fptr->n_sflags & S_WRITING) == 0) {
  159.                 /* possible direction change*/
  160.                 if (fptr->n_sflags & S_READING) {
  161.                     OSSEEKCUR(fp,
  162.                         (getsavech(fptr)?(setsavech(fptr,'\0'),-1L):0L));
  163.                 }
  164.                 fptr->n_sflags |= S_WRITING;
  165.                 fptr->n_sflags &= ~S_READING;
  166.                 fptr->n_cpos = 0;   /* best guess */
  167.             }
  168.             if (ch == '\n') fptr->n_cpos = 0;
  169.             else fptr->n_cpos++;
  170.             if (OSPUTC(ch,fp)==EOF) /* TAA MOD to check for write to RO file*/
  171.                 xlerror("write failed", fptr);
  172.         }
  173.     }
  174. }
  175.  
  176. /* xlflush - flush the input buffer */
  177. VOID xlflush()
  178. {
  179.     osflush();
  180. }
  181.  
  182. /* stdprint - print to *standard-output* */
  183. VOID stdprint(expr)
  184.   LVAL expr;
  185. {
  186.     xlprint(getvalue(s_stdout),expr,TRUE);
  187.     xlterpri(getvalue(s_stdout));
  188. }
  189.  
  190. /* stdputstr - print a string to *standard-output* */
  191. VOID stdputstr(str)
  192.   char *str;
  193. {
  194.     xlputstr(getvalue(s_stdout),str);
  195. }
  196.  
  197. /* errprint - print to *error-output* */
  198. VOID errprint(expr)
  199.   LVAL expr;
  200. {
  201.     xlprint(getvalue(s_stderr),expr,TRUE);
  202.     xlterpri(getvalue(s_stderr));
  203. }
  204.  
  205. /* errputstr - print a string to *error-output* */
  206. VOID errputstr(str)
  207.   char *str;
  208. {
  209.     xlputstr(getvalue(s_stderr),str);
  210. }
  211.  
  212. /* dbgprint - print to *debug-io* */
  213. VOID dbgprint(expr)
  214.   LVAL expr;
  215. {
  216.     xlprint(getvalue(s_debugio),expr,TRUE);
  217.     xlterpri(getvalue(s_debugio));
  218. }
  219.  
  220. /* dbgputstr - print a string to *debug-io* */
  221. VOID dbgputstr(str)
  222.   char *str;
  223. {
  224.     xlputstr(getvalue(s_debugio),str);
  225. }
  226.  
  227. /* trcprin1 - print to *trace-output* */
  228. VOID trcprin1(expr)
  229.   LVAL expr;
  230. {
  231.     xlprint(getvalue(s_traceout),expr,TRUE);
  232. }
  233.  
  234. /* trcputstr - print a string to *trace-output* */
  235. VOID trcputstr(str)
  236.   char *str;
  237. {
  238.     xlputstr(getvalue(s_traceout),str);
  239. }
  240.