home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lisp / interpre / xlispdos / source / xlio.c < prev    next >
Encoding:
C/C++ Source or Header  |  1986-04-06  |  3.0 KB  |  150 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. #ifdef MEGAMAX
  9. overlay "io"
  10. #endif
  11.  
  12. /* external variables */
  13. extern NODE *s_stdin,*s_unbound;
  14. extern int xlfsize;
  15. extern int xlplevel;
  16. extern int xldebug;
  17. extern int prompt;
  18. extern char buf[];
  19.  
  20. /* xlgetc - get a character from a file or stream */
  21. int xlgetc(fptr)
  22.   NODE *fptr;
  23. {
  24.     NODE *lptr,*cptr;
  25.     FILE *fp;
  26.     int ch;
  27.  
  28.     /* check for input from nil */
  29.     if (fptr == NIL)
  30.     ch = EOF;
  31.  
  32.     /* otherwise, check for input from a stream */
  33.     else if (consp(fptr)) {
  34.     if ((lptr = car(fptr)) == NIL)
  35.         ch = EOF;
  36.     else {
  37.         if (!consp(lptr) ||
  38.         (cptr = car(lptr)) == NIL || !fixp(cptr))
  39.         xlfail("bad stream");
  40.         if (rplaca(fptr,cdr(lptr)) == NIL)
  41.         rplacd(fptr,NIL);
  42.         ch = getfixnum(cptr);
  43.     }
  44.     }
  45.  
  46.     /* otherwise, check for a buffered file character */
  47.     else if (ch = getsavech(fptr))
  48.     setsavech(fptr,0);
  49.  
  50.     /* otherwise, get a new character */
  51.     else {
  52.  
  53.     /* get the file pointer */
  54.     fp = getfile(fptr);
  55.  
  56.     /* prompt if necessary */
  57.     if (prompt && fp == stdin) {
  58.  
  59.         /* print the debug level */
  60.         if (xldebug)
  61.         { sprintf(buf,"%d:",xldebug); stdputstr(buf); }
  62.  
  63.         /* print the nesting level */
  64.         if (xlplevel > 0)
  65.         { sprintf(buf,"%d",xlplevel); stdputstr(buf); }
  66.  
  67.         /* print the prompt */
  68.         stdputstr("> ");
  69.         prompt = FALSE;
  70.     }
  71.  
  72.     /* get the character */
  73.     ch = osgetc(fp);
  74.  
  75.     /* set the prompt flag on end of line or end of file */
  76.     if ((ch == '\n' || ch == EOF) && fp == stdin)
  77.         prompt = TRUE;
  78.     }
  79.  
  80.     /* return the character */
  81.     return (ch);
  82. }
  83.  
  84. /* xlpeek - peek at a character from a file or stream */
  85. int xlpeek(fptr)
  86.   NODE *fptr;
  87. {
  88.     NODE *lptr,*cptr;
  89.     int ch;
  90.  
  91.     /* check for input from nil */
  92.     if (fptr == NIL)
  93.     ch = EOF;
  94.  
  95.     /* otherwise, check for input from a stream */
  96.     else if (consp(fptr)) {
  97.     if ((lptr = car(fptr)) == NIL)
  98.         ch = EOF;
  99.     else {
  100.         if (!consp(lptr) ||
  101.         (cptr = car(lptr)) == NIL || !fixp(cptr))
  102.         xlfail("bad stream");
  103.         ch = getfixnum(cptr);
  104.     }
  105.     }
  106.  
  107.     /* otherwise, get the next file character and save it */
  108.     else
  109.     setsavech(fptr,ch = xlgetc(fptr));
  110.  
  111.     /* return the character */
  112.     return (ch);
  113. }
  114.  
  115. /* xlputc - put a character to a file or stream */
  116. xlputc(fptr,ch)
  117.   NODE *fptr; int ch;
  118. {
  119.     NODE *lptr;
  120.  
  121.     /* count the character */
  122.     xlfsize++;
  123.  
  124.     /* check for output to nil */
  125.     if (fptr == NIL)
  126.     ;
  127.  
  128.     /* otherwise, check for output to a stream */
  129.     else if (consp(fptr)) {
  130.     lptr = consa(cvfixnum((FIXNUM)ch));
  131.     if (cdr(fptr))
  132.         rplacd(cdr(fptr),lptr);
  133.     else
  134.         rplaca(fptr,lptr);
  135.     rplacd(fptr,lptr);
  136.     }
  137.  
  138.     /* otherwise, output the character to a file */
  139.     else
  140.     osputc(ch,getfile(fptr));
  141. }
  142.  
  143. /* xlflush - flush the input buffer */
  144. int xlflush()
  145. {
  146.     if (!prompt)
  147.     while (xlgetc(getvalue(s_stdin)) != '\n')
  148.         ;
  149. }
  150.