comparison src/alloc.c @ 89945:59dcbfe97385

Revision: [e-mail]--gnu-2004/emacs--unicode--0--patch-17 Merge from emacs--cvs-trunk--0 Patches applied: * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-417 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-419 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-420 Tweak permissions * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-421 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-430 Update from CVS

89944:ecb75580442e

  bcopy (s, p, len);
  return p;
}


/* Like malloc but used for allocating Lisp data.  NBYTES is the
   number of bytes to allocate, TYPE describes the intended use of the
   allcated memory block (for strings, for conses, ...).  */

static void *lisp_malloc_loser;

						     MEM_TYPE_MISC);
	  new->next = marker_block;
	  marker_block = new;
	  marker_block_index = 0;
	  n_marker_blocks++;
	}
      XSETMISC (val, &marker_block->markers[marker_block_index]);
      marker_block_index++;
    }

  consing_since_gc += sizeof (union Lisp_Misc);
  misc_objects_consed++;
  XMARKER (val)->gcmarkbit = 0;
  return val;
}

/* Return a Lisp_Misc_Save_Value object containing POINTER and
   INTEGER.  This is used to package C values to call record_unwind_protect.
   The unwind function can get the C values back using XSAVE_VALUE.  */

  val = allocate_misc ();
  XMISCTYPE (val) = Lisp_Misc_Save_Value;
  p = XSAVE_VALUE (val);
  p->pointer = pointer;
  p->integer = integer;
  return val;
}

DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
       doc: /* Return a newly allocated marker which does not point at any place.  */)

void
free_marker (marker)
     Lisp_Object marker;
{
  unchain_marker (XMARKER (marker));

  XMISC (marker)->u_marker.type = Lisp_Misc_Free;
  XMISC (marker)->u_free.chain = marker_free_list;
  marker_free_list = XMISC (marker);

  total_free_markers++;
}


/* Return a newly created vector or string with specified arguments as
   elements.  If all the arguments are characters that can fit

    case Lisp_Misc:
      CHECK_ALLOCATED_AND_LIVE (live_misc_p);
      if (XMARKER (obj)->gcmarkbit)
	break;
      XMARKER (obj)->gcmarkbit = 1;
      switch (XMISCTYPE (obj))
	{
	case Lisp_Misc_Buffer_Local_Value:
	case Lisp_Misc_Some_Buffer_Local_Value:
	  {

	case Lisp_Misc_Marker:
	  /* DO NOT mark thru the marker's chain.
	     The buffer's markers chain does not preserve markers from gc;
	     instead, markers are removed from the chain when freed by gc.  */
	case Lisp_Misc_Intfwd:
	case Lisp_Misc_Boolfwd:
	case Lisp_Misc_Objfwd:
	case Lisp_Misc_Buffer_Objfwd:
	case Lisp_Misc_Kboard_Objfwd:
	  /* Don't bother with Lisp_Buffer_Objfwd,
	     since all markable slots in current buffer marked anyway.  */
	  /* Don't need to do Lisp_Objfwd, since the places they point
	     are protected with staticpro.  */
	case Lisp_Misc_Save_Value:
	  break;

	case Lisp_Misc_Overlay:
	  {
	    struct Lisp_Overlay *ptr = XOVERLAY (obj);

89945:59dcbfe97385

  bcopy (s, p, len);
  return p;
}


/* Unwind for SAFE_ALLOCA */

Lisp_Object
safe_alloca_unwind (arg)
     Lisp_Object arg;
{
  register struct Lisp_Save_Value *p = XSAVE_VALUE (arg);

  p->dogc = 0;
  xfree (p->pointer);
  p->pointer = 0;
  free_misc (arg);
  return Qnil;
}


/* Like malloc but used for allocating Lisp data.  NBYTES is the
   number of bytes to allocate, TYPE describes the intended use of the
   allcated memory block (for strings, for conses, ...).  */

static void *lisp_malloc_loser;

						     MEM_TYPE_MISC);
	  new->next = marker_block;
	  marker_block = new;
	  marker_block_index = 0;
	  n_marker_blocks++;
	  total_free_markers += MARKER_BLOCK_SIZE;
	}
      XSETMISC (val, &marker_block->markers[marker_block_index]);
      marker_block_index++;
    }

  --total_free_markers;
  consing_since_gc += sizeof (union Lisp_Misc);
  misc_objects_consed++;
  XMARKER (val)->gcmarkbit = 0;
  return val;
}

/* Free a Lisp_Misc object */

void
free_misc (misc)
     Lisp_Object misc;
{
  XMISC (misc)->u_marker.type = Lisp_Misc_Free;
  XMISC (misc)->u_free.chain = marker_free_list;
  marker_free_list = XMISC (misc);

  total_free_markers++;
}

/* Return a Lisp_Misc_Save_Value object containing POINTER and
   INTEGER.  This is used to package C values to call record_unwind_protect.
   The unwind function can get the C values back using XSAVE_VALUE.  */

  val = allocate_misc ();
  XMISCTYPE (val) = Lisp_Misc_Save_Value;
  p = XSAVE_VALUE (val);
  p->pointer = pointer;
  p->integer = integer;
  p->dogc = 0;
  return val;
}

DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
       doc: /* Return a newly allocated marker which does not point at any place.  */)

void
free_marker (marker)
     Lisp_Object marker;
{
  unchain_marker (XMARKER (marker));
  free_misc (marker);
}


/* Return a newly created vector or string with specified arguments as
   elements.  If all the arguments are characters that can fit

    case Lisp_Misc:
      CHECK_ALLOCATED_AND_LIVE (live_misc_p);
      if (XMARKER (obj)->gcmarkbit)
	break;
      XMARKER (obj)->gcmarkbit = 1;

      switch (XMISCTYPE (obj))
	{
	case Lisp_Misc_Buffer_Local_Value:
	case Lisp_Misc_Some_Buffer_Local_Value:
	  {

	case Lisp_Misc_Marker:
	  /* DO NOT mark thru the marker's chain.
	     The buffer's markers chain does not preserve markers from gc;
	     instead, markers are removed from the chain when freed by gc.  */
	  break;

	case Lisp_Misc_Intfwd:
	case Lisp_Misc_Boolfwd:
	case Lisp_Misc_Objfwd:
	case Lisp_Misc_Buffer_Objfwd:
	case Lisp_Misc_Kboard_Objfwd:
	  /* Don't bother with Lisp_Buffer_Objfwd,
	     since all markable slots in current buffer marked anyway.  */
	  /* Don't need to do Lisp_Objfwd, since the places they point
	     are protected with staticpro.  */
	  break;

	case Lisp_Misc_Save_Value:
	  {
	    register struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj);
	    /* If DOGC is set, POINTER is the address of a memory
	       area containing INTEGER potential Lisp_Objects.  */
	    if (ptr->dogc)
	      {
		Lisp_Object *p = (Lisp_Object *) ptr->pointer;
		int nelt;
		for (nelt = ptr->integer; nelt > 0; nelt--, p++)
		  mark_maybe_object (*p);
	      }
	  }
	  break;

	case Lisp_Misc_Overlay:
	  {
	    struct Lisp_Overlay *ptr = XOVERLAY (obj);