Esempio n. 1
0
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);
		}
	}
}
Esempio n. 2
0
/* 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;
}
Esempio n. 3
0
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));
}
Esempio n. 4
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));
		    }
		}
	    }
	}
    }
}
Esempio n. 5
0
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));
}
Esempio n. 6
0
repv gh_list_tail(repv ls, repv k)
{
    return Fnthcdr (k, ls);
}
Esempio n. 7
0
File: Fmap.c Progetto: plops/clicc
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));
		}
	}
}