/* Helper function, primarily for use with the xt module */ LispObj * Lisp_PipeBroken(LispBuiltin *builtin) /* pipe-broken pipe-stream */ { int pid, status, retval; LispObj *result = NIL; LispObj *pipe_stream; pipe_stream = ARGUMENT(0); if (!STREAMP(pipe_stream) || pipe_stream->data.stream.type != LispStreamPipe) LispDestroy("%s: %s is not a pipe stream", STRFUN(builtin), STROBJ(pipe_stream)); if ((pid = PIDPSTREAMP(pipe_stream)) > 0) { retval = waitpid(pid, &status, WNOHANG | WUNTRACED); if (retval == pid || (retval == -1 && errno == ECHILD)) result = T; } return (result); }
LispObj * Lisp_DeleteFile(LispBuiltin *builtin) /* delete-file filename */ { GC_ENTER(); LispObj *filename; filename = ARGUMENT(0); if (STRINGP(filename)) { filename = APPLY1(Oparse_namestring, filename); GC_PROTECT(filename); } else if (STREAMP(filename)) { if (filename->data.stream.type != LispStreamFile) LispDestroy("%s: %s is not a FILE-STREAM", STRFUN(builtin), STROBJ(filename)); filename = filename->data.stream.pathname; } else { CHECK_PATHNAME(filename); } GC_LEAVE(); return (LispUnlink(THESTR(CAR(filename->data.pathname))) ? NIL : T); }
LispObj * Lisp_GetOutputStreamString(LispBuiltin *builtin) /* get-output-stream-string string-output-stream */ { int length; char *string; LispObj *string_output_stream, *result; string_output_stream = ARGUMENT(0); if (!STREAMP(string_output_stream) || string_output_stream->data.stream.type != LispStreamString || string_output_stream->data.stream.readable || !string_output_stream->data.stream.writable) LispDestroy("%s: %s is not an output string stream", STRFUN(builtin), STROBJ(string_output_stream)); string = LispGetSstring(SSTREAMP(string_output_stream), &length); result = LSTRING(string, length); /* reset string */ SSTREAMP(string_output_stream)->output = SSTREAMP(string_output_stream)->length = SSTREAMP(string_output_stream)->column = 0; return (result); }
LispObj * Lisp_RenameFile(LispBuiltin *builtin) /* rename-file filename new-name */ { int code; GC_ENTER(); char *from, *to; LispObj *old_truename, *new_truename; LispObj *filename, *new_name; new_name = ARGUMENT(1); filename = ARGUMENT(0); if (STRINGP(filename)) { filename = APPLY1(Oparse_namestring, filename); GC_PROTECT(filename); } else if (STREAMP(filename)) { if (filename->data.stream.type != LispStreamFile) LispDestroy("%s: %s is not a FILE-STREAM", STRFUN(builtin), STROBJ(filename)); filename = filename->data.stream.pathname; } else { CHECK_PATHNAME(filename); } old_truename = APPLY1(Otruename, filename); GC_PROTECT(old_truename); if (STRINGP(new_name)) { new_name = APPLY3(Oparse_namestring, new_name, NIL, filename); GC_PROTECT(new_name); } else { CHECK_PATHNAME(new_name); } from = THESTR(CAR(filename->data.pathname)); to = THESTR(CAR(new_name->data.pathname)); code = LispRename(from, to); if (code) LispDestroy("%s: rename(%s, %s): %s", STRFUN(builtin), from, to, strerror(errno)); GC_LEAVE(); new_truename = APPLY1(Otruename, new_name); RETURN_COUNT = 2; RETURN(0) = old_truename; RETURN(1) = new_truename; return (new_name); }
LispObj * Lisp_Streamp(LispBuiltin *builtin) /* streamp object */ { LispObj *object; object = ARGUMENT(0); return (STREAMP(object) ? T : NIL); }
/* Helper function, so that it is not required to redirect error output */ LispObj * Lisp_PipeErrorStream(LispBuiltin *builtin) /* pipe-error-stream pipe-stream */ { LispObj *pipe_stream; pipe_stream = ARGUMENT(0); if (!STREAMP(pipe_stream) || pipe_stream->data.stream.type != LispStreamPipe) LispDestroy("%s: %s is not a pipe stream", STRFUN(builtin), STROBJ(pipe_stream)); return (pipe_stream->data.stream.source.program->errorp); }
/* Helper function, primarily for use with the xt module */ LispObj * Lisp_PipeErrorDescriptor(LispBuiltin *builtin) /* pipe-error-descriptor pipe-stream */ { LispObj *pipe_stream; pipe_stream = ARGUMENT(0); if (!STREAMP(pipe_stream) || pipe_stream->data.stream.type != LispStreamPipe) LispDestroy("%s: %s is not a pipe stream", STRFUN(builtin), STROBJ(pipe_stream)); if (!EPSTREAMP(pipe_stream)) LispDestroy("%s: pipe %s is closed", STRFUN(builtin), STROBJ(pipe_stream)); return (INTEGER(LispFileno(EPSTREAMP(pipe_stream)))); }
/* Helper function, primarily for use with the xt module */ LispObj * Lisp_PipeInputDescriptor(LispBuiltin *builtin) /* pipe-input-descriptor pipe-stream */ { LispObj *pipe_stream; pipe_stream = ARGUMENT(0); if (!STREAMP(pipe_stream) || pipe_stream->data.stream.type != LispStreamPipe) LispDestroy("%s: %s is not a pipe stream", STRFUN(builtin), STROBJ(pipe_stream)); if (!IPSTREAMP(pipe_stream)) LispDestroy("%s: pipe %s is unreadable", STRFUN(builtin), STROBJ(pipe_stream)); return (INTEGER(LispFileno(IPSTREAMP(pipe_stream)))); }
void LispPushInput(LispObj *stream) { if (!STREAMP(stream) || !stream->data.stream.readable) LispDestroy("bad stream at PUSH-INPUT"); lisp__data.input_list = CONS(stream, lisp__data.input_list); SINPUT = stream; if (lisp__data.iunget + 1 == lisp__data.nunget) { LispUngetInfo **info = realloc(lisp__data.unget, sizeof(LispUngetInfo) * (lisp__data.nunget + 1)); if (!info || (info[lisp__data.nunget] = calloc(1, sizeof(LispUngetInfo))) == NULL) LispDestroy("out of memory"); lisp__data.unget = info; ++lisp__data.nunget; } ++lisp__data.iunget; memset(lisp__data.unget[lisp__data.iunget], '\0', sizeof(LispUngetInfo)); lisp__data.eof = 0; }
LispObj * Lisp_Open(LispBuiltin *builtin) /* open filename &key direction element-type if-exists if-does-not-exist external-format */ { GC_ENTER(); char *string; LispObj *stream = NIL; int mode, flags, direction, exist, noexist, file_exist; LispFile *file; LispObj *filename, *odirection, *element_type, *if_exists, *if_does_not_exist, *external_format; external_format = ARGUMENT(5); if_does_not_exist = ARGUMENT(4); if_exists = ARGUMENT(3); element_type = ARGUMENT(2); odirection = ARGUMENT(1); filename = ARGUMENT(0); if (STRINGP(filename)) { filename = APPLY1(Oparse_namestring, filename); GC_PROTECT(filename); } else if (STREAMP(filename)) { if (filename->data.stream.type != LispStreamFile) LispDestroy("%s: %s is not a FILE-STREAM", STRFUN(builtin), STROBJ(filename)); filename = filename->data.stream.pathname; } else { CHECK_PATHNAME(filename); } if (odirection != UNSPEC) { direction = -1; if (KEYWORDP(odirection)) { if (odirection == Kprobe) direction = DIR_PROBE; else if (odirection == Kinput) direction = DIR_INPUT; else if (odirection == Koutput) direction = DIR_OUTPUT; else if (odirection == Kio) direction = DIR_IO; } if (direction == -1) LispDestroy("%s: bad :DIRECTION %s", STRFUN(builtin), STROBJ(odirection)); } else direction = DIR_INPUT; if (element_type != UNSPEC) { /* just check argument... */ if (SYMBOLP(element_type) && ATOMID(element_type) == Scharacter) ; /* do nothing */ else if (KEYWORDP(element_type) && ATOMID(element_type) == Sdefault) ; /* do nothing */ else LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s", STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type)); } if (if_exists != UNSPEC) { exist = -1; if (if_exists == NIL) exist = EXT_NIL; else if (KEYWORDP(if_exists)) { if (if_exists == Kerror) exist = EXT_ERROR; else if (if_exists == Knew_version) exist = EXT_NEW_VERSION; else if (if_exists == Krename) exist = EXT_RENAME; else if (if_exists == Krename_and_delete) exist = EXT_RENAME_DELETE; else if (if_exists == Koverwrite) exist = EXT_OVERWRITE; else if (if_exists == Kappend) exist = EXT_APPEND; else if (if_exists == Ksupersede) exist = EXT_SUPERSEDE; } if (exist == -1) LispDestroy("%s: bad :IF-EXISTS %s", STRFUN(builtin), STROBJ(if_exists)); } else exist = EXT_ERROR; if (if_does_not_exist != UNSPEC) { noexist = -1; if (if_does_not_exist == NIL) noexist = NOEXT_NIL; if (KEYWORDP(if_does_not_exist)) { if (if_does_not_exist == Kerror) noexist = NOEXT_ERROR; else if (if_does_not_exist == Kcreate) noexist = NOEXT_CREATE; } if (noexist == -1) LispDestroy("%s: bad :IF-DOES-NO-EXISTS %s", STRFUN(builtin), STROBJ(if_does_not_exist)); } else noexist = direction != DIR_INPUT ? NOEXT_NOTHING : NOEXT_ERROR; if (external_format != UNSPEC) { /* just check argument... */ if (SYMBOLP(external_format) && ATOMID(external_format) == Scharacter) ; /* do nothing */ else if (KEYWORDP(external_format) && ATOMID(external_format) == Sdefault) ; /* do nothing */ else LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s", STRFUN(builtin), Sdefault, Scharacter, STROBJ(external_format)); } /* string representation of pathname */ string = THESTR(CAR(filename->data.pathname)); mode = 0; file_exist = access(string, F_OK) == 0; if (file_exist) { if (exist == EXT_NIL) { GC_LEAVE(); return (NIL); } } else { if (noexist == NOEXT_NIL) { GC_LEAVE(); return (NIL); } if (noexist == NOEXT_ERROR) LispDestroy("%s: file %s does not exist", STRFUN(builtin), STROBJ(CAR(filename->data.quote))); else if (noexist == NOEXT_CREATE) { LispFile *tmp = LispFopen(string, FILE_WRITE); if (tmp) LispFclose(tmp); else LispDestroy("%s: cannot create file %s", STRFUN(builtin), STROBJ(CAR(filename->data.quote))); } } if (direction == DIR_OUTPUT || direction == DIR_IO) { if (file_exist) { if (exist == EXT_ERROR) LispDestroy("%s: file %s already exists", STRFUN(builtin), STROBJ(CAR(filename->data.quote))); if (exist == EXT_RENAME) { /* Add an ending '~' at the end of the backup file */ char tmp[PATH_MAX + 1]; strcpy(tmp, string); if (strlen(tmp) + 1 > PATH_MAX) LispDestroy("%s: backup name for %s too long", STRFUN(builtin), STROBJ(CAR(filename->data.quote))); strcat(tmp, "~"); if (rename(string, tmp)) LispDestroy("%s: rename: %s", STRFUN(builtin), strerror(errno)); mode |= FILE_WRITE; } else if (exist == EXT_OVERWRITE) mode |= FILE_WRITE; else if (exist == EXT_APPEND) mode |= FILE_APPEND; } else mode |= FILE_WRITE; if (direction == DIR_IO) mode |= FILE_IO; } else mode |= FILE_READ; file = LispFopen(string, mode); if (file == NULL) LispDestroy("%s: open: %s", STRFUN(builtin), strerror(errno)); flags = 0; if (direction == DIR_PROBE) { LispFclose(file); file = NULL; } else { if (direction == DIR_INPUT || direction == DIR_IO) flags |= STREAM_READ; if (direction == DIR_OUTPUT || direction == DIR_IO) flags |= STREAM_WRITE; } stream = FILESTREAM(file, filename, flags); GC_LEAVE(); return (stream); }