14#include "EST_Pathname.h"
33 fprintf(fd,
"%s",(
const char *)siod_sprint(
exp));
38 fprintf(fd,
"%s",(
const char *)p);
47 pprintf(fd,car(
exp),
indent,width,depth-1,length);
48 for (
ll=length,l=cdr(
exp); l != NIL; l=cdr(l),
ll--)
55 pprintf(fd,rintern(
"..."),
indent,width,
61 fprintf(fd,
" . %s",(
const char *)siod_sprint(l));
65 pprintf(fd,car(l),
indent,width,depth-1,length);
75 pprintf(fd,
exp,0,72,-1,-1);
84 (equal(
file,rintern(
"t"))))
105 else if NTYPEP(p,tc_c_file)
108 fflush(p->storage_as.c_file.f);
124 siod_string_print(car(
exp),
sd);
128 siod_string_print(car(
tmp),
sd);
133 siod_string_print(
tmp,
sd);
138 if (FLONMPNAME(
exp) == NULL)
141 FLONMPNAME(
exp) = (
char *)must_malloc(
strlen(tkbuffer)+1);
149 for (i=0;
exp->storage_as.string.data[i] !=
'\0'; i++)
151 if (
exp->storage_as.string.data[i] ==
'"')
153 if (
exp->storage_as.string.data[i] ==
'\\')
155 sprintf(tkbuffer,
"%c",
exp->storage_as.string.data[i]);
173 sd += (*exp).storage_as.subr.name;
177 sprintf(tkbuffer,
"#<FILE %p ",(
void *)
exp->storage_as.c_file.f);
179 if (
exp->storage_as.c_file.name)
180 sd +=
exp->storage_as.c_file.name;
185 siod_string_print(car((*exp).storage_as.closure.code),
sd);
187 siod_string_print(cdr((*exp).storage_as.closure.code),
sd);
192 p = get_user_type_hooks(TYPE(
exp));
194 (*p->print_string)(
exp, tkbuffer);
198 sprintf(tkbuffer,
"#<%s %p>",p->name,(
void *)
exp);
212 siod_string_print(
exp,r);
218static LISP fd_to_scheme_file(
int fd,
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;
231 open_files = cons(
sym,open_files);
232 sym->storage_as.c_file.name = (
char *) must_malloc(
strlen(name)+1);
245 err(
"could not open file", name);
247 strcpy(
sym->storage_as.c_file.name,name);
252LISP fopen_c(
const char *name,
const char *
how)
257 fd = fd_open_file(name,
how);
260 err(
"could not open file", name);
262 sym = fd_to_scheme_file(fd, name,
how, 1);
267LISP siod_fdopen_c(
int fd,
const char *name,
char *
how)
269 return fd_to_scheme_file(fd, name,
how, 0);
275 const char *filename = NULL;
280 fd = fd_open_stdinout(
r_or_w);
282 else if (SYMBOLP(
what) || STRINGP(
what))
284 fd = fd_open_file((filename = get_c_string(
what)),
r_or_w);
286 else if (LIST1P(
what))
288 fd = fd_open_file((filename = get_c_string(CAR(
what))),
r_or_w);
290 else if (CONSP(
what) && !CONSP(CDR(
what)))
292 filename =
"[tcp connection]";
293 fd = fd_open_url(
"tcp",
294 get_c_string(CAR(
what)),
295 get_c_string(CDR(
what)),
299 else if (LIST4P(
what))
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)),
309 err(
"not openable",
what);
312 err(
"can't open",
what);
314 return fd_to_scheme_file(fd, filename,
r_or_w, 1);
317static 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;}}
329 flag = no_interrupt(1);
330 if NTYPEP(p,tc_c_file) err(
"not a file",p);
332 open_files = delq(p,open_files);
336static void file_prin1(
LISP ptr,
FILE *f)
338 name = ptr->storage_as.c_file.name;
339 fput_st(f,
"#<FILE ");
340 sprintf(tkbuffer,
" %p",(
void *)ptr->storage_as.c_file.f);
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);}
355 i = f_getc(get_c_file(p,
stdin));
356 return((i ==
EOF) ? NIL : flocons((
double)i));}
366 i = *get_c_string(c);
367 flag = no_interrupt(1);
373{fput_st(get_c_file(p,
stdout),get_c_string(str));
377{
return(flocons((
double)
ftell(get_c_file(
file,NULL))));}
396 for(item=entries.head(); item; item = item->next())
411 const char *
r_or_w = NULLP(
how) ?
"rb" : get_c_string(
how);
422 f = get_c_file(
file,NULL);
423 flag = no_interrupt(1);
424 if TYPEP(size,tc_string)
426 buffer = s->storage_as.string.data;
427 n = s->storage_as.string.dim;
430 {n = get_c_int(size);
431 buffer = (
char *) must_malloc(n+1);
434 ret = fread(buffer,1,n,f);
444 s->storage_as.string.data = buffer;
445 s->storage_as.string.dim = n;}
447 {s = strcons(
ret,NULL);
448 memcpy(s->storage_as.string.data,buffer,
ret);
453 return(flocons((
double)
ret));}
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);
482 {fput_st(f,
" ");lprin1f(car(
tmp),f);}
483 if NNULLP(
tmp) {fput_st(f,
" . ");lprin1f(
tmp,f);}
487 if (FLONMPNAME(
exp) == NULL)
490 FLONMPNAME(
exp) = (
char *)must_malloc(
strlen(tkbuffer)+1);
497 fput_st(f,PNAME(
exp));
509 fput_st(f,(*exp).storage_as.subr.name);
513 fput_st(f,
"#<CLOSURE ");
514 lprin1f(car((*exp).storage_as.closure.code),f);
516 lprin1f(cdr((*exp).storage_as.closure.code),f);
520 p = get_user_type_hooks(TYPE(
exp));
526 sprintf(tkbuffer,
"#<%s %p>",p->name,USERVAL(
exp));
529 fput_st(f,tkbuffer);}}
544{
return(vload(get_c_string(
fname),NULLP(
cflag) ? 0 : 1));}
552{
return(lreadf(
stdin));}
554LISP get_eof_val(
void)
560 const char *filename;
562 filename = get_c_string(
fname);
563 if (access(filename,R_OK) == 0)
571 unlink(get_c_string(name));
577 const char *
chow = NULL;
582 else if EQ(
how,cintern(
"a"))
chow = "a";
585 fput_st(fwarn,"
forms to ");
586 fput_st(fwarn,
cname);
589 f =
lf->storage_as.c_file.f;
594 fput_st(fwarn,
"done.\n");
597void close_open_files_upto(
LISP end)
599 for(l=open_files;((l!=end)&&(l!=NIL));l=cdr(l))
601 if (p->storage_as.c_file.f)
603 (p->storage_as.c_file.name) ? p->storage_as.c_file.name :
"");
608void close_open_files(
void)
610 close_open_files_upto(NIL);
613static void check_first_line(
FILE *
lf)
618 if ((c1 =
getc(
lf)) ==
'!')
619 while (((c2=
getc(
lf)) !=
'\n') && (c2 !=
EOF));
635 fput_st(fwarn,
"loading ");
636 fput_st(fwarn,
fname);
639 f =
lf->storage_as.c_file.f;
646 if EQ(
form,eof_val)
break;
650 result = tail =
form;
652 tail = setcdr(tail,
form);}
656 fput_st(fwarn,
"done.\n");
659void init_subrs_file(
void)
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);
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\
671 init_subr_2(
"fwrite",lfwrite,
672 "(fwrite BUFFER FILE)\n\
673 Write BUFFER into FILE.");
675 init_subr_0(
"read",lread,
677 Read next s-expression from stdin and return it.");
678 init_subr_0(
"eof-val",get_eof_val,
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,
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,
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,
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,
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,
708 Close filepoint FILEP.");
709 init_subr_1(
"getc",lgetc,
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,
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.");
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.");
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.");
int length(void) const
Length of string ({not} length of underlying chunk)