/* Opaque Lisp objects.
   Copyright (C) 1993, 1994 Sun Microsystems, Inc.

This file is part of XEmacs.

XEmacs is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.

XEmacs is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with XEmacs; see the file COPYING.  If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */

/* Synched up with: Not in FSF. */

/* Written by Ben Wing, October 1993. */

/* "Opaque" is used internally to hold keep track of allocated memory
   so it gets GC'd properly, and to store arbitrary data in places
   where a Lisp_Object is required and which may get GC'd. (e.g.  as
   the argument to record_unwind_protect()).  Once created in C,
   opaque objects cannot be resized.

   OPAQUE OBJECTS SHOULD NEVER ESCAPE TO THE LISP LEVEL.  Some code
   depends on this.  As such, opaque objects are a generalization
   of the Qunbound marker.
 */

#include <config.h>
#include "lisp.h"
#include "opaque.h"

/**********************************************************************/
/*                          OPAQUE OBJECTS                            */
/**********************************************************************/

Lisp_Object Qopaquep;
static Lisp_Object mark_opaque (Lisp_Object, void (*) (Lisp_Object));
static unsigned int sizeof_opaque (CONST void *header);
static void print_opaque (Lisp_Object obj, Lisp_Object printcharfun,
			  int escapeflag);
DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("opaque", opaque,
					mark_opaque, print_opaque, 0, 0, 0,
					sizeof_opaque, struct Lisp_Opaque);

static Lisp_Object
mark_opaque (Lisp_Object obj, void (*markobj) (Lisp_Object))
{
  if (XOPAQUE_MARKFUN (obj))
    return (XOPAQUE_MARKFUN (obj)) (obj, markobj);
  else
    return Qnil;
}

/* Should never, ever be called. (except by an external debugger) */
static void
print_opaque (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
{
  char buf[200];
  sprintf (buf, "#<INTERNAL EMACS BUG (opaque, size=%d) 0x%x>",
	   (LISP_WORD_TYPE) XOPAQUE_SIZE (obj),
	   (LISP_WORD_TYPE) XPNTR (obj));
  write_c_string (buf, printcharfun);
}

static unsigned int
sizeof_opaque (CONST void *header)
{
  struct Lisp_Opaque *p = (struct Lisp_Opaque *) header;
  return sizeof (*p) + p->size - 1;
}

Lisp_Object
make_opaque (int size, void *data)
{
  struct Lisp_Opaque *p = alloc_lcrecord (sizeof (*p) + size - 1,
					  lrecord_opaque);
  Lisp_Object val;

  p->markfun = 0;
  p->size = size;
  if (data)
    memcpy (p->data, data, size);
  else
    memset (p->data, 0, size);
  XSETOPAQUE (val, p);
  return val;
}

Lisp_Object
make_opaque_ptr (void *val)
{
  return make_opaque (sizeof (val), (void *) &val);
}

Lisp_Object
make_opaque_long (long val)
{
  return make_opaque (sizeof (val), (void *) &val);
}
