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_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_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); }
dylan_value Kspy_invoke_dylan_under_coded_restartVKiMM0I (dylan_value interactor_level_, dylan_value func_, dylan_value arguments_) { volatile dylan_value T4; volatile dylan_value new_level_; volatile dylan_value Pold_valueP_; volatile dylan_value T7; volatile dylan_value exitPexit_37_; volatile dylan_value T9; volatile dylan_value Uoriginal_handlersU_; volatile dylan_value T11; volatile dylan_value T12; volatile dylan_value T13; volatile dylan_value T14; volatile DWORD T15; volatile dylan_value T16; volatile DWORD T17; volatile DWORD T18; volatile dylan_value T19; volatile _KLsimple_object_vectorGVKd_1 T20 = {&KLsimple_object_vectorGVKdW, (dylan_value) 5}; volatile dylan_value T21; volatile _KLsimple_object_vectorGVKd_4 T22 = {&KLsimple_object_vectorGVKdW, (dylan_value) 17}; volatile dylan_value T23; volatile dylan_value T24_0; volatile _KLsimple_object_vectorGVKd_8 T25 = {&KLsimple_object_vectorGVKdW, (dylan_value) 33}; volatile dylan_value T26; volatile dylan_value T27; volatile dylan_value T28; // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:188 // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:192 T15 = primitive_cast_integer_as_raw(interactor_level_); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:192 T16 = primitive_machine_word_less_thanQ(T15,1); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:192 if (T16 != &KPfalseVKi) { // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:193 T4 = primitive_read_thread_variable(Tcurrent_interactor_levelTVKi); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:193 T17 = primitive_cast_integer_as_raw(T4); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:193 T18 = primitive_machine_word_add_signal_overflow(T17,4); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:193 T19 = primitive_cast_raw_as_integer(T18); new_level_ = T19; } else { new_level_ = interactor_level_; } // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:192 // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:196 Pold_valueP_ = primitive_read_thread_variable(Tcurrent_interactor_levelTVKi); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:196 ENTER_UNWIND_FRAME(T7); if (!nlx_setjmp(FRAME_DEST(T7))) { // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:196 primitive_write_thread_variable(Tcurrent_interactor_levelTVKi, new_level_); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:197 ENTER_EXIT_FRAME(exitPexit_37_); if (nlx_setjmp(FRAME_DEST(exitPexit_37_))) { T14 = FRAME_RETVAL(exitPexit_37_); } else { // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:203 Uoriginal_handlersU_ = primitive_read_thread_variable(Tcurrent_handlersTVKi); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:203 ENTER_UNWIND_FRAME(T11); if (!nlx_setjmp(FRAME_DEST(T11))) { // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:207 T12 = MAKE_CLOSURE_INITD(&Kanonymous_of_spy_invoke_dylan_under_coded_restartF33, 1, exitPexit_37_); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:206 T20.vector_element_[0] = new_level_; // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:206 T21 = primitive_copy_vector(&T20); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:205 T22.vector_element_[0] = &KJformat_string_; T22.vector_element_[1] = &K32; T22.vector_element_[2] = &KJformat_arguments_; T22.vector_element_[3] = T21; // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:205 T23 = primitive_copy_vector(&T22); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:203 T25.vector_element_[0] = &KJtype_; T25.vector_element_[1] = &KLabortGVKd; T25.vector_element_[2] = &KJfunction_; T25.vector_element_[3] = T12; T25.vector_element_[4] = &KJtest_; T25.vector_element_[5] = &KPfalseVKi; T25.vector_element_[6] = &KJinit_arguments_; T25.vector_element_[7] = T23; // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:203 T24_0 = KLhandlerGZ32ZconstructorVKiMM0I(&KLhandlerGVKi, &T25, &KLabortGVKd, T12, &KPfalseVKi, T23); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:203 T26 = T24_0; // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:203 T13 = primitive_read_thread_variable(Tcurrent_handlersTVKi); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:203 T27 = primitive_object_allocate_filled(3,&KLpairGVKdW,2,&KPunboundVKi,0,0,&KPunboundVKi); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:203 SLOT_VALUE_SETTER(T26, T27, 0); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:203 SLOT_VALUE_SETTER(T13, T27, 1); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:203 primitive_write_thread_variable(Tcurrent_handlersTVKi, T27); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:211 T28 = APPLY1(func_, arguments_); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:203 FALL_THROUGH_UNWIND(T28); } // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:203 primitive_write_thread_variable(Tcurrent_handlersTVKi, Uoriginal_handlersU_); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:203 CONTINUE_UNWIND(); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:197 T14 = T28; /* invalidate exitPexit_37_ */ } // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:197 // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:196 FALL_THROUGH_UNWIND(T14); } // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:196 primitive_write_thread_variable(Tcurrent_interactor_levelTVKi, Pold_valueP_); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:196 CONTINUE_UNWIND(); // /opt/opendylan-2014.1/sources/dylan/dylan-spy.dylan:188 return(T14); }