void Fset_elt(CL_FORM *base)
{
if(CL_CONSP(ARG(1)))
{
COPY(ARG(2), ARG(3));
COPY(ARG(1), ARG(4));
Fnthcdr(ARG(3));
if(CL_CONSP(ARG(3)))
{
COPY(ARG(0), GET_CAR(ARG(3)));
}
else
{
LOAD_SMSTR((CL_FORM *)&KClisp[252], ARG(0)); /* ~a is not a cons */
COPY(ARG(3), ARG(1));
Ferror(ARG(0), 2);
}
}
else
{
LOAD_BOOL(CL_SMVECP(ARG(1)), ARG(3));
if(CL_TRUEP(ARG(3)))
{
goto THEN1;
}
else
{
COPY(ARG(1), ARG(4));
LOAD_SYMBOL(SYMBOL(Slisp, 150), ARG(5)); /* COMPLEX-VECTOR */
rt_struct_typep(ARG(4));
}
if(CL_TRUEP(ARG(4)))
{
THEN1:;
Fset_row_major_aref(ARG(0));
}
else
{
COPY(SYMVAL(Slisp, 58), ARG(0)); /* WRONG_TYPE */
LOAD_SYMBOL(SYMBOL(Slisp, 36), ARG(2)); /* SEQUENCE */
Ferror(ARG(0), 3);
}
}
}
/* This compares two directory listings in case of a `write' event for
a directory. Generate resulting file notification events. The old
directory listing is retrieved from watch_object, it will be
replaced by the new directory listing at the end of this
function. */
static void
kqueue_compare_dir_list
(Lisp_Object watch_object)
{
Lisp_Object dir, pending_dl, deleted_dl;
Lisp_Object old_directory_files, old_dl, new_directory_files, new_dl, dl;
dir = XCAR (XCDR (watch_object));
pending_dl = Qnil;
deleted_dl = Qnil;
old_directory_files = Fnth (make_number (4), watch_object);
old_dl = kqueue_directory_listing (old_directory_files);
/* When the directory is not accessible anymore, it has been deleted. */
if (NILP (Ffile_directory_p (dir))) {
kqueue_generate_event (watch_object, Fcons (Qdelete, Qnil), dir, Qnil);
return;
}
new_directory_files =
directory_files_internal (dir, Qnil, Qnil, Qnil, 1, Qnil);
new_dl = kqueue_directory_listing (new_directory_files);
/* Parse through the old list. */
dl = old_dl;
while (1) {
Lisp_Object old_entry, new_entry, dl1;
if (NILP (dl))
break;
/* Search for an entry with the same inode. */
old_entry = XCAR (dl);
new_entry = assq_no_quit (XCAR (old_entry), new_dl);
if (! NILP (Fequal (old_entry, new_entry))) {
/* Both entries are identical. Nothing to do. */
new_dl = Fdelq (new_entry, new_dl);
goto the_end;
}
/* Both entries have the same inode. */
if (! NILP (new_entry)) {
/* Both entries have the same file name. */
if (strcmp (SSDATA (XCAR (XCDR (old_entry))),
SSDATA (XCAR (XCDR (new_entry)))) == 0) {
/* Modification time has been changed, the file has been written. */
if (NILP (Fequal (Fnth (make_number (2), old_entry),
Fnth (make_number (2), new_entry))))
kqueue_generate_event
(watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (old_entry)), Qnil);
/* Status change time has been changed, the file attributes
have changed. */
if (NILP (Fequal (Fnth (make_number (3), old_entry),
Fnth (make_number (3), new_entry))))
kqueue_generate_event
(watch_object, Fcons (Qattrib, Qnil),
XCAR (XCDR (old_entry)), Qnil);
} else {
/* The file has been renamed. */
kqueue_generate_event
(watch_object, Fcons (Qrename, Qnil),
XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry)));
deleted_dl = Fcons (new_entry, deleted_dl);
}
new_dl = Fdelq (new_entry, new_dl);
goto the_end;
}
/* Search, whether there is a file with the same name but another
inode. */
for (dl1 = new_dl; ! NILP (dl1); dl1 = XCDR (dl1)) {
new_entry = XCAR (dl1);
if (strcmp (SSDATA (XCAR (XCDR (old_entry))),
SSDATA (XCAR (XCDR (new_entry)))) == 0) {
pending_dl = Fcons (new_entry, pending_dl);
new_dl = Fdelq (new_entry, new_dl);
goto the_end;
}
}
/* Check, whether this a pending file. */
new_entry = assq_no_quit (XCAR (old_entry), pending_dl);
if (NILP (new_entry)) {
/* Check, whether this is an already deleted file (by rename). */
for (dl1 = deleted_dl; ! NILP (dl1); dl1 = XCDR (dl1)) {
new_entry = XCAR (dl1);
if (strcmp (SSDATA (XCAR (XCDR (old_entry))),
SSDATA (XCAR (XCDR (new_entry)))) == 0) {
deleted_dl = Fdelq (new_entry, deleted_dl);
goto the_end;
}
}
/* The file has been deleted. */
kqueue_generate_event
(watch_object, Fcons (Qdelete, Qnil), XCAR (XCDR (old_entry)), Qnil);
} else {
/* The file has been renamed. */
kqueue_generate_event
(watch_object, Fcons (Qrename, Qnil),
XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry)));
pending_dl = Fdelq (new_entry, pending_dl);
}
the_end:
dl = XCDR (dl);
old_dl = Fdelq (old_entry, old_dl);
}
/* Parse through the resulting new list. */
dl = new_dl;
while (1) {
Lisp_Object entry;
if (NILP (dl))
break;
/* A new file has appeared. */
entry = XCAR (dl);
kqueue_generate_event
(watch_object, Fcons (Qcreate, Qnil), XCAR (XCDR (entry)), Qnil);
/* Check size of that file. */
Lisp_Object size = Fnth (make_number (4), entry);
if (FLOATP (size) || (XINT (size) > 0))
kqueue_generate_event
(watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (entry)), Qnil);
dl = XCDR (dl);
new_dl = Fdelq (entry, new_dl);
}
/* Parse through the resulting pending_dl list. */
dl = pending_dl;
while (1) {
Lisp_Object entry;
if (NILP (dl))
break;
/* A file is still pending. Assume it was a write. */
entry = XCAR (dl);
kqueue_generate_event
(watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (entry)), Qnil);
dl = XCDR (dl);
pending_dl = Fdelq (entry, pending_dl);
}
/* At this point, old_dl, new_dl and pending_dl shall be empty.
deleted_dl might not be empty when there was a rename to a
nonexistent file. Let's make a check for this (might be removed
once the code is stable). */
if (! NILP (old_dl))
report_file_error ("Old list not empty", old_dl);
if (! NILP (new_dl))
report_file_error ("New list not empty", new_dl);
if (! NILP (pending_dl))
report_file_error ("Pending events list not empty", pending_dl);
// if (! NILP (deleted_dl))
// report_file_error ("Deleted events list not empty", deleted_dl);
/* Replace old directory listing with the new one. */
XSETCDR (Fnthcdr (make_number (3), watch_object),
Fcons (new_directory_files, Qnil));
return;
}
void list_position(CL_FORM *base)
{
GEN_HEAPVAR(ARG(4), ARG(8));
COPY(ARG(5), ARG(8));
LOAD_NIL(ARG(9));
if(CL_TRUEP(ARG(3)))
{
}
else
{
if(CL_TRUEP(INDIRECT(ARG(4))))
{
GEN_CLOSURE(array, ARG(10), 4, Z161_lambda, -1);
COPY(ARG(4), &array[3]);
LOAD_CLOSURE(array, ARG(10));
COPY(ARG(10), ARG(3));
}
else
{
GEN_STATIC_GLOBAL_FUNARG(extern_closure, Feql, 2);
LOAD_GLOBFUN(&extern_closure, ARG(3));
}
}
LOAD_NIL(ARG(10));
COPY(ARG(5), ARG(11));
COPY(ARG(1), ARG(12));
Fnthcdr(ARG(11));
M1_1:;
if(CL_ATOMP(ARG(11)))
{
LOAD_NIL(ARG(10));
goto RETURN1;
}
COPY(ARG(11), ARG(12));
COPY(GET_CAR(ARG(12)), ARG(10));
COPY(ARG(8), ARG(12));
COPY(ARG(6), ARG(13));
Fge(ARG(12), 2);
if(CL_TRUEP(ARG(12)))
{
goto RETURN1;
}
COPY(ARG(3), ARG(12));
COPY(ARG(0), ARG(13));
if(CL_TRUEP(ARG(7)))
{
COPY(ARG(7), ARG(14));
COPY(ARG(10), ARG(15));
Ffuncall(ARG(14), 2);
mv_count = 1;
}
else
{
COPY(ARG(10), ARG(14));
}
Ffuncall(ARG(12), 3);
mv_count = 1;
if(CL_TRUEP(ARG(12)))
{
COPY(ARG(8), ARG(9));
if(CL_TRUEP(ARG(2)))
{
}
else
{
goto RETURN1;
}
}
COPY(ARG(8), ARG(12));
F1plus(ARG(12));
COPY(ARG(12), ARG(8));
COPY(ARG(11), ARG(12));
COPY(GET_CDR(ARG(12)), ARG(11));
goto M1_1;
RETURN1:;
COPY(ARG(9), ARG(0));
}
static void
fix_command (Lisp_Object input, Lisp_Object values)
{
/* FIXME: Instead of this ugly hack, we should provide a way for an
interactive spec to return an expression/function that will re-build the
args without user intervention. */
if (CONSP (input))
{
Lisp_Object car;
car = XCAR (input);
/* Skip through certain special forms. */
while (EQ (car, Qlet) || EQ (car, Qletx)
|| EQ (car, Qsave_excursion)
|| EQ (car, Qprogn))
{
while (CONSP (XCDR (input)))
input = XCDR (input);
input = XCAR (input);
if (!CONSP (input))
break;
car = XCAR (input);
}
if (EQ (car, Qlist))
{
Lisp_Object intail, valtail;
for (intail = Fcdr (input), valtail = values;
CONSP (valtail);
intail = Fcdr (intail), valtail = XCDR (valtail))
{
Lisp_Object elt;
elt = Fcar (intail);
if (CONSP (elt))
{
Lisp_Object presflag, carelt;
carelt = XCAR (elt);
/* If it is (if X Y), look at Y. */
if (EQ (carelt, Qif)
&& EQ (Fnthcdr (make_number (3), elt), Qnil))
elt = Fnth (make_number (2), elt);
/* If it is (when ... Y), look at Y. */
else if (EQ (carelt, Qwhen))
{
while (CONSP (XCDR (elt)))
elt = XCDR (elt);
elt = Fcar (elt);
}
/* If the function call we're looking at
is a special preserved one, copy the
whole expression for this argument. */
if (CONSP (elt))
{
presflag = Fmemq (Fcar (elt), preserved_fns);
if (!NILP (presflag))
Fsetcar (valtail, Fcar (intail));
}
}
}
}
}
}
void unparse_unix_enough(CL_FORM *base)
{
LOAD_NIL(ARG(2));
LOAD_NIL(ARG(3));
ALLOC_CONS(ARG(4), ARG(2), ARG(3), ARG(2));
COPY(ARG(0), ARG(3));
Ppathname_directory(ARG(3));
COPY(ARG(1), ARG(4));
Ppathname_directory(ARG(4));
COPY(ARG(4), ARG(5));
Flength(ARG(5));
COPY(ARG(5), ARG(6));
LOAD_FIXNUM(ARG(7), 1, ARG(7));
Fgt(ARG(6), 2);
if(CL_TRUEP(ARG(6)))
{
COPY(ARG(3), ARG(6));
Flength(ARG(6));
COPY(ARG(5), ARG(7));
Fge(ARG(6), 2);
if(CL_TRUEP(ARG(6)))
{
COPY(ARG(3), ARG(6));
LOAD_FIXNUM(ARG(7), 0, ARG(7));
COPY(ARG(5), ARG(8));
subseq1(ARG(6));
COPY(ARG(4), ARG(7));
compare_component(ARG(6));
}
else
{
goto ELSE1;
}
}
else
{
goto ELSE1;
}
if(CL_TRUEP(ARG(6)))
{
LOAD_SYMBOL(SYMBOL(Slisp, 270), ARG(6)); /* RELATIVE */
COPY(ARG(5), ARG(7));
COPY(ARG(3), ARG(8));
Fnthcdr(ARG(7));
ALLOC_CONS(ARG(8), ARG(6), ARG(7), ARG(6));
}
else
{
ELSE1:;
if(CL_CONSP(ARG(3)))
{
COPY(GET_CAR(ARG(3)), ARG(6));
}
else
{
if(CL_TRUEP(ARG(3)))
{
LOAD_SMSTR((CL_FORM *)&KClisp[264], ARG(6)); /* ~a is not a list */
COPY(ARG(3), ARG(7));
Ferror(ARG(6), 2);
}
else
{
COPY(ARG(3), ARG(6));
}
}
if(CL_SYMBOLP(ARG(6)) && GET_SYMBOL(ARG(6)) == SYMBOL(Slisp, 267)) /* ABSOLUTE */
{
COPY(ARG(3), ARG(6));
}
else
{
LOAD_SMSTR((CL_FORM *)&KClisp[232], ARG(6)); /* ~S cannot be represented relative to ~S */
COPY(ARG(0), ARG(7));
COPY(ARG(1), ARG(8));
Ferror(ARG(6), 3);
}
}
COPY(ARG(6), ARG(7));
unparse_unix_directory_list(ARG(7));
COPY(ARG(2), ARG(8));
add_q(ARG(7));
COPY(ARG(0), ARG(3));
Ppathname_version(ARG(3));
if(CL_TRUEP(ARG(3)))
{
if(CL_SYMBOLP(ARG(3)) && GET_SYMBOL(ARG(3)) == SYMBOL(Slisp, 269)) /* NEWEST */
{
LOAD_NIL(ARG(4));
}
else
{
LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(4)); /* T */
}
}
else
{
LOAD_NIL(ARG(4));
}
COPY(ARG(0), ARG(5));
Ppathname_type(ARG(5));
if(CL_TRUEP(ARG(4)))
{
COPY(ARG(4), ARG(6));
}
else
{
if(CL_TRUEP(ARG(5)))
{
if(CL_SYMBOLP(ARG(5)) && GET_SYMBOL(ARG(5)) == SYMBOL(Slisp, 266)) /* UNSPECIFIC */
{
LOAD_NIL(ARG(6));
}
else
{
LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(6)); /* T */
}
}
else
{
LOAD_NIL(ARG(6));
}
}
COPY(ARG(0), ARG(7));
Ppathname_name(ARG(7));
if(CL_TRUEP(ARG(6)))
{
COPY(ARG(6), ARG(8));
}
else
{
if(CL_TRUEP(ARG(7)))
{
COPY(ARG(7), ARG(8));
COPY(ARG(1), ARG(9));
Ppathname_name(ARG(9));
compare_component(ARG(8));
if(CL_TRUEP(ARG(8)))
{
LOAD_NIL(ARG(8));
}
else
{
LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(8)); /* T */
}
}
else
{
LOAD_NIL(ARG(8));
}
}
if(CL_TRUEP(ARG(8)))
{
if(CL_TRUEP(ARG(7)))
{
}
else
{
LOAD_SMSTR((CL_FORM *)&KClisp[232], ARG(9)); /* ~S cannot be represented relative to ~S */
COPY(ARG(0), ARG(10));
COPY(ARG(1), ARG(11));
Ferror(ARG(9), 3);
}
COPY(ARG(7), ARG(9));
unparse_unix_piece(ARG(9));
COPY(ARG(2), ARG(10));
add_q(ARG(9));
}
if(CL_TRUEP(ARG(6)))
{
if(CL_TRUEP(ARG(5)))
{
LOAD_NIL(ARG(9));
}
else
{
LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(9)); /* T */
}
if(CL_TRUEP(ARG(9)))
{
goto THEN2;
}
else
{
} /* UNSPECIFIC */
if(CL_SYMBOLP(ARG(5)) && GET_SYMBOL(ARG(5)) == SYMBOL(Slisp, 266))
{
THEN2:;
LOAD_SMSTR((CL_FORM *)&KClisp[232], ARG(9)); /* ~S cannot be represented relative to ~S */
COPY(ARG(0), ARG(10));
COPY(ARG(1), ARG(11));
Ferror(ARG(9), 3);
}
LOAD_SMSTR((CL_FORM *)&Kunparse_unix_enough[0], ARG(9)); /* . */
COPY(ARG(2), ARG(10));
add_q(ARG(9));
COPY(ARG(5), ARG(9));
unparse_unix_piece(ARG(9));
COPY(ARG(2), ARG(10));
add_q(ARG(9));
}
if(CL_TRUEP(ARG(4)))
{
if(CL_SYMBOLP(ARG(3)) && GET_SYMBOL(ARG(3)) == SYMBOL(Slisp, 271)) /* WILD */
{
LOAD_SMSTR((CL_FORM *)&Kunparse_unix_enough[2], ARG(9)); /* .* */
COPY(ARG(2), ARG(10));
add_q(ARG(9));
}
else
{
if(CL_FIXNUMP(ARG(3)))
{
LOAD_NIL(ARG(9));
LOAD_SMSTR((CL_FORM *)&Kunparse_unix_enough[4], ARG(10)); /* .~D */
COPY(ARG(3), ARG(11));
Fformat(ARG(9), 3);
mv_count = 1;
COPY(ARG(2), ARG(10));
add_q(ARG(9));
}
else
{
LOAD_SMSTR((CL_FORM *)&KClisp[232], ARG(9)); /* ~S cannot be represented relative to ~S */
COPY(ARG(0), ARG(10));
COPY(ARG(1), ARG(11));
Ferror(ARG(9), 3);
}
}
}
LOAD_GLOBFUN(&CFconcatenate, ARG(3));
LOAD_SYMBOL(SYMBOL(Slisp, 40), ARG(4)); /* SIMPLE-STRING */
COPY(GET_CAR(ARG(2)), ARG(5));
Fapply(ARG(3), 3);
COPY(ARG(3), ARG(0));
}
repv gh_list_tail(repv ls, repv k)
{
return Fnthcdr (k, ls);
}
static void Z153_get_elem(CL_FORM *base)
{
if(CL_CONSP(ARG(1)))
{
COPY(GET_CAR(ARG(1)), ARG(2));
}
else
{
if(CL_TRUEP(ARG(1)))
{
LOAD_SMSTR((CL_FORM *)&KClisp[239], ARG(2)); /* ~a is not a list */
COPY(ARG(1), ARG(3));
Ferror(ARG(2), 2);
}
else
{
COPY(ARG(1), ARG(2));
}
}
if(CL_LISTP(ARG(2)))
{
if(CL_CONSP(ARG(1)))
{
COPY(GET_CAR(ARG(1)), ARG(2));
}
else
{
if(CL_TRUEP(ARG(1)))
{
LOAD_SMSTR((CL_FORM *)&KClisp[239], ARG(2)); /* ~a is not a list */
COPY(ARG(1), ARG(3));
Ferror(ARG(2), 2);
}
else
{
COPY(ARG(1), ARG(2));
}
}
if(CL_CONSP(ARG(2)))
{
COPY(GET_CAR(ARG(2)), ARG(3));
}
else
{
if(CL_TRUEP(ARG(2)))
{
LOAD_SMSTR((CL_FORM *)&KClisp[239], ARG(3)); /* ~a is not a list */
COPY(ARG(2), ARG(4));
Ferror(ARG(3), 2);
}
else
{
COPY(ARG(2), ARG(3));
}
}
COPY(ARG(2), ARG(4));
COPY(ARG(4), ARG(5));
if(CL_CONSP(ARG(5)))
{
COPY(GET_CDR(ARG(5)), ARG(2));
}
else
{
if(CL_TRUEP(ARG(5)))
{
LOAD_SMSTR((CL_FORM *)&KClisp[241], ARG(6)); /* ~a is not a list */
COPY(ARG(5), ARG(7));
Ferror(ARG(6), 2);
}
else
{
LOAD_NIL(ARG(2));
}
}
if(CL_CONSP(ARG(1)))
{
COPY(ARG(2), GET_CAR(ARG(1)));
}
else
{
LOAD_SMSTR((CL_FORM *)&KClisp[229], ARG(4)); /* ~a is not a cons */
COPY(ARG(1), ARG(5));
Ferror(ARG(4), 2);
}
COPY(ARG(3), ARG(0));
}
else
{
if(CL_CONSP(ARG(1)))
{
COPY(GET_CAR(ARG(1)), ARG(2));
}
else
{
if(CL_TRUEP(ARG(1)))
{
LOAD_SMSTR((CL_FORM *)&KClisp[239], ARG(2)); /* ~a is not a list */
COPY(ARG(1), ARG(3));
Ferror(ARG(2), 2);
}
else
{
COPY(ARG(1), ARG(2));
}
}
if(CL_LISTP(ARG(2)))
{
COPY(INDIRECT(GET_FORM(ARG(0)) + 3), ARG(3));
COPY(ARG(2), ARG(4));
Fnthcdr(ARG(3));
if(CL_CONSP(ARG(3)))
{
COPY(GET_CAR(ARG(3)), ARG(0));
}
else
{
if(CL_TRUEP(ARG(3)))
{
LOAD_SMSTR((CL_FORM *)&KClisp[239], ARG(4)); /* ~a is not a list */
COPY(ARG(3), ARG(5));
Ferror(ARG(4), 2);
}
else
{
LOAD_NIL(ARG(0));
}
}
}
else
{
COPY(ARG(2), ARG(3));
COPY(INDIRECT(GET_FORM(ARG(0)) + 3), ARG(4));
Frow_major_aref(ARG(3));
COPY(ARG(3), ARG(0));
}
}
}
