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_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); }
/* XXX preserve-whitespace is being ignored */ LispObj * Lisp_ReadFromString(LispBuiltin *builtin) /* read-from-string string &optional eof-error-p eof-value &key start end preserve-whitespace */ { GC_ENTER(); char *string; LispObj *stream, *result; long length, start, end, bytes_read; LispObj *ostring, *eof_error_p, *eof_value, *ostart, *oend; oend = ARGUMENT(4); ostart = ARGUMENT(3); eof_value = ARGUMENT(2); eof_error_p = ARGUMENT(1); ostring = ARGUMENT(0); CHECK_STRING(ostring); string = THESTR(ostring); LispCheckSequenceStartEnd(builtin, ostring, ostart, oend, &start, &end, &length); if (start > 0 || end < length) length = end - start; stream = LSTRINGSTREAM(string + start, STREAM_READ, length); if (eof_value == UNSPEC) eof_value = NIL; LispPushInput(stream); result = LispRead(); /* stream->data.stream.source.string->input is * the offset of the last byte read in string */ bytes_read = stream->data.stream.source.string->input; LispPopInput(stream); if (result == NULL) { if (eof_error_p == NIL) result = eof_value; else LispDestroy("%s: unexpected end of input", STRFUN(builtin)); } GC_PROTECT(result); RETURN(0) = FIXNUM(start + bytes_read); RETURN_COUNT = 1; GC_LEAVE(); return (result); }
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); }
LispObj * Lisp_Reexec(LispBuiltin *builtin) /* re-exec regex string &key count start end notbol noteol */ { size_t nmatch; re_mat match[10]; long start, end, length; int code, cflags, eflags; char *string; LispObj *result; re_cod *regexp; LispObj *regex, *ostring, *count, *ostart, *oend, *notbol, *noteol; noteol = ARGUMENT(6); notbol = ARGUMENT(5); oend = ARGUMENT(4); ostart = ARGUMENT(3); count = ARGUMENT(2); ostring = ARGUMENT(1); regex = ARGUMENT(0); if (STRINGP(regex)) regexp = LispRecomp(builtin, THESTR(regex), cflags = 0); else { CHECK_REGEX(regex); regexp = regex->data.regex.regex; cflags = regex->data.regex.options; } CHECK_STRING(ostring); if (count == UNSPEC) nmatch = 1; else { CHECK_INDEX(count); nmatch = FIXNUM_VALUE(count); if (nmatch > 10) LispDestroy("%s: COUNT cannot be larger than 10", STRFUN(builtin)); } if (nmatch && (cflags & RE_NOSUB)) nmatch = 1; eflags = RE_STARTEND; if (notbol != UNSPEC && notbol != NIL) eflags |= RE_NOTBOL; if (noteol != UNSPEC && noteol != NIL) eflags |= RE_NOTEOL; string = THESTR(ostring); LispCheckSequenceStartEnd(builtin, ostring, ostart, oend, &start, &end, &length); match[0].rm_so = start; match[0].rm_eo = end; code = reexec(regexp, string, nmatch, &match[0], eflags); if (code == 0) { if (nmatch && match[0].rm_eo >= match[0].rm_so) { result = CONS(CONS(FIXNUM(match[0].rm_so), FIXNUM(match[0].rm_eo)), NIL); if (nmatch > 1 && match[1].rm_eo >= match[1].rm_so) { int i; GC_ENTER(); LispObj *cons = result; GC_PROTECT(result); for (i = 1; i < nmatch && match[i].rm_eo >= match[i].rm_so; i++) { RPLACD(cons, CONS(CONS(FIXNUM(match[i].rm_so), FIXNUM(match[i].rm_eo)), NIL)); cons = CDR(cons); } GC_LEAVE(); } } else result = NIL; } else result = Knomatch; /* Maybe shoud cache compiled regex, but better the caller do it */ if (!XREGEXP(regex)) { refree(regexp); LispFree(regexp); } return (result); }
LispObj * Lisp_ParseInteger(LispBuiltin *builtin) /* parse-integer string &key start end radix junk-allowed */ { GC_ENTER(); char *ptr, *string; int character, junk, sign, overflow; long i, start, end, radix, length, integer, check; LispObj *result; LispObj *ostring, *ostart, *oend, *oradix, *junk_allowed; junk_allowed = ARGUMENT(4); oradix = ARGUMENT(3); oend = ARGUMENT(2); ostart = ARGUMENT(1); ostring = ARGUMENT(0); start = end = radix = 0; result = NIL; CHECK_STRING(ostring); LispCheckSequenceStartEnd(builtin, ostring, ostart, oend, &start, &end, &length); string = THESTR(ostring); if (oradix == UNSPEC) radix = 10; else { CHECK_INDEX(oradix); radix = FIXNUM_VALUE(oradix); } if (radix < 2 || radix > 36) LispDestroy("%s: :RADIX %ld must be in the range 2 to 36", STRFUN(builtin), radix); integer = check = 0; ptr = string + start; sign = overflow = 0; /* Skip leading white spaces */ for (i = start; i < end && *ptr && isspace(*ptr); ptr++, i++) ; /* Check for sign specification */ if (i < end && (*ptr == '-' || *ptr == '+')) { sign = *ptr == '-'; ++ptr; ++i; } for (junk = 0; i < end; i++, ptr++) { character = *ptr; if (islower(character)) character = toupper(character); if (character >= '0' && character <= '9') { if (character - '0' >= radix) junk = 1; else { check = integer; integer = integer * radix + character - '0'; } } else if (character >= 'A' && character <= 'Z') { if (character - 'A' + 10 >= radix) junk = 1; else { check = integer; integer = integer * radix + character - 'A' + 10; } } else { if (isspace(character)) break; junk = 1; } if (junk) break; if (!overflow && check > integer) overflow = 1; /* keep looping just to count read bytes */ } if (!junk) /* Skip white spaces */ for (; i < end && *ptr && isspace(*ptr); ptr++, i++) ; if ((junk || ptr == string) && (junk_allowed == UNSPEC || junk_allowed == NIL)) LispDestroy("%s: %s has a bad integer representation", STRFUN(builtin), STROBJ(ostring)); else if (ptr == string) result = NIL; else if (overflow) { mpi *bigi = LispMalloc(sizeof(mpi)); char *str; length = end - start + sign; str = LispMalloc(length + 1); strncpy(str, string - sign, length + sign); str[length + sign] = '\0'; mpi_init(bigi); mpi_setstr(bigi, str, radix); LispFree(str); result = BIGNUM(bigi); } else result = INTEGER(sign ? -integer : integer); GC_PROTECT(result); RETURN(0) = FIXNUM(i); RETURN_COUNT = 1; GC_LEAVE(); return (result); }