1 /*
2  *                   COPYRIGHT (c) 1988-1994 BY                             *
3  *        PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS.       *
4  *        See the source file SLIB.C for more information.                  *
5 
6  * Reorganization of files (Mar 1999) by Alan W Black <awb@cstr.ed.ac.uk>
7 
8  * File functions
9 
10 */
11 #include <cstdio>
12 #include "siod.h"
13 #include "siodp.h"
14 #include "EST_Pathname.h"
15 
16 static void siod_string_print(LISP exp, EST_String &sd);
17 
18 LISP open_files = NIL;
19 
pprintf(FILE * fd,LISP exp,int indent,int width,int depth,int length)20 void pprintf(FILE *fd,LISP exp,int indent,int width, int depth,int length)
21 {
22     // A pretty printer for expressions
23     // indent is the number of spaces to indent by
24     // width is the maximum column we're allow to print to
25     // depth is the we should print before ignoring it
26     // length is the number of items in a list we should print
27     int i,ll;
28     LISP l;
29 
30     if (exp == NIL)
31 	fprintf(fd,"nil");
32     else if (!consp(exp))
33 	fprintf(fd,"%s",(const char *)siod_sprint(exp));
34     else
35     {
36 	EST_String p = siod_sprint(exp);
37 	if (p.length() < width-indent)
38 	    fprintf(fd,"%s",(const char *)p);
39 	else
40 	{
41 	    fprintf(fd,"(");
42 	    indent += 1;
43 	    if (depth == 0)
44 		fprintf(fd,"...");
45 	    else
46 	    {
47 		pprintf(fd,car(exp),indent,width,depth-1,length);
48 		for (ll=length,l=cdr(exp); l != NIL; l=cdr(l),ll--)
49 		{
50 		    fprintf(fd,"\n");
51 		    for (i=0; i<indent; i++)
52 			fprintf(fd," ");
53 		    if (ll == 0)
54 		    {
55 			pprintf(fd,rintern("..."),indent,width,
56 				depth-1,length);
57 			break;
58 		    }
59 		    else if (!consp(l))  // a dotted pair
60 		    {
61 			fprintf(fd," . %s",(const char *)siod_sprint(l));
62 			break;
63 		    }
64 		    else
65 			pprintf(fd,car(l),indent,width,depth-1,length);
66 		}
67 	    }
68 	    fprintf(fd,")");
69 	}
70     }
71 }
72 
pprint_to_fd(FILE * fd,LISP exp)73 void pprint_to_fd(FILE *fd,LISP exp)
74 {
75     pprintf(fd,exp,0,72,-1,-1);
76     fprintf(fd,"\n");
77 }
78 
siod_pprintf(LISP exp,LISP file)79 static LISP siod_pprintf(LISP exp, LISP file)
80 {
81     //  Pretty printer
82 
83     if ((file == NIL) ||
84 	(equal(file,rintern("t"))))
85 	pprint(exp);
86     else
87     {
88 	pprintf(get_c_file(file,stdout),exp,0,72,-1,-1);
89 	fprintf(get_c_file(file,stdout),"\n");
90     }
91     return NIL;
92 }
93 
pprint(LISP exp)94 void pprint(LISP exp)
95 {
96     // Pretty print this expression to stdout
97 
98     pprint_to_fd(stdout,exp);
99 }
100 
fflush_l(LISP p)101 static LISP fflush_l(LISP p)
102 {
103     if (p == NIL)
104 	fflush(stdout);
105     else if NTYPEP(p,tc_c_file)
106 	err("not a file",p);
107     else
108 	fflush(p->storage_as.c_file.f);
109     return NIL;
110 }
111 
siod_string_print(LISP exp,EST_String & sd)112 static void siod_string_print(LISP exp, EST_String &sd)
113 {
114     LISP tmp;
115     int i;
116 
117     switch TYPE(exp)
118     {
119       case tc_nil:
120 	sd += "nil";
121 	break;
122       case tc_cons:
123 	sd += "(";
124 	siod_string_print(car(exp),sd);
125 	for(tmp=cdr(exp);CONSP(tmp);tmp=cdr(tmp))
126 	{
127 	    sd += " ";
128 	    siod_string_print(car(tmp),sd);
129 	}
130 	if NNULLP(tmp)
131 	{
132 	    sd += " . ";
133 	    siod_string_print(tmp,sd);
134 	}
135 	sd += ")";
136 	break;
137       case tc_flonum:
138 	if (FLONMPNAME(exp) == NULL)
139 	{
140 	    sprintf(tkbuffer,"%.8g",FLONM(exp));
141 	    FLONMPNAME(exp) = (char *)must_malloc(strlen(tkbuffer)+1);
142 	    sprintf(FLONMPNAME(exp),"%s",tkbuffer);
143 	}
144 	sprintf(tkbuffer,"%s",FLONMPNAME(exp));
145 	sd += tkbuffer;
146 	break;
147       case tc_string:
148 	sd += "\"";
149 	for (i=0; exp->storage_as.string.data[i] != '\0'; i++)
150 	{
151 	    if (exp->storage_as.string.data[i] == '"')
152 		sd += "\\";
153 	    if (exp->storage_as.string.data[i] == '\\')
154 		sd += "\\";
155 	    sprintf(tkbuffer,"%c",exp->storage_as.string.data[i]);
156 	    sd += tkbuffer;
157 	}
158 	sd += "\"";
159 	break;
160       case tc_symbol:
161 	sd += PNAME(exp);
162 	break;
163       case tc_subr_0:
164       case tc_subr_1:
165       case tc_subr_2:
166       case tc_subr_3:
167       case tc_subr_4:
168       case tc_lsubr:
169       case tc_fsubr:
170       case tc_msubr:
171 	sprintf(tkbuffer,"#<SUBR(%d) ",TYPE(exp));
172 	sd += tkbuffer;
173 	sd += (*exp).storage_as.subr.name;
174 	sd += ">";
175 	break;
176       case tc_c_file:
177 	sprintf(tkbuffer,"#<FILE %p ",(void *)exp->storage_as.c_file.f);
178 	sd += tkbuffer;
179 	if (exp->storage_as.c_file.name)
180 	    sd += exp->storage_as.c_file.name;
181 	sd += ">";
182         break;
183       case tc_closure:
184 	sd += "#<CLOSURE ";
185 	siod_string_print(car((*exp).storage_as.closure.code),sd);
186 	sd += " ";
187 	siod_string_print(cdr((*exp).storage_as.closure.code),sd);
188 	sd += ">";
189 	break;
190       default:
191 	struct user_type_hooks *p;
192 	p = get_user_type_hooks(TYPE(exp));
193 	if (p->print_string)
194 	  (*p->print_string)(exp, tkbuffer);
195 	else
196 	{
197 	    if (p->name)
198 		sprintf(tkbuffer,"#<%s %p>",p->name,(void *)exp);
199 	    else
200 		sprintf(tkbuffer,"#<UNKNOWN %d %p>",TYPE(exp),(void *)exp);
201 	}
202 	sd += tkbuffer;
203     }
204     return;
205 }
206 
siod_sprint(LISP exp)207 EST_String siod_sprint(LISP exp)
208 {
209     EST_String r;
210 
211     r = "";
212     siod_string_print(exp,r);
213 
214     return r;
215 }
216 
217 
fd_to_scheme_file(int fd,const char * name,const char * how,int close_on_error)218 static LISP fd_to_scheme_file(int fd,
219 			      const char *name,
220 			      const char *how,
221 			      int close_on_error)
222 {
223   LISP sym;
224   long flag;
225   flag = no_interrupt(1);
226   sym = newcell(tc_c_file);
227   sym->storage_as.c_file.f = (FILE *)NULL;
228   sym->storage_as.c_file.name = (char *)NULL;
229 
230   if (fd != fileno(stderr))
231       open_files = cons(sym,open_files);
232   sym->storage_as.c_file.name = (char *) must_malloc(strlen(name)+1);
233   if (fd == fileno(stdin))
234       sym->storage_as.c_file.f = stdin;
235   else   if (fd == fileno(stdout))
236       sym->storage_as.c_file.f = stdout;
237   else   if (fd == fileno(stderr))
238       sym->storage_as.c_file.f = stderr;
239   else if (!(sym->storage_as.c_file.f = fdopen(fd ,how)))
240     {
241       if (close_on_error)
242 	close(fd);
243       perror(name);
244       put_st("\n");
245       err("could not open file", name);
246     }
247   strcpy(sym->storage_as.c_file.name,name);
248   no_interrupt(flag);
249   return(sym);
250 }
251 
fopen_c(const char * name,const char * how)252 LISP fopen_c(const char *name, const char *how)
253 {
254   LISP sym;
255   int fd;
256 
257   fd = fd_open_file(name, how);
258 
259   if (fd < 0)
260     err("could not open file", name);
261 
262   sym = fd_to_scheme_file(fd, name, how, 1);
263 
264   return(sym);
265 }
266 
siod_fdopen_c(int fd,const char * name,char * how)267 LISP siod_fdopen_c(int fd, const char *name, char *how)
268 {
269   return fd_to_scheme_file(fd, name, how, 0);
270 }
271 
fopen_l(LISP what,const char * r_or_w)272 LISP fopen_l(LISP what, const char *r_or_w)
273 {
274   int fd = -1;
275   const char *filename = NULL;
276 
277   if (NULLP(what))
278     {
279       filename = "-";
280       fd = fd_open_stdinout(r_or_w);
281     }
282   else if (SYMBOLP(what) || STRINGP(what))
283     {
284       fd = fd_open_file((filename = get_c_string(what)), r_or_w);
285     }
286   else if (LIST1P(what))
287     {
288       fd = fd_open_file((filename = get_c_string(CAR(what))), r_or_w);
289     }
290   else if (CONSP(what)  &&  !CONSP(CDR(what)))
291     {
292       filename = "[tcp connection]";
293       fd = fd_open_url("tcp",
294 		       get_c_string(CAR(what)),
295 		       get_c_string(CDR(what)),
296 		       NULL,
297 		       r_or_w);
298     }
299   else if (LIST4P(what))
300     {
301       filename = "[url]";
302       fd = fd_open_url(get_c_string(CAR1(what)),
303 		       get_c_string(CAR2(what)),
304 		       get_c_string(CAR3(what)),
305 		       get_c_string(CAR4(what)),
306 		       r_or_w);
307     }
308   else
309     err("not openable", what);
310 
311   if (fd<0)
312     err("can't open", what);
313 
314   return fd_to_scheme_file(fd, filename, r_or_w, 1);
315 }
316 
file_gc_free(LISP ptr)317 static void file_gc_free(LISP ptr)
318 {if ((ptr->storage_as.c_file.f) &&
319      (ptr->storage_as.c_file.f != stdin) &&
320      (ptr->storage_as.c_file.f != stdout))
321    {fclose(ptr->storage_as.c_file.f);
322     ptr->storage_as.c_file.f = (FILE *) NULL;}
323  if (ptr->storage_as.c_file.name)
324    {wfree(ptr->storage_as.c_file.name);
325     ptr->storage_as.c_file.name = NULL;}}
326 
fclose_l(LISP p)327 LISP fclose_l(LISP p)
328 {long flag;
329  flag = no_interrupt(1);
330  if NTYPEP(p,tc_c_file) err("not a file",p);
331  file_gc_free(p);
332  open_files = delq(p,open_files);
333  no_interrupt(flag);
334  return(NIL);}
335 
file_prin1(LISP ptr,FILE * f)336 static void file_prin1(LISP ptr,FILE *f)
337 {char *name;
338  name = ptr->storage_as.c_file.name;
339  fput_st(f,"#<FILE ");
340  sprintf(tkbuffer," %p",(void *)ptr->storage_as.c_file.f);
341  fput_st(f,tkbuffer);
342  if (name)
343    {fput_st(f," ");
344     fput_st(f,name);}
345  fput_st(f,">");}
346 
get_c_file(LISP p,FILE * deflt)347 FILE *get_c_file(LISP p,FILE *deflt)
348 {if (NULLP(p) && deflt) return(deflt);
349  if NTYPEP(p,tc_c_file) err("not a file",p);
350  if (!p->storage_as.c_file.f) err("file is closed",p);
351  return(p->storage_as.c_file.f);}
352 
lgetc(LISP p)353 LISP lgetc(LISP p)
354 {int i;
355  i = f_getc(get_c_file(p,stdin));
356  return((i == EOF) ? NIL : flocons((double)i));}
357 
lputc(LISP c,LISP p)358 LISP lputc(LISP c,LISP p)
359 {long flag;
360  int i;
361  FILE *f;
362  f = get_c_file(p,stdout);
363  if FLONUMP(c)
364    i = (int)FLONM(c);
365  else
366    i = *get_c_string(c);
367  flag = no_interrupt(1);
368  putc(i,f);
369  no_interrupt(flag);
370  return(NIL);}
371 
lputs(LISP str,LISP p)372 LISP lputs(LISP str,LISP p)
373 {fput_st(get_c_file(p,stdout),get_c_string(str));
374  return(NIL);}
375 
lftell(LISP file)376 LISP lftell(LISP file)
377 {return(flocons((double)ftell(get_c_file(file,NULL))));}
378 
lfseek(LISP file,LISP offset,LISP direction)379 LISP lfseek(LISP file,LISP offset,LISP direction)
380 {return((fseek(get_c_file(file,NULL),get_c_int(offset),get_c_int(direction)))
381 	? NIL : truth);}
382 
directory_entries(LISP ldir,LISP lnoflagdir)383 static LISP directory_entries(LISP ldir, LISP lnoflagdir)
384 {
385   LISP lentries=NIL;
386   EST_Pathname dir(get_c_string(ldir));
387 
388   if (dir == "")
389     return NIL;
390 
391   dir = dir.as_directory();
392 
393   EST_StrList entries(dir.entries(lnoflagdir!=NIL?0:1));
394   EST_Litem *item;
395 
396   for(item=entries.head(); item; item = item->next())
397     {
398       EST_String entry(entries(item));
399       if (entry != "../" && entry != "./" && entry != ".." && entry != ".")
400 	{
401 	  LISP litem = strintern(entry);
402 	  lentries = cons(litem, lentries);
403 	}
404     }
405 
406   return lentries;
407 }
408 
fopen_l(LISP what,LISP how)409 static LISP fopen_l(LISP what,LISP how)
410 {
411   const char *r_or_w = NULLP(how) ? "rb" : get_c_string(how);
412 
413   return fopen_l(what, r_or_w);
414 
415 }
416 
lfread(LISP size,LISP file)417 static LISP lfread(LISP size,LISP file)
418 {long flag,n,ret,m;
419  char *buffer;
420  LISP s;
421  FILE *f;
422  f = get_c_file(file,NULL);
423  flag = no_interrupt(1);
424  if TYPEP(size,tc_string)
425    {s = size;
426     buffer = s->storage_as.string.data;
427     n = s->storage_as.string.dim;
428     m = 0;}
429  else
430    {n = get_c_int(size);
431     buffer = (char *) must_malloc(n+1);
432     buffer[n] = 0;
433     m = 1;}
434  ret = fread(buffer,1,n,f);
435  if (ret == 0)
436    {if (m)
437       wfree(buffer);
438     no_interrupt(flag);
439     return(NIL);}
440  if (m)
441    {if (ret == n)
442       {s = cons(NIL,NIL);
443        s->type = tc_string;
444        s->storage_as.string.data = buffer;
445        s->storage_as.string.dim = n;}
446     else
447       {s = strcons(ret,NULL);
448        memcpy(s->storage_as.string.data,buffer,ret);
449        wfree(buffer);}
450     no_interrupt(flag);
451     return(s);}
452  no_interrupt(flag);
453  return(flocons((double)ret));}
454 
lfwrite(LISP string,LISP file)455 static LISP lfwrite(LISP string,LISP file)
456 {FILE *f;
457  long flag;
458  char *data;
459  long dim;
460  f = get_c_file(file,NULL);
461  if NTYPEP(string,tc_string) err("not a string",string);
462  data = string->storage_as.string.data;
463  dim = string->storage_as.string.dim;
464  flag = no_interrupt(1);
465  fwrite(data,dim,1,f);
466  no_interrupt(flag);
467  return(NIL);}
468 
lprin1f(LISP exp,FILE * f)469 LISP lprin1f(LISP exp,FILE *f)
470 {LISP tmp;
471  struct user_type_hooks *p;
472  STACK_CHECK(&exp);
473  INTERRUPT_CHECK();
474  switch TYPE(exp)
475    {case tc_nil:
476       fput_st(f,"nil");
477       break;
478    case tc_cons:
479       fput_st(f,"(");
480       lprin1f(car(exp),f);
481       for(tmp=cdr(exp);CONSP(tmp);tmp=cdr(tmp))
482 	{fput_st(f," ");lprin1f(car(tmp),f);}
483       if NNULLP(tmp) {fput_st(f," . ");lprin1f(tmp,f);}
484       fput_st(f,")");
485       break;
486     case tc_flonum:
487       if (FLONMPNAME(exp) == NULL)
488       {
489 	  sprintf(tkbuffer,"%.8g",FLONM(exp));
490 	  FLONMPNAME(exp) = (char *)must_malloc(strlen(tkbuffer)+1);
491 	  sprintf(FLONMPNAME(exp),"%s",tkbuffer);
492       }
493       sprintf(tkbuffer,"%s",FLONMPNAME(exp));
494       fput_st(f,tkbuffer);
495       break;
496     case tc_symbol:
497       fput_st(f,PNAME(exp));
498       break;
499     case tc_subr_0:
500     case tc_subr_1:
501     case tc_subr_2:
502     case tc_subr_3:
503     case tc_subr_4:
504     case tc_lsubr:
505     case tc_fsubr:
506     case tc_msubr:
507       sprintf(tkbuffer,"#<SUBR(%d) ",TYPE(exp));
508       fput_st(f,tkbuffer);
509       fput_st(f,(*exp).storage_as.subr.name);
510       fput_st(f,">");
511       break;
512     case tc_closure:
513       fput_st(f,"#<CLOSURE ");
514       lprin1f(car((*exp).storage_as.closure.code),f);
515       fput_st(f," ");
516       lprin1f(cdr((*exp).storage_as.closure.code),f);
517       fput_st(f,">");
518       break;
519     default:
520       p = get_user_type_hooks(TYPE(exp));
521       if (p->prin1)
522 	(*p->prin1)(exp,f);
523       else
524       {
525 	  if (p->name)
526 	      sprintf(tkbuffer,"#<%s %p>",p->name,USERVAL(exp));
527 	  else
528 	      sprintf(tkbuffer,"#<UNKNOWN %d %p>",TYPE(exp),(void *)exp);
529 	  fput_st(f,tkbuffer);}}
530  return(NIL);}
531 
lprintfp(LISP exp,LISP file)532 static LISP lprintfp(LISP exp,LISP file)
533 {lprin1f(exp,get_c_file(file,stdout));
534  return(NIL);}
535 
terpri(LISP file)536 static LISP terpri(LISP file)
537 {fput_st(get_c_file(file,stdout),"\n");
538  return(NIL);}
539 
lreadfp(LISP file)540 static LISP lreadfp(LISP file)
541 {return lreadf(get_c_file(file,stdout));}
542 
load(LISP fname,LISP cflag)543 LISP load(LISP fname,LISP cflag)
544 {return(vload(get_c_string(fname),NULLP(cflag) ? 0 : 1));}
545 
lprint(LISP exp)546 LISP lprint(LISP exp)
547 {lprin1f(exp,stdout);
548  put_st("\n");
549  return(NIL);}
550 
lread(void)551 LISP lread(void)
552 {return(lreadf(stdin));}
553 
get_eof_val(void)554 LISP get_eof_val(void)
555 {return(eof_val);}
556 
probe_file(LISP fname)557 static LISP probe_file(LISP fname)
558 {
559     // return t if file exists, nil otherwise
560     const char *filename;
561 
562     filename = get_c_string(fname);
563     if (access(filename,R_OK) == 0)
564 	return truth;
565     else
566 	return NIL;
567 }
568 
lunlink(LISP name)569 static LISP lunlink(LISP name)
570 {
571     unlink(get_c_string(name));
572     return NIL;
573 }
574 
save_forms(LISP fname,LISP forms,LISP how)575 static LISP save_forms(LISP fname,LISP forms,LISP how)
576 {const char *cname;
577  const char *chow = NULL;
578  LISP l,lf;
579  FILE *f;
580  cname = get_c_string(fname);
581  if EQ(how,NIL) chow = "wb";
582  else if EQ(how,cintern("a")) chow = "a";
583  else err("bad argument to save-forms",how);
584  fput_st(fwarn,(*chow == 'a') ? "appending" : "saving");
585  fput_st(fwarn," forms to ");
586  fput_st(fwarn,cname);
587  fput_st(fwarn,"\n");
588  lf = fopen_c(cname,chow);
589  f = lf->storage_as.c_file.f;
590  for(l=forms;NNULLP(l);l=cdr(l))
591    {lprin1f(car(l),f);
592     putc('\n',f);}
593  fclose_l(lf);
594  fput_st(fwarn,"done.\n");
595  return(truth);}
596 
close_open_files_upto(LISP end)597 void close_open_files_upto(LISP end)
598 {LISP l,p;
599  for(l=open_files;((l!=end)&&(l!=NIL));l=cdr(l))
600    {p = car(l);
601     if (p->storage_as.c_file.f)
602       {fprintf(stderr,"closing a file left open: %s\n",
603 	       (p->storage_as.c_file.name) ? p->storage_as.c_file.name : "");
604        fflush(stderr);
605        file_gc_free(p);}}
606  open_files = l;}
607 
close_open_files(void)608 void close_open_files(void)
609 {
610     close_open_files_upto(NIL);
611 }
612 
check_first_line(FILE * lf)613 static void check_first_line(FILE *lf)
614 {  /* If this line starts #! skip it -- this is for scripts */
615     int c0,c1,c2;
616     if ((c0=getc(lf)) == '#')
617     {
618 	if ((c1 = getc(lf)) == '!')
619 	    while (((c2=getc(lf)) != '\n') && (c2 != EOF)); /* skip to EOLN */
620 	else
621 	{
622 	    ungetc(c1,lf);
623 	    ungetc(c0,lf);  /* possibly something don't support 2 ungets */
624 	}
625     }
626     else
627 	ungetc(c0,lf);
628 }
629 
vload(const char * fname_raw,long cflag)630 LISP vload(const char *fname_raw, long cflag)
631 {
632   LISP form,result,tail,lf;
633  FILE *f;
634   EST_Pathname fname(fname_raw);
635  fput_st(fwarn,"loading ");
636  fput_st(fwarn,fname);
637  fput_st(fwarn,"\n");
638  lf = fopen_c(fname,"rb");
639  f = lf->storage_as.c_file.f;
640  if (!cflag)
641      check_first_line(f);
642  result = NIL;
643  tail = NIL;
644  while(1)
645    {form = lreadf(f);
646     if EQ(form,eof_val) break;
647     if (cflag)
648       {form = cons(form,NIL);
649        if NULLP(result)
650 	 result = tail = form;
651        else
652 	 tail = setcdr(tail,form);}
653     else
654       leval(form,NIL);}
655  fclose_l(lf);
656  fput_st(fwarn,"done.\n");
657  return(result);}
658 
init_subrs_file(void)659 void init_subrs_file(void)
660 {
661     long j;
662     set_gc_hooks(tc_c_file,FALSE,NULL,NULL,NULL,file_gc_free,NULL,&j);
663     set_print_hooks(tc_c_file,file_prin1, NULL);
664     setvar(cintern("stderr"),
665 	   fd_to_scheme_file(fileno(stderr),"stderr","w",FALSE),NIL);
666 
667  init_subr_2("fread",lfread,
668   "(fread BUFFER FILE)\n\
669   BUFFER is a string of length N, N bytes are read from FILE into\n\
670   BUFFER.");
671  init_subr_2("fwrite",lfwrite,
672   "(fwrite BUFFER FILE)\n\
673   Write BUFFER into FILE.");
674 
675  init_subr_0("read",lread,
676  "(read)\n\
677   Read next s-expression from stdin and return it.");
678  init_subr_0("eof-val",get_eof_val,
679  "(eof_val)\n\
680   Returns symbol used to indicate end of file.  May be used (with eq?)\n\
681   to determine when end of file occurs while reading files.");
682  init_subr_1("print",lprint,
683  "(print DATA)\n\
684   Print DATA to stdout if textual form.  Not a pretty printer.");
685  init_subr_2("pprintf",siod_pprintf,
686  "(pprintf EXP [FD])\n\
687  Pretty print EXP to FD, if FD is nil print to the screen.");
688  init_subr_2("printfp",lprintfp,
689  "(printfp DATA FILEP)\n\
690   Print DATA to file indicated by file pointer FILEP.  File pointers are\n\
691   are created by fopen.");
692  init_subr_1("readfp",lreadfp,
693  "(readfp FILEP)\n\
694   Read and return next s-expression from file indicated by file pointer\n\
695   FILEP.  File pointers are created by fopen.");
696  init_subr_1("terpri",terpri,
697  "(terpri FILEP)\n\
698   Print newline to FILEP, is FILEP is nil or not specified a newline it\n\
699   is printed to stdout.");
700  init_subr_1("fflush",fflush_l,
701  "(fflush FILEP)\n\
702   Flush FILEP. If FILEP is nil, then flush stdout.");
703  init_subr_2("fopen",fopen_l,
704  "(fopen FILENAME HOW)\n\
705   Return file pointer for FILENAME opened in mode HOW.");
706  init_subr_1("fclose",fclose_l,
707  "(fclose FILEP)\n\
708   Close filepoint FILEP.");
709  init_subr_1("getc",lgetc,
710  "(getc FILEP)\n\
711   Get next character from FILEP.  Character is returned as a number. If\n\
712   FILEP is nil, or not specified input comes from stdin.");
713  init_subr_2("putc",lputc,
714  "(putc ECHAR FILEP)\n\
715   Put ECHAR (a number) as a character to FILEP.  If FILEP is nil or not\n\
716   specified output goes to stdout.");
717  init_subr_2("puts",lputs,
718  "(puts STRING FILEP)\n\
719   Write STRING (print name of symbol) to FILEP.  If FILEP is nil or not\n\
720   specified output goes to stdout.");
721  init_subr_1("ftell",lftell,
722  "(ftell FILEP)\n\
723   Returns position in file FILEP is currently pointing at.");
724  init_subr_3("fseek",lfseek,
725  "(fseek FILEP OFFSET DIRECTION)\n\
726   Position FILEP to OFFSET. If DIRECTION is 0 offset is from start of file.\n\
727   If DIRECTION is 1, offset is from current position.  If DIRECTION is\n\
728   2 offset is from end of file.");
729  init_subr_1("probe_file",probe_file,
730  "(probe_file FILENAME)\n\
731   Returns t if FILENAME exists and is readable, nil otherwise.");
732  init_subr_1("delete-file",lunlink,
733  "(delete-file FILENAME)\n\
734   Delete named file.");
735  init_subr_2("load",load,
736  "(load FILENAME OPTION)\n\
737   Load s-expressions in FILENAME.  If OPTION is nil or unspecified evaluate\n\
738   each s-expression in FILENAME as it is read, if OPTION is t, return them\n\
739   unevaluated in a list.");
740 
741  init_subr_2("directory-entries", directory_entries,
742  "(directory-entries DIRECTORY &opt NOFLAGDIR)\n\
743   Return a list of the entries in the directory. If NOFLAGDIR is non-null\n\
744   don't check to see which are directories.");
745 
746  init_subr_3("save-forms",save_forms,
747  "(save-forms FILENAME FORMS HOW)\n\
748   Save FORMS in FILENAME.  If HOW is a appending FORMS to FILENAME,\n\
749   or if HOW is w start from the beginning of FILENAME.");
750 }
751