home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / XLISP / XLISP11.ARK / XLFIO.C < prev    next >
Text File  |  1986-10-12  |  5KB  |  248 lines
  1. /* xlfio - xlisp file i/o */
  2.  
  3. #ifdef AZTEC
  4. #include "a:stdio.h"
  5. #else
  6. #include <stdio.h>
  7. #endif
  8.  
  9. #include "xlisp.h"
  10.  
  11. /* external variables */
  12. extern struct node *xlstack;
  13.  
  14. /* local variables */
  15. static char buf[STRMAX+1];
  16.  
  17. /* xlfopen - open a file */
  18. static struct node *xlfopen(args)
  19.   struct node *args;
  20. {
  21.     struct node *oldstk,arg,fname,mode,*val;
  22.     FILE *fp;
  23.  
  24.     /* create a new stack frame */
  25.     oldstk = xlsave(&arg,&fname,&mode,NULL);
  26.  
  27.     /* initialize */
  28.     arg.n_ptr = args;
  29.  
  30.     /* get the file name */
  31.     fname.n_ptr = xlevmatch(STR,&arg.n_ptr);
  32.  
  33.     /* get the mode */
  34.     mode.n_ptr = xlevmatch(STR,&arg.n_ptr);
  35.  
  36.     /* make sure there aren't any more arguments */
  37.     xllastarg(arg.n_ptr);
  38.  
  39.     /* try to open the file */
  40.     if ((fp = fopen(fname.n_ptr->n_str,
  41.                 mode.n_ptr->n_str)) != NULL) {
  42.     val = newnode(FPTR);
  43.     val->n_fp = fp;
  44.     }
  45.     else
  46.     val = NULL;
  47.  
  48.     /* restore the previous stack frame */
  49.     xlstack = oldstk;
  50.  
  51.     /* return the file pointer */
  52.     return (val);
  53. }
  54.  
  55. /* xlfclose - close a file */
  56. static struct node *xlfclose(args)
  57.   struct node *args;
  58. {
  59.     struct node *fptr;
  60.  
  61.     /* get file pointer */
  62.     fptr = xlevmatch(FPTR,&args);
  63.  
  64.     /* make sure there aren't any more arguments */
  65.     xllastarg(args);
  66.  
  67.     /* make sure the file exists */
  68.     if (fptr->n_fp == NULL)
  69.     xlfail("file not open");
  70.  
  71.     /* close the file */
  72.     fclose(fptr->n_fp);
  73.     fptr->n_fp = NULL;
  74.  
  75.     /* return nil */
  76.     return (NULL);
  77. }
  78.  
  79. /* xlgetc - get a character from a file */
  80. static struct node *xlgetc(args)
  81.   struct node *args;
  82. {
  83.     struct node *val;
  84.     FILE *fp;
  85.     int ch;
  86.  
  87.     /* get file pointer */
  88.     if (args != NULL)
  89.     fp = xlevmatch(FPTR,&args)->n_fp;
  90.     else
  91.     fp = stdin;
  92.  
  93.     /* make sure there aren't any more arguments */
  94.     xllastarg(args);
  95.  
  96.     /* make sure the file exists */
  97.     if (fp == NULL)
  98.     xlfail("file not open");
  99.  
  100.     /* get character and check for eof */
  101.     if ((ch = getc(fp)) != EOF) {
  102.  
  103.     /* create return node */
  104.     val = newnode(INT);
  105.     val->n_int = ch;
  106.     }
  107.     else
  108.     val = NULL;
  109.  
  110.     /* return the character */
  111.     return (val);
  112. }
  113.  
  114. /* xlputc - put a character to a file */
  115. static struct node *xlputc(args)
  116.   struct node *args;
  117. {
  118.     struct node *oldstk,arg,chr;
  119.     FILE *fp;
  120.  
  121.     /* create a new stack frame */
  122.     oldstk = xlsave(&arg,&chr,NULL);
  123.  
  124.     /* initialize */
  125.     arg.n_ptr = args;
  126.  
  127.     /* get the character */
  128.     chr.n_ptr = xlevmatch(INT,&arg.n_ptr);
  129.  
  130.     /* get file pointer */
  131.     if (arg.n_ptr != NULL)
  132.     fp = xlevmatch(FPTR,&arg.n_ptr)->n_fp;
  133.     else
  134.     fp = stdout;
  135.  
  136.     /* make sure there aren't any more arguments */
  137.     xllastarg(arg.n_ptr);
  138.  
  139.     /* make sure the file exists */
  140.     if (fp == NULL)
  141.     xlfail("file not open");
  142.  
  143.     /* put character to the file */
  144.     putc(chr.n_ptr->n_int,fp);
  145.  
  146.     /* restore the previous stack frame */
  147.     xlstack = oldstk;
  148.  
  149.     /* return the character */
  150.     return (chr.n_ptr);
  151. }
  152.  
  153. /* xlfgets - get a string from a file */
  154. static struct node *xlfgets(args)
  155.   struct node *args;
  156. {
  157.     struct node *str;
  158.     char *sptr;
  159.     FILE *fp;
  160.  
  161.     /* get file pointer */
  162.     if (args != NULL)
  163.     fp = xlevmatch(FPTR,&args)->n_fp;
  164.     else
  165.     fp = stdin;
  166.  
  167.     /* make sure there aren't any more arguments */
  168.     xllastarg(args);
  169.  
  170.     /* make sure the file exists */
  171.     if (fp == NULL)
  172.     xlfail("file not open");
  173.  
  174.     /* get character and check for eof */
  175.     if (fgets(buf,STRMAX,fp) != NULL) {
  176.  
  177.     /* create return node */
  178.     str = newnode(STR);
  179.     str->n_str = strsave(buf);
  180.  
  181.     /* make sure we got the whole string */
  182.     while (buf[strlen(buf)-1] != '\n') {
  183.         if (fgets(buf,STRMAX,fp) == NULL)
  184.         break;
  185.         sptr = str->n_str;
  186.         str->n_str = stralloc(strlen(sptr) + strlen(buf));
  187.         strcpy(str->n_str,sptr);
  188.         strcat(buf);
  189.         strfree(sptr);
  190.     }
  191.     }
  192.     else
  193.     str = NULL;
  194.  
  195.     /* return the string */
  196.     return (str);
  197. }
  198.  
  199. /* xlfputs - put a string to a file */
  200. static struct node *xlfputs(args)
  201.   struct node *args;
  202. {
  203.     struct node *oldstk,arg,str;
  204.     FILE *fp;
  205.  
  206.     /* create a new stack frame */
  207.     oldstk = xlsave(&arg,&str,NULL);
  208.  
  209.     /* initialize */
  210.     arg.n_ptr = args;
  211.  
  212.     /* get the string */
  213.     str.n_ptr = xlevmatch(STR,&arg.n_ptr);
  214.  
  215.     /* get file pointer */
  216.     if (arg.n_ptr != NULL)
  217.     fp = xlevmatch(FPTR,&arg.n_ptr)->n_fp;
  218.     else
  219.     fp = stdout;
  220.  
  221.     /* make sure there aren't any more arguments */
  222.     xllastarg(arg.n_ptr);
  223.  
  224.     /* make sure the file exists */
  225.     if (fp == NULL)
  226.     xlfail("file not open");
  227.  
  228.     /* put string to the file */
  229.     fputs(str.n_ptr->n_str,fp);
  230.  
  231.     /* restore the previous stack frame */
  232.     xlstack = oldstk;
  233.  
  234.     /* return the string */
  235.     return (str.n_ptr);
  236. }
  237.  
  238. /* xlfinit - initialize file stuff */
  239. xlfinit()
  240. {
  241.     xlsubr("fopen",xlfopen);
  242.     xlsubr("fclose",xlfclose);
  243.     xlsubr("getc",xlgetc);
  244.     xlsubr("putc",xlputc);
  245.     xlsubr("fgets",xlfgets);
  246.     xlsubr("fputs",xlfputs);
  247. }
  248.