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);
}
