Initial revision

Objects/classobject.c

@@ -0,0 +1,268 @@
+/* Class object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "node.h"
+#include "object.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+#include "dictobject.h"
+#include "funcobject.h"
+#include "classobject.h"
+#include "objimpl.h"
+
+typedef struct {
+	OB_HEAD
+	node	*cl_tree;	/* The entire classdef parse tree */
+	object	*cl_bases;	/* A tuple */
+	object	*cl_methods;	/* A dictionary */
+} classobject;
+
+object *
+newclassobject(tree, bases, methods)
+	node *tree;
+	object *bases; /* NULL or tuple of classobjects! */
+	object *methods;
+{
+	classobject *op;
+	op = NEWOBJ(classobject, &Classtype);
+	if (op == NULL)
+		return NULL;
+	op->cl_tree = tree;
+	if (bases != NULL)
+		INCREF(bases);
+	op->cl_bases = bases;
+	INCREF(methods);
+	op->cl_methods = methods;
+	return (object *) op;
+}
+
+/* Class methods */
+
+static void
+class_dealloc(op)
+	classobject *op;
+{
+	int i;
+	if (op->cl_bases != NULL)
+		DECREF(op->cl_bases);
+	DECREF(op->cl_methods);
+	free((ANY *)op);
+}
+
+static object *
+class_getattr(op, name)
+	register classobject *op;
+	register char *name;
+{
+	register object *v;
+	v = dictlookup(op->cl_methods, name);
+	if (v != NULL) {
+		INCREF(v);
+		return v;
+	}
+	if (op->cl_bases != NULL) {
+		int n = gettuplesize(op->cl_bases);
+		int i;
+		for (i = 0; i < n; i++) {
+			v = class_getattr(gettupleitem(op->cl_bases, i), name);
+			if (v != NULL)
+				return v;
+		}
+	}
+	errno = ESRCH;
+	return NULL;
+}
+
+typeobject Classtype = {
+	OB_HEAD_INIT(&Typetype)
+	0,
+	"class",
+	sizeof(classobject),
+	0,
+	class_dealloc,	/*tp_dealloc*/
+	0,		/*tp_print*/
+	class_getattr,	/*tp_getattr*/
+	0,		/*tp_setattr*/
+	0,		/*tp_compare*/
+	0,		/*tp_repr*/
+	0,		/*tp_as_number*/
+	0,		/*tp_as_sequence*/
+	0,		/*tp_as_mapping*/
+};
+
+
+/* We're not done yet: next, we define class member objects... */
+
+typedef struct {
+	OB_HEAD
+	classobject	*cm_class;	/* The class object */
+	object		*cm_attr;	/* A dictionary */
+} classmemberobject;
+
+object *
+newclassmemberobject(class)
+	register object *class;
+{
+	register classmemberobject *cm;
+	if (!is_classobject(class)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	cm = NEWOBJ(classmemberobject, &Classmembertype);
+	if (cm == NULL)
+		return NULL;
+	INCREF(class);
+	cm->cm_class = (classobject *)class;
+	cm->cm_attr = newdictobject();
+	if (cm->cm_attr == NULL) {
+		DECREF(cm);
+		return NULL;
+	}
+	return (object *)cm;
+}
+
+/* Class member methods */
+
+static void
+classmember_dealloc(cm)
+	register classmemberobject *cm;
+{
+	DECREF(cm->cm_class);
+	if (cm->cm_attr != NULL)
+		DECREF(cm->cm_attr);
+	free((ANY *)cm);
+}
+
+static object *
+classmember_getattr(cm, name)
+	register classmemberobject *cm;
+	register char *name;
+{
+	register object *v = dictlookup(cm->cm_attr, name);
+	if (v != NULL) {
+		INCREF(v);
+		return v;
+	}
+	v = class_getattr(cm->cm_class, name);
+	if (v == NULL)
+		return v; /* class_getattr() has set errno */
+	if (is_funcobject(v)) {
+		object *w = newclassmethodobject(v, (object *)cm);
+		DECREF(v);
+		return w;
+	}
+	DECREF(v);
+	errno = ESRCH;
+	return NULL;
+}
+
+static int
+classmember_setattr(cm, name, v)
+	classmemberobject *cm;
+	char *name;
+	object *v;
+{
+	if (v == NULL)
+		return dictremove(cm->cm_attr, name);
+	else
+		return dictinsert(cm->cm_attr, name, v);
+}
+
+typeobject Classmembertype = {
+	OB_HEAD_INIT(&Typetype)
+	0,
+	"class member",
+	sizeof(classmemberobject),
+	0,
+	classmember_dealloc,	/*tp_dealloc*/
+	0,			/*tp_print*/
+	classmember_getattr,	/*tp_getattr*/
+	classmember_setattr,	/*tp_setattr*/
+	0,			/*tp_compare*/
+	0,			/*tp_repr*/
+	0,			/*tp_as_number*/
+	0,			/*tp_as_sequence*/
+	0,			/*tp_as_mapping*/
+};
+
+
+/* And finally, here are class method objects */
+/* (Really methods of class members) */
+
+typedef struct {
+	OB_HEAD
+	object	*cm_func;	/* The method function */
+	object	*cm_self;	/* The object to which this applies */
+} classmethodobject;
+
+object *
+newclassmethodobject(func, self)
+	object *func;
+	object *self;
+{
+	register classmethodobject *cm;
+	if (!is_funcobject(func)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	cm = NEWOBJ(classmethodobject, &Classmethodtype);
+	if (cm == NULL)
+		return NULL;
+	INCREF(func);
+	cm->cm_func = func;
+	INCREF(self);
+	cm->cm_self = self;
+	return (object *)cm;
+}
+
+object *
+classmethodgetfunc(cm)
+	register object *cm;
+{
+	if (!is_classmethodobject(cm)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	return ((classmethodobject *)cm)->cm_func;
+}
+
+object *
+classmethodgetself(cm)
+	register object *cm;
+{
+	if (!is_classmethodobject(cm)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	return ((classmethodobject *)cm)->cm_self;
+}
+
+/* Class method methods */
+
+static void
+classmethod_dealloc(cm)
+	register classmethodobject *cm;
+{
+	DECREF(cm->cm_func);
+	DECREF(cm->cm_self);
+	free((ANY *)cm);
+}
+
+typeobject Classmethodtype = {
+	OB_HEAD_INIT(&Typetype)
+	0,
+	"class method",
+	sizeof(classmethodobject),
+	0,
+	classmethod_dealloc,	/*tp_dealloc*/
+	0,			/*tp_print*/
+	0,			/*tp_getattr*/
+	0,			/*tp_setattr*/
+	0,			/*tp_compare*/
+	0,			/*tp_repr*/
+	0,			/*tp_as_number*/
+	0,			/*tp_as_sequence*/
+	0,			/*tp_as_mapping*/
+};

Objects/fileobject.c

@@ -0,0 +1,267 @@
+/* File object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "intobject.h"
+#include "fileobject.h"
+#include "methodobject.h"
+#include "objimpl.h"
+
+typedef struct {
+	OB_HEAD
+	FILE *f_fp;
+	object *f_name;
+	object *f_mode;
+	/* XXX Should move the 'need space' on printing flag here */
+} fileobject;
+
+FILE *
+getfilefile(f)
+	object *f;
+{
+	if (!is_fileobject(f)) {
+		errno = EBADF;
+		return NULL;
+	}
+	return ((fileobject *)f)->f_fp;
+}
+
+object *
+newopenfileobject(fp, name, mode)
+	FILE *fp;
+	char *name;
+	char *mode;
+{
+	fileobject *f = NEWOBJ(fileobject, &Filetype);
+	if (f == NULL)
+		return NULL;
+	f->f_fp = NULL;
+	f->f_name = newstringobject(name);
+	f->f_mode = newstringobject(mode);
+	if (f->f_name == NULL || f->f_mode == NULL) {
+		DECREF(f);
+		errno = ENOMEM;
+		return NULL;
+	}
+	f->f_fp = fp;
+	return (object *) f;
+}
+
+object *
+newfileobject(name, mode)
+	char *name, *mode;
+{
+	fileobject *f;
+	FILE *fp;
+	f = (fileobject *) newopenfileobject((FILE *)NULL, name, mode);
+	if (f == NULL)
+		return NULL;
+	if ((f->f_fp = fopen(name, mode)) == NULL) {
+		DECREF(f);
+		return NULL;
+	}
+	return (object *)f;
+}
+
+/* Methods */
+
+static void
+filedealloc(f)
+	fileobject *f;
+{
+	if (f->f_fp != NULL)
+		fclose(f->f_fp);
+	if (f->f_name != NULL)
+		DECREF(f->f_name);
+	if (f->f_mode != NULL)
+		DECREF(f->f_mode);
+	free((char *)f);
+}
+
+static void
+fileprint(f, fp, flags)
+	fileobject *f;
+	FILE *fp;
+	int flags;
+{
+	fprintf(fp, "<%s file ", f->f_fp == NULL ? "closed" : "open");
+	printobject(f->f_name, fp, flags);
+	fprintf(fp, ", mode ");
+	printobject(f->f_mode, fp, flags);
+	fprintf(fp, ">");
+}
+
+static object *
+filerepr(f)
+	fileobject *f;
+{
+	char buf[300];
+	/* XXX This differs from fileprint if the filename contains
+	   quotes or other funny characters. */
+	sprintf(buf, "<%s file '%.256s', mode '%.10s'>",
+		f->f_fp == NULL ? "closed" : "open",
+		getstringvalue(f->f_name),
+		getstringvalue(f->f_mode));
+	return newstringobject(buf);
+}
+
+static object *
+fileclose(f, args)
+	fileobject *f;
+	object *args;
+{
+	if (args != NULL) {
+		errno = EINVAL;
+		return NULL;
+	}
+	if (f->f_fp != NULL) {
+		fclose(f->f_fp);
+		f->f_fp = NULL;
+	}
+	INCREF(None);
+	return None;
+}
+
+static object *
+fileread(f, args)
+	fileobject *f;
+	object *args;
+{
+	int n;
+	object *v;
+	if (f->f_fp == NULL) {
+		errno = EBADF;
+		return NULL;
+	}
+	if (args == NULL || !is_intobject(args)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	n = getintvalue(args);
+	if (n <= 0 /* || n > 0x7fff /*XXX*/ ) {
+		errno = EDOM;
+		return NULL;
+	}
+	v = newsizedstringobject((char *)NULL, n);
+	if (v == NULL) {
+		errno = ENOMEM;
+		return NULL;
+	}
+	n = fread(getstringvalue(v), 1, n, f->f_fp);
+	/* EOF is reported as an empty string */
+	/* XXX should detect real I/O errors? */
+	resizestring(&v, n);
+	return v;
+}
+
+/* XXX Should this be unified with raw_input()? */
+
+static object *
+filereadline(f, args)
+	fileobject *f;
+	object *args;
+{
+	int n;
+	object *v;
+	if (f->f_fp == NULL) {
+		errno = EBADF;
+		return NULL;
+	}
+	if (args == NULL) {
+		n = 10000; /* XXX should really be unlimited */
+	}
+	else if (is_intobject(args)) {
+		n = getintvalue(args);
+		if (n < 0 || n > 0x7fff /*XXX*/ ) {
+			errno = EDOM;
+			return NULL;
+		}
+	}
+	else {
+		errno = EINVAL;
+		return NULL;
+	}
+	v = newsizedstringobject((char *)NULL, n);
+	if (v == NULL) {
+		errno = ENOMEM;
+		return NULL;
+	}
+	if (fgets(getstringvalue(v), n+1, f->f_fp) == NULL) {
+		/* EOF is reported as an empty string */
+		/* XXX should detect real I/O errors? */
+		n = 0;
+	}
+	else {
+		n = strlen(getstringvalue(v));
+	}
+	resizestring(&v, n);
+	return v;
+}
+
+static object *
+filewrite(f, args)
+	fileobject *f;
+	object *args;
+{
+	int n, n2;
+	if (f->f_fp == NULL) {
+		errno = EBADF;
+		return NULL;
+	}
+	if (args == NULL || !is_stringobject(args)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	errno = 0;
+	n2 = fwrite(getstringvalue(args), 1, n = getstringsize(args), f->f_fp);
+	if (n2 != n) {
+		if (errno == 0)
+			errno = EIO;
+		return NULL;
+	}
+	INCREF(None);
+	return None;
+}
+
+static struct methodlist {
+	char *ml_name;
+	method ml_meth;
+} filemethods[] = {
+	{"write",	filewrite},
+	{"read",	fileread},
+	{"readline",	filereadline},
+	{"close",	fileclose},
+	{NULL,		NULL}		/* sentinel */
+};
+
+static object *
+filegetattr(f, name)
+	fileobject *f;
+	char *name;
+{
+	struct methodlist *ml = filemethods;
+	for (; ml->ml_name != NULL; ml++) {
+		if (strcmp(name, ml->ml_name) == 0)
+			return newmethodobject(ml->ml_name, ml->ml_meth,
+				(object *)f);
+	}
+	errno = ESRCH;
+	return NULL;
+}
+
+typeobject Filetype = {
+	OB_HEAD_INIT(&Typetype)
+	0,
+	"file",
+	sizeof(fileobject),
+	0,
+	filedealloc,	/*tp_dealloc*/
+	fileprint,	/*tp_print*/
+	filegetattr,	/*tp_getattr*/
+	0,		/*tp_setattr*/
+	0,		/*tp_compare*/
+	filerepr,	/*tp_repr*/
+};

Objects/floatobject.c

@@ -0,0 +1,240 @@
+/* Float object implementation */
+
+#include <stdio.h>
+#include <math.h>
+#include <ctype.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "floatobject.h"
+#include "stringobject.h"
+#include "objimpl.h"
+
+object *
+newfloatobject(fval)
+	double fval;
+{
+	/* For efficiency, this code is copied from newobject() */
+	register floatobject *op = (floatobject *) malloc(sizeof(floatobject));
+	if (op == NULL) {
+		errno = ENOMEM;
+	}
+	else {
+		NEWREF(op);
+		op->ob_type = &Floattype;
+		op->ob_fval = fval;
+	}
+	return (object *) op;
+}
+
+double
+getfloatvalue(op)
+	object *op;
+{
+	if (!is_floatobject(op)) {
+		errno = EBADF;
+		return -1;
+	}
+	else
+		return ((floatobject *)op) -> ob_fval;
+}
+
+/* Methods */
+
+static void
+float_buf_repr(buf, v)
+	char *buf;
+	floatobject *v;
+{
+	register char *cp;
+	/* Subroutine for float_repr and float_print.
+	   We want float numbers to be recognizable as such,
+	   i.e., they should contain a decimal point or an exponent.
+	   However, %g may print the number as an integer;
+	   in such cases, we append ".0" to the string. */
+	sprintf(buf, "%.12g", v->ob_fval);
+	cp = buf;
+	if (*cp == '-')
+		cp++;
+	for (; *cp != '\0'; cp++) {
+		/* Any non-digit means it's not an integer;
+		   this takes care of NAN and INF as well. */
+		if (!isdigit(*cp))
+			break;
+	}
+	if (*cp == '\0') {
+		*cp++ = '.';
+		*cp++ = '0';
+		*cp++ = '\0';
+	}
+}
+
+static void
+float_print(v, fp, flags)
+	floatobject *v;
+	FILE *fp;
+	int flags;
+{
+	char buf[100];
+	float_buf_repr(buf, v);
+	fputs(buf, fp);
+}
+
+static object *
+float_repr(v)
+	floatobject *v;
+{
+	char buf[100];
+	float_buf_repr(buf, v);
+	return newstringobject(buf);
+}
+
+static int
+float_compare(v, w)
+	floatobject *v, *w;
+{
+	double i = v->ob_fval;
+	double j = w->ob_fval;
+	return (i < j) ? -1 : (i > j) ? 1 : 0;
+}
+
+static object *
+float_add(v, w)
+	floatobject *v;
+	object *w;
+{
+	if (!is_floatobject(w)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	return newfloatobject(v->ob_fval + ((floatobject *)w) -> ob_fval);
+}
+
+static object *
+float_sub(v, w)
+	floatobject *v;
+	object *w;
+{
+	if (!is_floatobject(w)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	return newfloatobject(v->ob_fval - ((floatobject *)w) -> ob_fval);
+}
+
+static object *
+float_mul(v, w)
+	floatobject *v;
+	object *w;
+{
+	if (!is_floatobject(w)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	return newfloatobject(v->ob_fval * ((floatobject *)w) -> ob_fval);
+}
+
+static object *
+float_div(v, w)
+	floatobject *v;
+	object *w;
+{
+	if (!is_floatobject(w)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	if (((floatobject *)w) -> ob_fval == 0) {
+		errno = EDOM;
+		return NULL;
+	}
+	return newfloatobject(v->ob_fval / ((floatobject *)w) -> ob_fval);
+}
+
+static object *
+float_rem(v, w)
+	floatobject *v;
+	object *w;
+{
+	double wx;
+	extern double fmod();
+	if (!is_floatobject(w)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	wx = ((floatobject *)w) -> ob_fval;
+	if (wx == 0.0) {
+		errno = EDOM;
+		return NULL;
+	}
+	return newfloatobject(fmod(v->ob_fval, wx));
+}
+
+static object *
+float_pow(v, w)
+	floatobject *v;
+	object *w;
+{
+	double iv, iw, ix;
+	extern double pow();
+	if (!is_floatobject(w)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	iv = v->ob_fval;
+	iw = ((floatobject *)w)->ob_fval;
+	errno = 0;
+	ix = pow(iv, iw);
+	if (errno != 0)
+		return NULL;
+	else
+		return newfloatobject(ix);
+}
+
+static object *
+float_neg(v)
+	floatobject *v;
+{
+	return newfloatobject(-v->ob_fval);
+}
+
+static object *
+float_pos(v)
+	floatobject *v;
+{
+	return newfloatobject(v->ob_fval);
+}
+
+static number_methods float_as_number = {
+	float_add,	/*tp_add*/
+	float_sub,	/*tp_subtract*/
+	float_mul,	/*tp_multiply*/
+	float_div,	/*tp_divide*/
+	float_rem,	/*tp_remainder*/
+	float_pow,	/*tp_power*/
+	float_neg,	/*tp_negate*/
+	float_pos,	/*tp_plus*/
+};
+
+typeobject Floattype = {
+	OB_HEAD_INIT(&Typetype)
+	0,
+	"float",
+	sizeof(floatobject),
+	0,
+	free,			/*tp_dealloc*/
+	float_print,		/*tp_print*/
+	0,			/*tp_getattr*/
+	0,			/*tp_setattr*/
+	float_compare,		/*tp_compare*/
+	float_repr,		/*tp_repr*/
+	&float_as_number,	/*tp_as_number*/
+	0,			/*tp_as_sequence*/
+	0,			/*tp_as_mapping*/
+};
+
+/*
+XXX This is not enough.  Need:
+- automatic casts for mixed arithmetic (3.1 * 4)
+- mixed comparisons (!)
+- look at other uses of ints that could be extended to floats
+*/

Objects/funcobject.c

@@ -0,0 +1,101 @@
+/* Function object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "node.h"
+#include "stringobject.h"
+#include "funcobject.h"
+#include "objimpl.h"
+#include "token.h"
+
+typedef struct {
+	OB_HEAD
+	node *func_node;
+	object *func_globals;
+} funcobject;
+
+object *
+newfuncobject(n, globals)
+	node *n;
+	object *globals;
+{
+	funcobject *op = NEWOBJ(funcobject, &Functype);
+	if (op != NULL) {
+		op->func_node = n;
+		if (globals != NULL)
+			INCREF(globals);
+		op->func_globals = globals;
+	}
+	return (object *)op;
+}
+
+node *
+getfuncnode(op)
+	object *op;
+{
+	if (!is_funcobject(op)) {
+		errno = EBADF;
+		return NULL;
+	}
+	return ((funcobject *) op) -> func_node;
+}
+
+object *
+getfuncglobals(op)
+	object *op;
+{
+	if (!is_funcobject(op)) {
+		errno = EBADF;
+		return NULL;
+	}
+	return ((funcobject *) op) -> func_globals;
+}
+
+/* Methods */
+
+static void
+funcdealloc(op)
+	funcobject *op;
+{
+	/* XXX free node? */
+	DECREF(op->func_globals);
+	free((char *)op);
+}
+
+static void
+funcprint(op, fp, flags)
+	funcobject *op;
+	FILE *fp;
+	int flags;
+{
+	node *n = op->func_node;
+	n = CHILD(n, 1);
+	fprintf(fp, "<user function %s>", STR(n));
+}
+
+static object *
+funcrepr(op)
+	funcobject *op;
+{
+	char buf[100];
+	node *n = op->func_node;
+	n = CHILD(n, 1);
+	sprintf(buf, "<user function %.80s>", STR(n));
+	return newstringobject(buf);
+}
+
+typeobject Functype = {
+	OB_HEAD_INIT(&Typetype)
+	0,
+	"function",
+	sizeof(funcobject),
+	0,
+	funcdealloc,	/*tp_dealloc*/
+	funcprint,	/*tp_print*/
+	0,		/*tp_getattr*/
+	0,		/*tp_setattr*/
+	0,		/*tp_compare*/
+	funcrepr,	/*tp_repr*/
+};

Objects/intobject.c

@@ -0,0 +1,250 @@
+/* Integer object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "stringobject.h"
+#include "objimpl.h"
+
+/* Standard Booleans */
+intobject FalseObject = {
+	OB_HEAD_INIT(&Inttype)
+	0
+};
+intobject TrueObject = {
+	OB_HEAD_INIT(&Inttype)
+	1
+};
+
+object *
+newintobject(ival)
+	long ival;
+{
+	/* For efficiency, this code is copied from newobject() */
+	register intobject *op = (intobject *) malloc(sizeof(intobject));
+	if (op == NULL) {
+		errno = ENOMEM;
+	}
+	else {
+		NEWREF(op);
+		op->ob_type = &Inttype;
+		op->ob_ival = ival;
+	}
+	return (object *) op;
+}
+
+long
+getintvalue(op)
+	register object *op;
+{
+	if (!is_intobject(op)) {
+		errno = EBADF;
+		return -1;
+	}
+	else
+		return ((intobject *)op) -> ob_ival;
+}
+
+/* Methods */
+
+static void
+intprint(v, fp, flags)
+	intobject *v;
+	FILE *fp;
+	int flags;
+{
+	fprintf(fp, "%ld", v->ob_ival);
+}
+
+static object *
+intrepr(v)
+	intobject *v;
+{
+	char buf[20];
+	sprintf(buf, "%ld", v->ob_ival);
+	return newstringobject(buf);
+}
+
+static int
+intcompare(v, w)
+	intobject *v, *w;
+{
+	register long i = v->ob_ival;
+	register long j = w->ob_ival;
+	return (i < j) ? -1 : (i > j) ? 1 : 0;
+}
+
+static object *
+intadd(v, w)
+	intobject *v;
+	register object *w;
+{
+	register long a, b, x;
+	if (!is_intobject(w)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	a = v->ob_ival;
+	b = ((intobject *)w) -> ob_ival;
+	x = a + b;
+	if ((x^a) < 0 && (x^b) < 0) {
+		errno = ERANGE;
+		return NULL;
+	}
+	return newintobject(x);
+}
+
+static object *
+intsub(v, w)
+	intobject *v;
+	register object *w;
+{
+	register long a, b, x;
+	if (!is_intobject(w)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	a = v->ob_ival;
+	b = ((intobject *)w) -> ob_ival;
+	x = a - b;
+	if ((x^a) < 0 && (x^~b) < 0) {
+		errno = ERANGE;
+		return NULL;
+	}
+	return newintobject(x);
+}
+
+static object *
+intmul(v, w)
+	intobject *v;
+	register object *w;
+{
+	register long a, b;
+	double x;
+	if (!is_intobject(w)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	a = v->ob_ival;
+	b = ((intobject *)w) -> ob_ival;
+	x = (double)a * (double)b;
+	if (x > 0x7fffffff || x < (double) (long) 0x80000000) {
+		errno = ERANGE;
+		return NULL;
+	}
+	return newintobject(a * b);
+}
+
+static object *
+intdiv(v, w)
+	intobject *v;
+	register object *w;
+{
+	if (!is_intobject(w)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	if (((intobject *)w) -> ob_ival == 0) {
+		errno = EDOM;
+		return NULL;
+	}
+	return newintobject(v->ob_ival / ((intobject *)w) -> ob_ival);
+}
+
+static object *
+intrem(v, w)
+	intobject *v;
+	register object *w;
+{
+	if (!is_intobject(w)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	if (((intobject *)w) -> ob_ival == 0) {
+		errno = EDOM;
+		return NULL;
+	}
+	return newintobject(v->ob_ival % ((intobject *)w) -> ob_ival);
+}
+
+static object *
+intpow(v, w)
+	intobject *v;
+	register object *w;
+{
+	register long iv, iw, ix;
+	register int neg;
+	if (!is_intobject(w)) {
+		errno = EINVAL;
+		return NULL;
+	}
+	iv = v->ob_ival;
+	iw = ((intobject *)w)->ob_ival;
+	neg = 0;
+	if (iw < 0)
+		neg = 1, iw = -iw;
+	ix = 1;
+	for (; iw > 0; iw--)
+		ix = ix * iv;
+	if (neg) {
+		if (ix == 0) {
+			errno = EDOM;
+			return NULL;
+		}
+		ix = 1/ix;
+	}
+	/* XXX How to check for overflow? */
+	return newintobject(ix);
+}
+
+static object *
+intneg(v)
+	intobject *v;
+{
+	register long a, x;
+	a = v->ob_ival;
+	x = -a;
+	if (a < 0 && x < 0) {
+		errno = ERANGE;
+		return NULL;
+	}
+	return newintobject(x);
+}
+
+static object *
+intpos(v)
+	intobject *v;
+{
+	INCREF(v);
+	return (object *)v;
+}
+
+static number_methods int_as_number = {
+	intadd,	/*tp_add*/
+	intsub,	/*tp_subtract*/
+	intmul,	/*tp_multiply*/
+	intdiv,	/*tp_divide*/
+	intrem,	/*tp_remainder*/
+	intpow,	/*tp_power*/
+	intneg,	/*tp_negate*/
+	intpos,	/*tp_plus*/
+};
+
+typeobject Inttype = {
+	OB_HEAD_INIT(&Typetype)
+	0,
+	"int",
+	sizeof(intobject),
+	0,
+	free,		/*tp_dealloc*/
+	intprint,	/*tp_print*/
+	0,		/*tp_getattr*/
+	0,		/*tp_setattr*/
+	intcompare,	/*tp_compare*/
+	intrepr,	/*tp_repr*/
+	&int_as_number,	/*tp_as_number*/
+	0,		/*tp_as_sequence*/
+	0,		/*tp_as_mapping*/
+};

Objects/listobject.c

@@ -0,0 +1,482 @@
+/* List object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+#include "methodobject.h"
+#include "listobject.h"
+#include "objimpl.h"
+#include "modsupport.h"
+
+typedef struct {
+	OB_VARHEAD
+	object **ob_item;
+} listobject;
+
+object *
+newlistobject(size)
+	int size;
+{
+	int i;
+	listobject *op;
+	if (size < 0) {
+		errno = EINVAL;
+		return NULL;
+	}
+	op = (listobject *) malloc(sizeof(listobject));
+	if (op == NULL) {
+		errno = ENOMEM;
+		return NULL;
+	}
+	if (size <= 0) {
+		op->ob_item = NULL;
+	}
+	else {
+		op->ob_item = (object **) malloc(size * sizeof(object *));
+		if (op->ob_item == NULL) {
+			free((ANY *)op);
+			errno = ENOMEM;
+			return NULL;
+		}
+	}
+	NEWREF(op);
+	op->ob_type = &Listtype;
+	op->ob_size = size;
+	for (i = 0; i < size; i++)
+		op->ob_item[i] = NULL;
+	return (object *) op;
+}
+
+int
+getlistsize(op)
+	object *op;
+{
+	if (!is_listobject(op)) {
+		errno = EBADF;
+		return -1;
+	}
+	else
+		return ((listobject *)op) -> ob_size;
+}
+
+object *
+getlistitem(op, i)
+	object *op;
+	int i;
+{
+	if (!is_listobject(op)) {
+		errno = EBADF;
+		return NULL;
+	}
+	if (i < 0 || i >= ((listobject *)op) -> ob_size) {
+		errno = EDOM;
+		return NULL;
+	}
+	return ((listobject *)op) -> ob_item[i];
+}
+
+int
+setlistitem(op, i, newitem)
+	register object *op;
+	register int i;
+	register object *newitem;
+{
+	register object *olditem;
+	if (!is_listobject(op)) {
+		if (newitem != NULL)
+			DECREF(newitem);
+		return errno = EBADF;
+	}
+	if (i < 0 || i >= ((listobject *)op) -> ob_size) {
+		if (newitem != NULL)
+			DECREF(newitem);
+		return errno = EDOM;
+	}
+	olditem = ((listobject *)op) -> ob_item[i];
+	((listobject *)op) -> ob_item[i] = newitem;
+	if (olditem != NULL)
+		DECREF(olditem);
+	return 0;
+}
+
+static int
+ins1(self, where, v)
+	listobject *self;
+	int where;
+	object *v;
+{
+	int i;
+	object **items;
+	if (v == NULL)
+		return errno = EINVAL;
+	items = self->ob_item;
+	RESIZE(items, object *, self->ob_size+1);
+	if (items == NULL)
+		return errno = ENOMEM;
+	if (where < 0)
+		where = 0;
+	if (where > self->ob_size)
+		where = self->ob_size;
+	for (i = self->ob_size; --i >= where; )
+		items[i+1] = items[i];
+	INCREF(v);
+	items[where] = v;
+	self->ob_item = items;
+	self->ob_size++;
+	return 0;
+}
+
+int
+inslistitem(op, where, newitem)
+	object *op;
+	int where;
+	object *newitem;
+{
+	if (!is_listobject(op))
+		return errno = EBADF;
+	return ins1((listobject *)op, where, newitem);
+}
+
+int
+addlistitem(op, newitem)
+	object *op;
+	object *newitem;
+{
+	if (!is_listobject(op))
+		return errno = EBADF;
+	return ins1((listobject *)op,
+		(int) ((listobject *)op)->ob_size, newitem);
+}
+
+/* Methods */
+
+static void
+list_dealloc(op)
+	listobject *op;
+{
+	int i;
+	for (i = 0; i < op->ob_size; i++) {
+		if (op->ob_item[i] != NULL)
+			DECREF(op->ob_item[i]);
+	}
+	if (op->ob_item != NULL)
+		free((ANY *)op->ob_item);
+	free((ANY *)op);
+}
+
+static void
+list_print(op, fp, flags)
+	listobject *op;
+	FILE *fp;
+	int flags;
+{
+	int i;
+	fprintf(fp, "[");
+	for (i = 0; i < op->ob_size && !StopPrint; i++) {
+		if (i > 0) {
+			fprintf(fp, ", ");
+		}
+		printobject(op->ob_item[i], fp, flags);
+	}
+	fprintf(fp, "]");
+}
+
+object *
+list_repr(v)
+	listobject *v;
+{
+	object *s, *t, *comma;
+	int i;
+	s = newstringobject("[");
+	comma = newstringobject(", ");
+	for (i = 0; i < v->ob_size && s != NULL; i++) {
+		if (i > 0)
+			joinstring(&s, comma);
+		t = reprobject(v->ob_item[i]);
+		joinstring(&s, t);
+		DECREF(t);
+	}
+	DECREF(comma);
+	t = newstringobject("]");
+	joinstring(&s, t);
+	DECREF(t);
+	return s;
+}
+
+static int
+list_compare(v, w)
+	listobject *v, *w;
+{
+	int len = (v->ob_size < w->ob_size) ? v->ob_size : w->ob_size;
+	int i;
+	for (i = 0; i < len; i++) {
+		int cmp = cmpobject(v->ob_item[i], w->ob_item[i]);
+		if (cmp != 0)
+			return cmp;
+	}
+	return v->ob_size - w->ob_size;
+}
+
+static int
+list_length(a)
+	listobject *a;
+{
+	return a->ob_size;
+}
+
+static object *
+list_item(a, i)
+	listobject *a;
+	int i;
+{
+	if (i < 0 || i >= a->ob_size) {
+		errno = EDOM;
+		return NULL;
+	}
+	INCREF(a->ob_item[i]);
+	return a->ob_item[i];
+}
+
+static object *
+list_slice(a, ilow, ihigh)
+	listobject *a;
+	int ilow, ihigh;
+{
+	listobject *np;
+	int i;
+	if (ilow < 0)
+		ilow = 0;
+	else if (ilow > a->ob_size)
+		ilow = a->ob_size;
+	if (ihigh < 0)
+		ihigh = 0;
+	if (ihigh < ilow)
+		ihigh = ilow;
+	else if (ihigh > a->ob_size)
+		ihigh = a->ob_size;
+	np = (listobject *) newlistobject(ihigh - ilow);
+	if (np == NULL)
+		return NULL;
+	for (i = ilow; i < ihigh; i++) {
+		object *v = a->ob_item[i];
+		INCREF(v);
+		np->ob_item[i - ilow] = v;
+	}
+	return (object *)np;
+}
+
+static object *
+list_concat(a, bb)
+	listobject *a;
+	object *bb;
+{
+	int size;
+	int i;
+	listobject *np;
+	if (!is_listobject(bb)) {
+		errno = EINVAL;
+		return NULL;
+	}
+#define b ((listobject *)bb)
+	size = a->ob_size + b->ob_size;
+	np = (listobject *) newlistobject(size);
+	if (np == NULL) {
+		errno = ENOMEM;
+		return NULL;
+	}
+	for (i = 0; i < a->ob_size; i++) {
+		object *v = a->ob_item[i];
+		INCREF(v);
+		np->ob_item[i] = v;
+	}
+	for (i = 0; i < b->ob_size; i++) {
+		object *v = b->ob_item[i];
+		INCREF(v);
+		np->ob_item[i + a->ob_size] = v;
+	}
+	return (object *)np;
+#undef b
+}
+
+static int
+list_ass_item(a, i, v)
+	listobject *a;
+	int i;
+	object *v;
+{
+	if (i < 0 || i >= a->ob_size)
+		return errno = EDOM;
+	if (v == NULL)
+		return list_ass_slice(a, i, i+1, v);
+	INCREF(v);
+	DECREF(a->ob_item[i]);
+	a->ob_item[i] = v;
+	return 0;
+}
+
+static int
+list_ass_slice(a, ilow, ihigh, v)
+	listobject *a;
+	int ilow, ihigh;
+	object *v;
+{
+	object **item;
+	int n; /* Size of replacement list */
+	int d; /* Change in size */
+	int k; /* Loop index */
+#define b ((listobject *)v)
+	if (v == NULL)
+		n = 0;
+	else if (is_listobject(v))
+		n = b->ob_size;
+	else
+		return errno = EINVAL;
+	if (ilow < 0)
+		ilow = 0;
+	else if (ilow > a->ob_size)
+		ilow = a->ob_size;
+	if (ihigh < 0)
+		ihigh = 0;
+	if (ihigh < ilow)
+		ihigh = ilow;
+	else if (ihigh > a->ob_size)
+		ihigh = a->ob_size;
+	item = a->ob_item;
+	d = n - (ihigh-ilow);
+	if (d <= 0) { /* Delete -d items; DECREF ihigh-ilow items */
+		for (k = ilow; k < ihigh; k++)
+			DECREF(item[k]);
+		if (d < 0) {
+			for (/*k = ihigh*/; k < a->ob_size; k++)
+				item[k+d] = item[k];
+			a->ob_size += d;
+			RESIZE(item, object *, a->ob_size); /* Can't fail */
+			a->ob_item = item;
+		}
+	}
+	else { /* Insert d items; DECREF ihigh-ilow items */
+		RESIZE(item, object *, a->ob_size + d);
+		if (item == NULL)
+			return errno = ENOMEM;
+		for (k = a->ob_size; --k >= ihigh; )
+			item[k+d] = item[k];
+		for (/*k = ihigh-1*/; k >= ilow; --k)
+			DECREF(item[k]);
+		a->ob_item = item;
+		a->ob_size += d;
+	}
+	for (k = 0; k < n; k++, ilow++) {
+		object *w = b->ob_item[k];
+		INCREF(w);
+		item[ilow] = w;
+	}
+	return 0;
+#undef b
+}
+
+static object *
+ins(self, where, v)
+	listobject *self;
+	int where;
+	object *v;
+{
+	if (ins1(self, where, v) != 0)
+		return NULL;
+	INCREF(None);
+	return None;
+}
+
+static object *
+listinsert(self, args)
+	listobject *self;
+	object *args;
+{
+	int i;
+	if (args == NULL || !is_tupleobject(args) || gettuplesize(args) != 2) {
+		errno = EINVAL;
+		return NULL;
+	}
+	if (!getintarg(gettupleitem(args, 0), &i))
+		return NULL;
+	return ins(self, i, gettupleitem(args, 1));
+}
+
+static object *
+listappend(self, args)
+	listobject *self;
+	object *args;
+{
+	return ins(self, (int) self->ob_size, args);
+}
+
+static int
+cmp(v, w)
+	char *v, *w;
+{
+	return cmpobject(* (object **) v, * (object **) w);
+}
+
+static object *
+listsort(self, args)
+	listobject *self;
+	object *args;
+{
+	if (args != NULL) {
+		errno = EINVAL;
+		return NULL;
+	}
+	errno = 0;
+	if (self->ob_size > 1)
+		qsort((char *)self->ob_item,
+				(int) self->ob_size, sizeof(object *), cmp);
+	if (errno != 0)
+		return NULL;
+	INCREF(None);
+	return None;
+}
+
+static struct methodlist list_methods[] = {
+	{"append",	listappend},
+	{"insert",	listinsert},
+	{"sort",	listsort},
+	{NULL,		NULL}		/* sentinel */
+};
+
+static object *
+list_getattr(f, name)
+	listobject *f;
+	char *name;
+{
+	return findmethod(list_methods, (object *)f, name);
+}
+
+static sequence_methods list_as_sequence = {
+	list_length,	/*sq_length*/
+	list_concat,	/*sq_concat*/
+	0,		/*sq_repeat*/
+	list_item,	/*sq_item*/
+	list_slice,	/*sq_slice*/
+	list_ass_item,	/*sq_ass_item*/
+	list_ass_slice,	/*sq_ass_slice*/
+};
+
+typeobject Listtype = {
+	OB_HEAD_INIT(&Typetype)
+	0,
+	"list",
+	sizeof(listobject),
+	0,
+	list_dealloc,	/*tp_dealloc*/
+	list_print,	/*tp_print*/
+	list_getattr,	/*tp_getattr*/
+	0,		/*tp_setattr*/
+	list_compare,	/*tp_compare*/
+	list_repr,	/*tp_repr*/
+	0,		/*tp_as_number*/
+	&list_as_sequence,	/*tp_as_sequence*/
+	0,		/*tp_as_mapping*/
+};

Objects/methodobject.c

@@ -0,0 +1,113 @@
+/* Method object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "node.h"
+#include "stringobject.h"
+#include "methodobject.h"
+#include "objimpl.h"
+#include "token.h"
+
+typedef struct {
+	OB_HEAD
+	char *m_name;
+	method m_meth;
+	object *m_self;
+} methodobject;
+
+object *
+newmethodobject(name, meth, self)
+	char *name; /* static string */
+	method meth;
+	object *self;
+{
+	methodobject *op = NEWOBJ(methodobject, &Methodtype);
+	if (op != NULL) {
+		op->m_name = name;
+		op->m_meth = meth;
+		if (self != NULL)
+			INCREF(self);
+		op->m_self = self;
+	}
+	return (object *)op;
+}
+
+method
+getmethod(op)
+	object *op;
+{
+	if (!is_methodobject(op)) {
+		errno = EBADF;
+		return NULL;
+	}
+	return ((methodobject *)op) -> m_meth;
+}
+
+object *
+getself(op)
+	object *op;
+{
+	if (!is_methodobject(op)) {
+		errno = EBADF;
+		return NULL;
+	}
+	return ((methodobject *)op) -> m_self;
+}
+
+/* Methods (the standard built-in methods, that is) */
+
+static void
+meth_dealloc(m)
+	methodobject *m;
+{
+	if (m->m_self != NULL)
+		DECREF(m->m_self);
+	free((char *)m);
+}
+
+static void
+meth_print(m, fp, flags)
+	methodobject *m;
+	FILE *fp;
+	int flags;
+{
+	if (m->m_self == NULL)
+		fprintf(fp, "<%s method>", m->m_name);
+	else
+		fprintf(fp, "<%s method of %s object at %lx>",
+			m->m_name, m->m_self->ob_type->tp_name,
+			(long)m->m_self);
+}
+
+static object *
+meth_repr(m)
+	methodobject *m;
+{
+	char buf[200];
+	if (m->m_self == NULL)
+		sprintf(buf, "<%.80s method>", m->m_name);
+	else
+		sprintf(buf, "<%.80s method of %.80s object at %lx>",
+			m->m_name, m->m_self->ob_type->tp_name,
+			(long)m->m_self);
+	return newstringobject(buf);
+}
+
+typeobject Methodtype = {
+	OB_HEAD_INIT(&Typetype)
+	0,
+	"method",
+	sizeof(methodobject),
+	0,
+	meth_dealloc,	/*tp_dealloc*/
+	meth_print,	/*tp_print*/
+	0,		/*tp_getattr*/
+	0,		/*tp_setattr*/
+	0,		/*tp_compare*/
+	meth_repr,	/*tp_repr*/
+	0,		/*tp_as_number*/
+	0,		/*tp_as_sequence*/
+	0,		/*tp_as_mapping*/
+};

Objects/moduleobject.c

@@ -0,0 +1,130 @@
+/* Module object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "dictobject.h"
+#include "moduleobject.h"
+#include "objimpl.h"
+
+typedef struct {
+	OB_HEAD
+	object *md_name;
+	object *md_dict;
+} moduleobject;
+
+object *
+newmoduleobject(name)
+	char *name;
+{
+	moduleobject *m = NEWOBJ(moduleobject, &Moduletype);
+	if (m == NULL)
+		return NULL;
+	m->md_name = newstringobject(name);
+	m->md_dict = newdictobject();
+	if (m->md_name == NULL || m->md_dict == NULL) {
+		DECREF(m);
+		return NULL;
+	}
+	return (object *)m;
+}
+
+object *
+getmoduledict(m)
+	object *m;
+{
+	if (!is_moduleobject(m)) {
+		errno = EBADF;
+		return NULL;
+	}
+	return ((moduleobject *)m) -> md_dict;
+}
+
+int
+setmoduledict(m, v)
+	object *m;
+	object *v;
+{
+	if (!is_moduleobject(m))
+		return errno = EBADF;
+	if (!is_dictobject(v))
+		return errno = EINVAL;
+	DECREF(((moduleobject *)m) -> md_dict);
+	INCREF(v);
+	((moduleobject *)m) -> md_dict = v;
+	return 0;
+}
+
+/* Methods */
+
+static void
+moduledealloc(m)
+	moduleobject *m;
+{
+	if (m->md_name != NULL)
+		DECREF(m->md_name);
+	if (m->md_dict != NULL)
+		DECREF(m->md_dict);
+	free((char *)m);
+}
+
+static void
+moduleprint(m, fp, flags)
+	moduleobject *m;
+	FILE *fp;
+	int flags;
+{
+	fprintf(fp, "<module %s>", getstringvalue(m->md_name));
+}
+
+static object *
+modulerepr(m)
+	moduleobject *m;
+{
+	char buf[100];
+	sprintf(buf, "<module %.80s>", getstringvalue(m->md_name));
+	return newstringobject(buf);
+}
+
+static object *
+modulegetattr(m, name)
+	moduleobject *m;
+	char *name;
+{
+	object *res = dictlookup(m->md_dict, name);
+	if (res == NULL) {
+		if (errno == ENOENT)
+			errno = ESRCH;
+	}
+	else
+		INCREF(res);
+	return res;
+}
+
+static int
+modulesetattr(m, name, v)
+	moduleobject *m;
+	char *name;
+	object *v;
+{
+	if (v == NULL)
+		return dictremove(m->md_dict, name);
+	else
+		return dictinsert(m->md_dict, name, v);
+}
+
+typeobject Moduletype = {
+	OB_HEAD_INIT(&Typetype)
+	0,			/*ob_size*/
+	"module",		/*tp_name*/
+	sizeof(moduleobject),	/*tp_size*/
+	0,			/*tp_itemsize*/
+	moduledealloc,	/*tp_dealloc*/
+	moduleprint,	/*tp_print*/
+	modulegetattr,	/*tp_getattr*/
+	modulesetattr,	/*tp_setattr*/
+	0,		/*tp_compare*/
+	modulerepr,	/*tp_repr*/
+};

Objects/object.c

@@ -0,0 +1,195 @@
+/* Object implementation; and 'noobject' implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "objimpl.h"
+#include "errors.h"
+
+extern object *err_nomem PROTO((void)); /* XXX from modsupport.c */
+
+int StopPrint; /* Flag to indicate printing must be stopped */
+
+/* Object allocation routines used by NEWOBJ and NEWVAROBJ macros */
+
+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;
+}
+
+#if 0 /* unused */
+
+varobject *
+newvarobject(tp, size)
+	typeobject *tp;
+	unsigned int size;
+{
+	varobject *op = (varobject *)
+		malloc(tp->tp_basicsize + size * tp->tp_itemsize);
+	if (op == NULL)
+		return err_nomem();
+	NEWREF(op);
+	op->ob_type = tp;
+	op->ob_size = size;
+	return op;
+}
+
+#endif
+
+static int prlevel;
+
+void
+printobject(op, fp, flags)
+	object *op;
+	FILE *fp;
+	int flags;
+{
+	/* Hacks to make printing a long or recursive object interruptible */
+	prlevel++;
+	if (!StopPrint && intrcheck()) {
+		fprintf(fp, "\n[print interrupted]\n");
+		StopPrint = 1;
+	}
+	if (!StopPrint) {
+		if (op == NULL) {
+			fprintf(fp, "<nil>");
+		}
+		else if (op->ob_type->tp_print == NULL) {
+			fprintf(fp, "<%s object at %lx>",
+				op->ob_type->tp_name, (long)op);
+		}
+		else {
+			(*op->ob_type->tp_print)(op, fp, flags);
+		}
+	}
+	prlevel--;
+	if (prlevel == 0)
+		StopPrint = 0;
+}
+
+object *
+reprobject(v)
+	object *v;
+{
+	object *w;
+	/* Hacks to make converting a long or recursive object interruptible */
+	prlevel++;
+	if (!StopPrint && intrcheck()) {
+		StopPrint = 1;
+		w = NULL;
+		err_set(KeyboardInterrupt);
+	}
+	if (!StopPrint) {
+		if (v == NULL) {
+			w = newstringobject("<nil>");
+		}
+		else if (v->ob_type->tp_repr == NULL) {
+			char buf[100];
+			sprintf(buf, "<%.80s object at %lx>",
+				v->ob_type->tp_name, (long)v);
+			w = newstringobject(buf);
+		}
+		else {
+			w = (*v->ob_type->tp_repr)(v);
+		}
+	}
+	prlevel--;
+	if (prlevel == 0)
+		StopPrint = 0;
+	return w;
+}
+
+int
+cmpobject(v, w)
+	object *v, *w;
+{
+	typeobject *tp;
+	if (v == w)
+		return 0;
+	if (v == NULL)
+		return -1;
+	if (w == NULL)
+		return 1;
+	if ((tp = v->ob_type) != w->ob_type)
+		return strcmp(tp->tp_name, w->ob_type->tp_name);
+	if (tp->tp_compare == NULL)
+		return (v < w) ? -1 : 1;
+	return ((*tp->tp_compare)(v, w));
+}
+
+
+/*
+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,
+so there is exactly one.
+*/
+
+static void
+noprint(op, fp, flags)
+	object *op;
+	FILE *fp;
+	int flags;
+{
+	fprintf(fp, "<no value>");
+}
+
+static typeobject Notype = {
+	OB_HEAD_INIT(&Typetype)
+	0,
+	"novalue",
+	0,
+	0,
+	0,		/*tp_dealloc*/ /*never called*/
+	noprint,	/*tp_print*/
+};
+
+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;
+}
+
+DELREF(op)
+	object *op;
+{
+	op->_ob_next->_ob_prev = op->_ob_prev;
+	op->_ob_prev->_ob_next = op->_ob_next;
+	(*(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);
+		printobject(op, fp, 0);
+		putc('\n', fp);
+	}
+}
+
+#endif

Objects/stringobject.c

@@ -0,0 +1,328 @@
+/* String object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "intobject.h"
+#include "objimpl.h"
+
+object *
+newsizedstringobject(str, size)
+	char *str;
+	int size;
+{
+	register stringobject *op = (stringobject *)
+		malloc(sizeof(stringobject) + size * sizeof(char));
+	if (op == NULL) {
+		errno = ENOMEM;
+	}
+	else {
+		NEWREF(op);
+		op->ob_type = &Stringtype;
+		op->ob_size = size;
+		if (str != NULL)
+			memcpy(op->ob_sval, str, size);
+		op->ob_sval[size] = '\0';
+	}
+	return (object *) op;
+}
+
+object *
+newstringobject(str)
+	char *str;
+{
+	register unsigned int size = strlen(str);
+	register stringobject *op = (stringobject *)
+		malloc(sizeof(stringobject) + size * sizeof(char));
+	if (op == NULL) {
+		errno = ENOMEM;
+	}
+	else {
+		NEWREF(op);
+		op->ob_type = &Stringtype;
+		op->ob_size = size;
+		strcpy(op->ob_sval, str);
+	}
+	return (object *) op;
+}
+
+unsigned int
+getstringsize(op)
+	register object *op;
+{
+	if (!is_stringobject(op)) {
+		errno = EBADF;
+		return -1;
+	}
+	return ((stringobject *)op) -> ob_size;
+}
+
+/*const*/ char *
+getstringvalue(op)
+	register object *op;
+{
+	if (!is_stringobject(op)) {
+		errno = EBADF;
+		return NULL;
+	}
+	return ((stringobject *)op) -> ob_sval;
+}
+
+/* Methods */
+
+static void
+stringprint(op, fp, flags)
+	stringobject *op;
+	FILE *fp;
+	int flags;
+{
+	int i;
+	char c;
+	if (flags & PRINT_RAW) {
+		fwrite(op->ob_sval, 1, (int) op->ob_size, fp);
+		return;
+	}
+	fprintf(fp, "'");
+	for (i = 0; i < op->ob_size; i++) {
+		c = op->ob_sval[i];
+		if (c == '\'' || c == '\\')
+			fprintf(fp, "\\%c", c);
+		else if (c < ' ' || c >= 0177)
+			fprintf(fp, "\\%03o", c&0377);
+		else
+			putc(c, fp);
+	}
+	fprintf(fp, "'");
+}
+
+static object *
+stringrepr(op)
+	register stringobject *op;
+{
+	/* XXX overflow? */
+	int newsize = 2 + 4 * op->ob_size * sizeof(char);
+	object *v = newsizedstringobject((char *)NULL, newsize);
+	if (v == NULL) {
+		errno = ENOMEM;
+	}
+	else {
+		register int i;
+		register char c;
+		register char *p;
+		NEWREF(v);
+		v->ob_type = &Stringtype;
+		((stringobject *)v)->ob_size = newsize;
+		p = ((stringobject *)v)->ob_sval;
+		*p++ = '\'';
+		for (i = 0; i < op->ob_size; i++) {
+			c = op->ob_sval[i];
+			if (c == '\'' || c == '\\')
+				*p++ = '\\', *p++ = c;
+			else if (c < ' ' || c >= 0177) {
+				sprintf(p, "\\%03o", c&0377);
+				while (*p != '\0')
+					p++;
+				
+			}
+			else
+				*p++ = c;
+		}
+		*p++ = '\'';
+		*p = '\0';
+		resizestring(&v, (int) (p - ((stringobject *)v)->ob_sval));
+	}
+	return v;
+}
+
+static int
+stringlength(a)
+	stringobject *a;
+{
+	return a->ob_size;
+}
+
+static object *
+stringconcat(a, bb)
+	register stringobject *a;
+	register object *bb;
+{
+	register unsigned int size;
+	register stringobject *op;
+	if (!is_stringobject(bb)) {
+		errno = EINVAL;
+		return NULL;
+	}
+#define b ((stringobject *)bb)
+	/* Optimize cases with empty left or right operand */
+	if (a->ob_size == 0) {
+		INCREF(bb);
+		return bb;
+	}
+	if (b->ob_size == 0) {
+		INCREF(a);
+		return (object *)a;
+	}
+	size = a->ob_size + b->ob_size;
+	op = (stringobject *)
+		malloc(sizeof(stringobject) + size * sizeof(char));
+	if (op == NULL) {
+		errno = ENOMEM;
+	}
+	else {
+		NEWREF(op);
+		op->ob_type = &Stringtype;
+		op->ob_size = size;
+		memcpy(op->ob_sval, a->ob_sval, (int) a->ob_size);
+		memcpy(op->ob_sval + a->ob_size, b->ob_sval, (int) b->ob_size);
+		op->ob_sval[size] = '\0';
+	}
+	return (object *) op;
+#undef b
+}
+
+static object *
+stringrepeat(a, n)
+	register stringobject *a;
+	register int n;
+{
+	register int i;
+	register unsigned int size;
+	register stringobject *op;
+	if (n < 0)
+		n = 0;
+	size = a->ob_size * n;
+	if (size == a->ob_size) {
+		INCREF(a);
+		return (object *)a;
+	}
+	op = (stringobject *)
+		malloc(sizeof(stringobject) + size * sizeof(char));
+	if (op == NULL) {
+		errno = ENOMEM;
+	}
+	else {
+		NEWREF(op);
+		op->ob_type = &Stringtype;
+		op->ob_size = size;
+		for (i = 0; i < size; i += a->ob_size)
+			memcpy(op->ob_sval+i, a->ob_sval, (int) a->ob_size);
+		op->ob_sval[size] = '\0';
+	}
+	return (object *) op;
+}
+
+/* String slice a[i:j] consists of characters a[i] ... a[j-1] */
+
+static object *
+stringslice(a, i, j)
+	register stringobject *a;
+	register int i, j; /* May be negative! */
+{
+	if (i < 0)
+		i = 0;
+	if (j < 0)
+		j = 0; /* Avoid signed/unsigned bug in next line */
+	if (j > a->ob_size)
+		j = a->ob_size;
+	if (i == 0 && j == a->ob_size) { /* It's the same as a */
+		INCREF(a);
+		return (object *)a;
+	}
+	if (j < i)
+		j = i;
+	return newsizedstringobject(a->ob_sval + i, (int) (j-i));
+}
+
+static object *
+stringitem(a, i)
+	stringobject *a;
+	register int i;
+{
+	if (i < 0 || i >= a->ob_size) {
+		errno = EDOM;
+		return NULL;
+	}
+	return stringslice(a, i, i+1);
+}
+
+static int
+stringcompare(a, b)
+	stringobject *a, *b;
+{
+	/* XXX should use memcmp on shortest size, then compare lengths */
+	return strcmp(a->ob_sval, b->ob_sval);
+}
+
+static sequence_methods string_as_sequence = {
+	stringlength,	/*tp_length*/
+	stringconcat,	/*tp_concat*/
+	stringrepeat,	/*tp_repeat*/
+	stringitem,	/*tp_item*/
+	stringslice,	/*tp_slice*/
+	0,	/*tp_ass_item*/
+	0,	/*tp_ass_slice*/
+};
+
+typeobject Stringtype = {
+	OB_HEAD_INIT(&Typetype)
+	0,
+	"string",
+	sizeof(stringobject),
+	sizeof(char),
+	free,		/*tp_dealloc*/
+	stringprint,	/*tp_print*/
+	0,		/*tp_getattr*/
+	0,		/*tp_setattr*/
+	stringcompare,	/*tp_compare*/
+	stringrepr,	/*tp_repr*/
+	0,		/*tp_as_number*/
+	&string_as_sequence,	/*tp_as_sequence*/
+	0,		/*tp_as_mapping*/
+};
+
+void
+joinstring(pv, w)
+	register object **pv;
+	register object *w;
+{
+	register object *v;
+	if (*pv == NULL || w == NULL || !is_stringobject(*pv))
+		return;
+	v = stringconcat((stringobject *) *pv, w);
+	DECREF(*pv);
+	*pv = v;
+}
+
+/* The following function breaks the notion that strings are immutable:
+   it changes the size of a string.  We get away with this only if there
+   is only one module referencing the object.  You can also think of it
+   as creating a new string object and destroying the old one, only
+   more efficiently.  In any case, don't use this if the string may
+   already be known to some other part of the code... */
+
+int
+resizestring(pv, newsize)
+	object **pv;
+	int newsize;
+{
+	register stringobject *v;
+	v = (stringobject *) *pv;
+	if (!is_stringobject(v) || v->ob_refcnt != 1) {
+		*pv = 0;
+		DECREF(v);
+		return errno = EBADF;
+	}
+	*pv = (object *)
+		realloc((char *)v,
+			sizeof(stringobject) + newsize * sizeof(char));
+	if (*pv == NULL) {
+		DECREF(v);
+		return errno = ENOMEM;
+	}
+	v = (stringobject *) *pv;
+	v->ob_size = newsize;
+	v->ob_sval[newsize] = '\0';
+	return 0;
+}

Objects/tupleobject.c

@@ -0,0 +1,276 @@
+/* Tuple object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+#include "intobject.h"
+#include "objimpl.h"
+
+typedef struct {
+	OB_VARHEAD
+	object *ob_item[1];
+} tupleobject;
+
+object *
+newtupleobject(size)
+	register int size;
+{
+	register int i;
+	register tupleobject *op;
+	if (size < 0) {
+		errno = EINVAL;
+		return NULL;
+	}
+	op = (tupleobject *)
+		malloc(sizeof(tupleobject) + size * sizeof(object *));
+	if (op == NULL) {
+		errno = ENOMEM;
+		return NULL;
+	}
+	NEWREF(op);
+	op->ob_type = &Tupletype;
+	op->ob_size = size;
+	for (i = 0; i < size; i++)
+		op->ob_item[i] = NULL;
+	return (object *) op;
+}
+
+int
+gettuplesize(op)
+	register object *op;
+{
+	if (!is_tupleobject(op)) {
+		errno = EBADF;
+		return -1;
+	}
+	else
+		return ((tupleobject *)op)->ob_size;
+}
+
+object *
+gettupleitem(op, i)
+	register object *op;
+	register int i;
+{
+	if (!is_tupleobject(op)) {
+		errno = EBADF;
+		return NULL;
+	}
+	if (i < 0 || i >= ((tupleobject *)op) -> ob_size) {
+		errno = EDOM;
+		return NULL;
+	}
+	return ((tupleobject *)op) -> ob_item[i];
+}
+
+int
+settupleitem(op, i, newitem)
+	register object *op;
+	register int i;
+	register object *newitem;
+{
+	register object *olditem;
+	if (!is_tupleobject(op)) {
+		if (newitem != NULL)
+			DECREF(newitem);
+		return errno = EBADF;
+	}
+	if (i < 0 || i >= ((tupleobject *)op) -> ob_size) {
+		if (newitem != NULL)
+			DECREF(newitem);
+		return errno = EDOM;
+	}
+	olditem = ((tupleobject *)op) -> ob_item[i];
+	((tupleobject *)op) -> ob_item[i] = newitem;
+	if (olditem != NULL)
+		DECREF(olditem);
+	return 0;
+}
+
+/* Methods */
+
+static void
+tupledealloc(op)
+	register tupleobject *op;
+{
+	register int i;
+	for (i = 0; i < op->ob_size; i++) {
+		if (op->ob_item[i] != NULL)
+			DECREF(op->ob_item[i]);
+	}
+	free((ANY *)op);
+}
+
+static void
+tupleprint(op, fp, flags)
+	tupleobject *op;
+	FILE *fp;
+	int flags;
+{
+	int i;
+	fprintf(fp, "(");
+	for (i = 0; i < op->ob_size && !StopPrint; i++) {
+		if (i > 0) {
+			fprintf(fp, ", ");
+		}
+		printobject(op->ob_item[i], fp, flags);
+	}
+	if (op->ob_size == 1)
+		fprintf(fp, ",");
+	fprintf(fp, ")");
+}
+
+object *
+tuplerepr(v)
+	tupleobject *v;
+{
+	object *s, *t, *comma;
+	int i;
+	s = newstringobject("(");
+	comma = newstringobject(", ");
+	for (i = 0; i < v->ob_size && s != NULL; i++) {
+		if (i > 0)
+			joinstring(&s, comma);
+		t = reprobject(v->ob_item[i]);
+		joinstring(&s, t);
+		if (t != NULL)
+			DECREF(t);
+	}
+	DECREF(comma);
+	if (v->ob_size == 1) {
+		t = newstringobject(",");
+		joinstring(&s, t);
+		DECREF(t);
+	}
+	t = newstringobject(")");
+	joinstring(&s, t);
+	DECREF(t);
+	return s;
+}
+
+static int
+tuplecompare(v, w)
+	register tupleobject *v, *w;
+{
+	register int len =
+		(v->ob_size < w->ob_size) ? v->ob_size : w->ob_size;
+	register int i;
+	for (i = 0; i < len; i++) {
+		int cmp = cmpobject(v->ob_item[i], w->ob_item[i]);
+		if (cmp != 0)
+			return cmp;
+	}
+	return v->ob_size - w->ob_size;
+}
+
+static int
+tuplelength(a)
+	tupleobject *a;
+{
+	return a->ob_size;
+}
+
+static object *
+tupleitem(a, i)
+	register tupleobject *a;
+	register int i;
+{
+	if (i < 0 || i >= a->ob_size) {
+		errno = EDOM;
+		return NULL;
+	}
+	INCREF(a->ob_item[i]);
+	return a->ob_item[i];
+}
+
+static object *
+tupleslice(a, ilow, ihigh)
+	register tupleobject *a;
+	register int ilow, ihigh;
+{
+	register tupleobject *np;
+	register int i;
+	if (ilow < 0)
+		ilow = 0;
+	if (ihigh > a->ob_size)
+		ihigh = a->ob_size;
+	if (ihigh < ilow)
+		ihigh = ilow;
+	if (ilow == 0 && ihigh == a->ob_size) {
+		/* XXX can only do this if tuples are immutable! */
+		INCREF(a);
+		return (object *)a;
+	}
+	np = (tupleobject *)newtupleobject(ihigh - ilow);
+	if (np == NULL)
+		return NULL;
+	for (i = ilow; i < ihigh; i++) {
+		object *v = a->ob_item[i];
+		INCREF(v);
+		np->ob_item[i - ilow] = v;
+	}
+	return (object *)np;
+}
+
+static object *
+tupleconcat(a, bb)
+	register tupleobject *a;
+	register object *bb;
+{
+	register int size;
+	register int i;
+	tupleobject *np;
+	if (!is_tupleobject(bb)) {
+		errno = EINVAL;
+		return NULL;
+	}
+#define b ((tupleobject *)bb)
+	size = a->ob_size + b->ob_size;
+	np = (tupleobject *) newtupleobject(size);
+	if (np == NULL) {
+		errno = ENOMEM;
+		return NULL;
+	}
+	for (i = 0; i < a->ob_size; i++) {
+		object *v = a->ob_item[i];
+		INCREF(v);
+		np->ob_item[i] = v;
+	}
+	for (i = 0; i < b->ob_size; i++) {
+		object *v = b->ob_item[i];
+		INCREF(v);
+		np->ob_item[i + a->ob_size] = v;
+	}
+	return (object *)np;
+#undef b
+}
+
+static sequence_methods tuple_as_sequence = {
+	tuplelength,	/*sq_length*/
+	tupleconcat,	/*sq_concat*/
+	0,		/*sq_repeat*/
+	tupleitem,	/*sq_item*/
+	tupleslice,	/*sq_slice*/
+	0,		/*sq_ass_item*/
+	0,		/*sq_ass_slice*/
+};
+
+typeobject Tupletype = {
+	OB_HEAD_INIT(&Typetype)
+	0,
+	"tuple",
+	sizeof(tupleobject) - sizeof(object *),
+	sizeof(object *),
+	tupledealloc,	/*tp_dealloc*/
+	tupleprint,	/*tp_print*/
+	0,		/*tp_getattr*/
+	0,		/*tp_setattr*/
+	tuplecompare,	/*tp_compare*/
+	tuplerepr,	/*tp_repr*/
+	0,		/*tp_as_number*/
+	&tuple_as_sequence,	/*tp_as_sequence*/
+	0,		/*tp_as_mapping*/
+};

Objects/typeobject.c

@@ -0,0 +1,47 @@
+/* Type object implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "objimpl.h"
+
+/* Type object implementation */
+
+static void
+typeprint(v, fp, flags)
+	typeobject *v;
+	FILE *fp;
+	int flags;
+{
+	fprintf(fp, "<type '%s'>", v->tp_name);
+}
+
+static object *
+typerepr(v)
+	typeobject *v;
+{
+	char buf[100];
+	sprintf(buf, "<type '%.80s'>", v->tp_name);
+	return newstringobject(buf);
+}
+
+typedef struct {
+	OB_HEAD
+	long ob_ival;
+} intobject;
+
+typeobject Typetype = {
+	OB_HEAD_INIT(&Typetype)
+	0,			/* Number of items for varobject */
+	"type",			/* Name of this type */
+	sizeof(typeobject),	/* Basic object size */
+	0,			/* Item size for varobject */
+	0,		/*tp_dealloc*/
+	typeprint,	/*tp_print*/
+	0,		/*tp_getattr*/
+	0,		/*tp_setattr*/
+	0,		/*tp_compare*/
+	typerepr,	/*tp_repr*/
+};

Objects/xxobject.c

@@ -0,0 +1,94 @@
+/* Xx objects */
+
+typedef struct {
+	OB_HEAD
+	object	*x_attr;	/* Attributes dictionary */
+} xxobject;
+
+extern typeobject Xxtype;	/* Really static, forward */
+
+static xxobject *
+newxxobject(arg)
+	object *arg;
+{
+	textobject *xp;
+	xp = NEWOBJ(xxobject, &Xxtype);
+	if (xp == NULL)
+		return NULL;
+	xp->x_attr = NULL;
+	return xp;
+}
+
+/* Xx methods */
+
+static void
+xx_dealloc(xp)
+	xxobject *xp;
+{
+	if (xp->x_attr != NULL)
+		DECREF(xp->x_attr);
+	DEL(xp);
+}
+
+static object *
+xx_demo(self, args)
+	xxobject *self;
+	object *args;
+{
+	if (!getnoarg(args))
+		return NULL;
+	INCREF(None);
+	return None;
+}
+
+static struct methodlist xx_methods[] = {
+	"demo",		xx_demo,
+	{NULL,		NULL}		/* sentinel */
+};
+
+static object *
+xx_getattr(xp, name)
+	xxobject *xp;
+	char *name;
+{
+	if (xp->x_attr != NULL) {
+		object *v = dictlookup(xp->x_attr, name);
+		if (v != NULL) {
+			INCREF(v);
+			return v;
+		}
+	}
+	return findmethod(xx_methods, (object *)xp, name);
+}
+
+static int
+xx_setattr(xp, name, v)
+	xxobject *xp;
+	char *name;
+	object *v;
+{
+	if (xp->x_attr == NULL) {
+		xp->x_attr = newdictobject();
+		if (xp->x_attr == NULL)
+			return errno;
+	}
+	if (v == NULL)
+		return dictremove(xp->x_attr, name);
+	else
+		return dictinsert(xp->x_attr, name, v);
+}
+
+static typeobject Xxtype = {
+	OB_HEAD_INIT(&Typetype)
+	0,			/*ob_size*/
+	"xx",			/*tp_name*/
+	sizeof(xxobject),	/*tp_size*/
+	0,			/*tp_itemsize*/
+	/* methods */
+	xx_dealloc,	/*tp_dealloc*/
+	0,		/*tp_print*/
+	xx_getattr,	/*tp_getattr*/
+	xx_setattr,	/*tp_setattr*/
+	0,		/*tp_compare*/
+	0,		/*tp_repr*/
+};