/* xlfio - xlisp file i/o */ #ifdef AZTEC #include "a:stdio.h" #else #include #endif #include "xlisp.h" /* external variables */ extern struct node *xlstack; /* local variables */ static char buf[STRMAX+1]; /* xlfopen - open a file */ static struct node *xlfopen(args) struct node *args; { struct node *oldstk,arg,fname,mode,*val; FILE *fp; /* create a new stack frame */ oldstk = xlsave(&arg,&fname,&mode,NULL); /* initialize */ arg.n_ptr = args; /* get the file name */ fname.n_ptr = xlevmatch(STR,&arg.n_ptr); /* get the mode */ mode.n_ptr = xlevmatch(STR,&arg.n_ptr); /* make sure there aren't any more arguments */ xllastarg(arg.n_ptr); /* try to open the file */ if ((fp = fopen(fname.n_ptr->n_str, mode.n_ptr->n_str)) != NULL) { val = newnode(FPTR); val->n_fp = fp; } else val = NULL; /* restore the previous stack frame */ xlstack = oldstk; /* return the file pointer */ return (val); } /* xlfclose - close a file */ static struct node *xlfclose(args) struct node *args; { struct node *fptr; /* get file pointer */ fptr = xlevmatch(FPTR,&args); /* make sure there aren't any more arguments */ xllastarg(args); /* make sure the file exists */ if (fptr->n_fp == NULL) xlfail("file not open"); /* close the file */ fclose(fptr->n_fp); fptr->n_fp = NULL; /* return nil */ return (NULL); } /* xlgetc - get a character from a file */ static struct node *xlgetc(args) struct node *args; { struct node *val; FILE *fp; int ch; /* get file pointer */ if (args != NULL) fp = xlevmatch(FPTR,&args)->n_fp; else fp = stdin; /* make sure there aren't any more arguments */ xllastarg(args); /* make sure the file exists */ if (fp == NULL) xlfail("file not open"); /* get character and check for eof */ if ((ch = getc(fp)) != EOF) { /* create return node */ val = newnode(INT); val->n_int = ch; } else val = NULL; /* return the character */ return (val); } /* xlputc - put a character to a file */ static struct node *xlputc(args) struct node *args; { struct node *oldstk,arg,chr; FILE *fp; /* create a new stack frame */ oldstk = xlsave(&arg,&chr,NULL); /* initialize */ arg.n_ptr = args; /* get the character */ chr.n_ptr = xlevmatch(INT,&arg.n_ptr); /* get file pointer */ if (arg.n_ptr != NULL) fp = xlevmatch(FPTR,&arg.n_ptr)->n_fp; else fp = stdout; /* make sure there aren't any more arguments */ xllastarg(arg.n_ptr); /* make sure the file exists */ if (fp == NULL) xlfail("file not open"); /* put character to the file */ putc(chr.n_ptr->n_int,fp); /* restore the previous stack frame */ xlstack = oldstk; /* return the character */ return (chr.n_ptr); } /* xlfgets - get a string from a file */ static struct node *xlfgets(args) struct node *args; { struct node *str; char *sptr; FILE *fp; /* get file pointer */ if (args != NULL) fp = xlevmatch(FPTR,&args)->n_fp; else fp = stdin; /* make sure there aren't any more arguments */ xllastarg(args); /* make sure the file exists */ if (fp == NULL) xlfail("file not open"); /* get character and check for eof */ if (fgets(buf,STRMAX,fp) != NULL) { /* create return node */ str = newnode(STR); str->n_str = strsave(buf); /* make sure we got the whole string */ while (buf[strlen(buf)-1] != '\n') { if (fgets(buf,STRMAX,fp) == NULL) break; sptr = str->n_str; str->n_str = stralloc(strlen(sptr) + strlen(buf)); strcpy(str->n_str,sptr); strcat(buf); strfree(sptr); } } else str = NULL; /* return the string */ return (str); } /* xlfputs - put a string to a file */ static struct node *xlfputs(args) struct node *args; { struct node *oldstk,arg,str; FILE *fp; /* create a new stack frame */ oldstk = xlsave(&arg,&str,NULL); /* initialize */ arg.n_ptr = args; /* get the string */ str.n_ptr = xlevmatch(STR,&arg.n_ptr); /* get file pointer */ if (arg.n_ptr != NULL) fp = xlevmatch(FPTR,&arg.n_ptr)->n_fp; else fp = stdout; /* make sure there aren't any more arguments */ xllastarg(arg.n_ptr); /* make sure the file exists */ if (fp == NULL) xlfail("file not open"); /* put string to the file */ fputs(str.n_ptr->n_str,fp); /* restore the previous stack frame */ xlstack = oldstk; /* return the string */ return (str.n_ptr); } /* xlfinit - initialize file stuff */ xlfinit() { xlsubr("fopen",xlfopen); xlsubr("fclose",xlfclose); xlsubr("getc",xlgetc); xlsubr("putc",xlputc); xlsubr("fgets",xlfgets); xlsubr("fputs",xlfputs); }