1991-02-19 12:39:46 +00:00
|
|
|
/***********************************************************
|
1992-04-05 14:26:55 +00:00
|
|
|
Copyright 1991, 1992 by Stichting Mathematisch Centrum, Amsterdam, The
|
1991-02-19 12:39:46 +00:00
|
|
|
Netherlands.
|
|
|
|
|
|
|
|
All Rights Reserved
|
|
|
|
|
|
|
|
Permission to use, copy, modify, and distribute this software and its
|
|
|
|
documentation for any purpose and without fee is hereby granted,
|
|
|
|
provided that the above copyright notice appear in all copies and that
|
|
|
|
both that copyright notice and this permission notice appear in
|
|
|
|
supporting documentation, and that the names of Stichting Mathematisch
|
|
|
|
Centrum or CWI not be used in advertising or publicity pertaining to
|
|
|
|
distribution of the software without specific, written prior permission.
|
|
|
|
|
|
|
|
STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
|
|
|
|
THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
|
|
|
FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
|
|
|
|
FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
|
|
|
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
|
|
|
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
|
|
|
|
OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
|
|
|
|
|
|
|
******************************************************************/
|
|
|
|
|
1990-12-20 15:06:42 +00:00
|
|
|
/* Generic object operations; and implementation of None (NoObject) */
|
1990-10-14 12:07:46 +00:00
|
|
|
|
1990-12-20 15:06:42 +00:00
|
|
|
#include "allobjects.h"
|
1990-10-14 12:07:46 +00:00
|
|
|
|
1990-12-20 15:06:42 +00:00
|
|
|
#ifdef REF_DEBUG
|
|
|
|
long ref_total;
|
|
|
|
#endif
|
1990-10-14 12:07:46 +00:00
|
|
|
|
1990-12-20 15:06:42 +00:00
|
|
|
/* Object allocation routines used by NEWOBJ and NEWVAROBJ macros.
|
|
|
|
These are used by the individual routines for object creation.
|
|
|
|
Do not call them otherwise, they do not initialize the object! */
|
1990-10-14 12:07:46 +00:00
|
|
|
|
|
|
|
object *
|
|
|
|
newobject(tp)
|
|
|
|
typeobject *tp;
|
|
|
|
{
|
|
|
|
object *op = (object *) malloc(tp->tp_basicsize);
|
|
|
|
if (op == NULL)
|
|
|
|
return err_nomem();
|
|
|
|
NEWREF(op);
|
|
|
|
op->ob_type = tp;
|
|
|
|
return op;
|
|
|
|
}
|
|
|
|
|
|
|
|
varobject *
|
|
|
|
newvarobject(tp, size)
|
|
|
|
typeobject *tp;
|
|
|
|
unsigned int size;
|
|
|
|
{
|
|
|
|
varobject *op = (varobject *)
|
|
|
|
malloc(tp->tp_basicsize + size * tp->tp_itemsize);
|
|
|
|
if (op == NULL)
|
1991-05-05 20:10:41 +00:00
|
|
|
return (varobject *)err_nomem();
|
1990-10-14 12:07:46 +00:00
|
|
|
NEWREF(op);
|
|
|
|
op->ob_type = tp;
|
|
|
|
op->ob_size = size;
|
|
|
|
return op;
|
|
|
|
}
|
|
|
|
|
1991-06-07 16:10:43 +00:00
|
|
|
int
|
1990-10-14 12:07:46 +00:00
|
|
|
printobject(op, fp, flags)
|
|
|
|
object *op;
|
|
|
|
FILE *fp;
|
|
|
|
int flags;
|
|
|
|
{
|
1991-07-27 21:40:24 +00:00
|
|
|
int ret = 0;
|
1991-06-07 16:10:43 +00:00
|
|
|
if (intrcheck()) {
|
|
|
|
err_set(KeyboardInterrupt);
|
|
|
|
return -1;
|
1990-10-14 12:07:46 +00:00
|
|
|
}
|
1991-06-07 16:10:43 +00:00
|
|
|
if (op == NULL) {
|
|
|
|
fprintf(fp, "<nil>");
|
1990-10-14 12:07:46 +00:00
|
|
|
}
|
1991-06-07 16:10:43 +00:00
|
|
|
else {
|
|
|
|
if (op->ob_refcnt <= 0)
|
1992-03-27 17:26:13 +00:00
|
|
|
fprintf(fp, "(refcnt %u):", op->ob_refcnt);
|
1991-06-07 16:10:43 +00:00
|
|
|
if (op->ob_type->tp_print == NULL)
|
|
|
|
fprintf(fp, "<%s object at %lx>",
|
|
|
|
op->ob_type->tp_name, (long)op);
|
|
|
|
else
|
1991-07-27 21:40:24 +00:00
|
|
|
ret = (*op->ob_type->tp_print)(op, fp, flags);
|
1991-06-07 16:10:43 +00:00
|
|
|
}
|
1991-07-27 21:40:24 +00:00
|
|
|
if (ret == 0) {
|
|
|
|
if (ferror(fp)) {
|
1991-12-10 13:59:09 +00:00
|
|
|
err_errno(IOError);
|
1991-07-27 21:40:24 +00:00
|
|
|
clearerr(fp);
|
|
|
|
ret = -1;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return ret;
|
1990-10-14 12:07:46 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
object *
|
|
|
|
reprobject(v)
|
|
|
|
object *v;
|
|
|
|
{
|
1991-06-07 16:10:43 +00:00
|
|
|
if (intrcheck()) {
|
1990-10-14 12:07:46 +00:00
|
|
|
err_set(KeyboardInterrupt);
|
1991-06-07 16:10:43 +00:00
|
|
|
return NULL;
|
1990-10-14 12:07:46 +00:00
|
|
|
}
|
1991-06-07 16:10:43 +00:00
|
|
|
if (v == NULL)
|
|
|
|
return newstringobject("<NULL>");
|
|
|
|
else if (v->ob_type->tp_repr == NULL) {
|
|
|
|
char buf[120];
|
|
|
|
sprintf(buf, "<%.80s object at %lx>",
|
|
|
|
v->ob_type->tp_name, (long)v);
|
|
|
|
return newstringobject(buf);
|
1990-10-14 12:07:46 +00:00
|
|
|
}
|
1991-06-07 16:10:43 +00:00
|
|
|
else
|
|
|
|
return (*v->ob_type->tp_repr)(v);
|
1990-10-14 12:07:46 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
int
|
|
|
|
cmpobject(v, w)
|
|
|
|
object *v, *w;
|
|
|
|
{
|
|
|
|
typeobject *tp;
|
|
|
|
if (v == w)
|
|
|
|
return 0;
|
|
|
|
if (v == NULL)
|
|
|
|
return -1;
|
|
|
|
if (w == NULL)
|
|
|
|
return 1;
|
1991-07-01 18:48:04 +00:00
|
|
|
if ((tp = v->ob_type) != w->ob_type) {
|
|
|
|
if (tp->tp_as_number != NULL &&
|
|
|
|
w->ob_type->tp_as_number != NULL) {
|
|
|
|
if (coerce(&v, &w) != 0) {
|
|
|
|
err_clear();
|
|
|
|
/* XXX Should report the error,
|
|
|
|
XXX but the interface isn't there... */
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
int cmp = (*v->ob_type->tp_compare)(v, w);
|
|
|
|
DECREF(v);
|
|
|
|
DECREF(w);
|
|
|
|
return cmp;
|
|
|
|
}
|
|
|
|
}
|
1990-10-14 12:07:46 +00:00
|
|
|
return strcmp(tp->tp_name, w->ob_type->tp_name);
|
1991-07-01 18:48:04 +00:00
|
|
|
}
|
1990-10-14 12:07:46 +00:00
|
|
|
if (tp->tp_compare == NULL)
|
|
|
|
return (v < w) ? -1 : 1;
|
1991-07-01 18:48:04 +00:00
|
|
|
return (*tp->tp_compare)(v, w);
|
1990-10-14 12:07:46 +00:00
|
|
|
}
|
|
|
|
|
1990-12-20 15:06:42 +00:00
|
|
|
object *
|
|
|
|
getattr(v, name)
|
|
|
|
object *v;
|
|
|
|
char *name;
|
|
|
|
{
|
|
|
|
if (v->ob_type->tp_getattr == NULL) {
|
|
|
|
err_setstr(TypeError, "attribute-less object");
|
|
|
|
return NULL;
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
return (*v->ob_type->tp_getattr)(v, name);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
int
|
|
|
|
setattr(v, name, w)
|
|
|
|
object *v;
|
|
|
|
char *name;
|
|
|
|
object *w;
|
|
|
|
{
|
|
|
|
if (v->ob_type->tp_setattr == NULL) {
|
|
|
|
if (v->ob_type->tp_getattr == NULL)
|
1991-12-24 13:28:03 +00:00
|
|
|
err_setstr(TypeError,
|
|
|
|
"attribute-less object (assign or del)");
|
1990-12-20 15:06:42 +00:00
|
|
|
else
|
1991-12-24 13:28:03 +00:00
|
|
|
err_setstr(TypeError,
|
|
|
|
"object has read-only attributes");
|
1990-12-20 23:12:40 +00:00
|
|
|
return -1;
|
1990-12-20 15:06:42 +00:00
|
|
|
}
|
|
|
|
else {
|
|
|
|
return (*v->ob_type->tp_setattr)(v, name, w);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
1990-10-14 12:07:46 +00:00
|
|
|
|
|
|
|
/*
|
|
|
|
NoObject is usable as a non-NULL undefined value, used by the macro None.
|
|
|
|
There is (and should be!) no way to create other objects of this type,
|
1990-12-20 15:06:42 +00:00
|
|
|
so there is exactly one (which is indestructible, by the way).
|
1990-10-14 12:07:46 +00:00
|
|
|
*/
|
|
|
|
|
1992-03-27 17:26:13 +00:00
|
|
|
/* ARGSUSED */
|
1991-06-07 16:10:43 +00:00
|
|
|
static int
|
1990-12-20 15:06:42 +00:00
|
|
|
none_print(op, fp, flags)
|
1990-10-14 12:07:46 +00:00
|
|
|
object *op;
|
|
|
|
FILE *fp;
|
|
|
|
int flags;
|
|
|
|
{
|
1990-12-20 15:06:42 +00:00
|
|
|
fprintf(fp, "None");
|
1991-06-07 16:10:43 +00:00
|
|
|
return 0;
|
1990-12-20 15:06:42 +00:00
|
|
|
}
|
|
|
|
|
1992-03-27 17:26:13 +00:00
|
|
|
/* ARGSUSED */
|
1990-12-20 15:06:42 +00:00
|
|
|
static object *
|
|
|
|
none_repr(op)
|
|
|
|
object *op;
|
|
|
|
{
|
|
|
|
return newstringobject("None");
|
1990-10-14 12:07:46 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
static typeobject Notype = {
|
|
|
|
OB_HEAD_INIT(&Typetype)
|
|
|
|
0,
|
1990-12-20 15:06:42 +00:00
|
|
|
"None",
|
1990-10-14 12:07:46 +00:00
|
|
|
0,
|
|
|
|
0,
|
|
|
|
0, /*tp_dealloc*/ /*never called*/
|
1990-12-20 15:06:42 +00:00
|
|
|
none_print, /*tp_print*/
|
|
|
|
0, /*tp_getattr*/
|
|
|
|
0, /*tp_setattr*/
|
|
|
|
0, /*tp_compare*/
|
|
|
|
none_repr, /*tp_repr*/
|
|
|
|
0, /*tp_as_number*/
|
|
|
|
0, /*tp_as_sequence*/
|
|
|
|
0, /*tp_as_mapping*/
|
1990-10-14 12:07:46 +00:00
|
|
|
};
|
|
|
|
|
|
|
|
object NoObject = {
|
|
|
|
OB_HEAD_INIT(&Notype)
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
|
|
#ifdef TRACE_REFS
|
|
|
|
|
|
|
|
static object refchain = {&refchain, &refchain};
|
|
|
|
|
|
|
|
NEWREF(op)
|
|
|
|
object *op;
|
|
|
|
{
|
|
|
|
ref_total++;
|
|
|
|
op->ob_refcnt = 1;
|
|
|
|
op->_ob_next = refchain._ob_next;
|
|
|
|
op->_ob_prev = &refchain;
|
|
|
|
refchain._ob_next->_ob_prev = op;
|
|
|
|
refchain._ob_next = op;
|
|
|
|
}
|
|
|
|
|
1990-12-20 15:06:42 +00:00
|
|
|
UNREF(op)
|
|
|
|
register object *op;
|
1990-10-14 12:07:46 +00:00
|
|
|
{
|
1990-12-20 15:06:42 +00:00
|
|
|
register object *p;
|
1990-11-02 17:49:51 +00:00
|
|
|
if (op->ob_refcnt < 0) {
|
1990-12-20 15:06:42 +00:00
|
|
|
fprintf(stderr, "UNREF negative refcnt\n");
|
|
|
|
abort();
|
|
|
|
}
|
|
|
|
for (p = refchain._ob_next; p != &refchain; p = p->_ob_next) {
|
|
|
|
if (p == op)
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
if (p == &refchain) { /* Not found */
|
|
|
|
fprintf(stderr, "UNREF unknown object\n");
|
1990-11-02 17:49:51 +00:00
|
|
|
abort();
|
|
|
|
}
|
1990-10-14 12:07:46 +00:00
|
|
|
op->_ob_next->_ob_prev = op->_ob_prev;
|
|
|
|
op->_ob_prev->_ob_next = op->_ob_next;
|
1990-12-20 15:06:42 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
DELREF(op)
|
|
|
|
object *op;
|
|
|
|
{
|
|
|
|
UNREF(op);
|
1990-10-14 12:07:46 +00:00
|
|
|
(*(op)->ob_type->tp_dealloc)(op);
|
|
|
|
}
|
|
|
|
|
|
|
|
printrefs(fp)
|
|
|
|
FILE *fp;
|
|
|
|
{
|
|
|
|
object *op;
|
|
|
|
fprintf(fp, "Remaining objects:\n");
|
|
|
|
for (op = refchain._ob_next; op != &refchain; op = op->_ob_next) {
|
|
|
|
fprintf(fp, "[%d] ", op->ob_refcnt);
|
1991-06-07 16:10:43 +00:00
|
|
|
if (printobject(op, fp, 0) != 0)
|
|
|
|
err_clear();
|
1990-10-14 12:07:46 +00:00
|
|
|
putc('\n', fp);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
#endif
|