This is opaque.c in view mode; [Download] [Up]
/* 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);
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.