/* 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.  As its name implies, its contents are
   inaccessible to the Lisp programmer.  Once created in C, opaque
   objects cannot be resized.
 */

#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);
DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("opaque", opaque,
					mark_opaque, 0, 0, 0, 0,
					sizeof_opaque, struct Lisp_Opaque);

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

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 *data)
{
  return make_opaque (sizeof (data), (void *) &data);
}

DEFUN ("opaquep", Fopaquep, Sopaquep, 1, 1, 0,
       "Return non-nil if OBJECT is an opaque object.")
  (object)
  Lisp_Object object;
{
  return (OPAQUEP (object) ? Qt : Qnil);
}

void
syms_of_opaque (void)
{
  defsymbol (&Qopaquep, "opaquep");
  defsubr (&Sopaquep);
}
