Initial revision

Python/cgensupport.c

@@ -0,0 +1,369 @@
+/* Functions used by cgen output */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "floatobject.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+#include "listobject.h"
+#include "methodobject.h"
+#include "moduleobject.h"
+#include "modsupport.h"
+#include "import.h"
+#include "cgensupport.h"
+#include "errors.h"
+
+
+/* Functions to construct return values */
+
+object *
+mknewcharobject(c)
+	int c;
+{
+	char ch[1];
+	ch[0] = c;
+	return newsizedstringobject(ch, 1);
+}
+
+/* Functions to extract arguments.
+   These needs to know the total number of arguments supplied,
+   since the argument list is a tuple only of there is more than
+   one argument. */
+
+int
+getiobjectarg(args, nargs, i, p_arg)
+	register object *args;
+	int nargs, i;
+	object **p_arg;
+{
+	if (nargs != 1) {
+		if (args == NULL || !is_tupleobject(args) ||
+				nargs != gettuplesize(args) ||
+				i < 0 || i >= nargs) {
+			return err_badarg();
+		}
+		else {
+			args = gettupleitem(args, i);
+		}
+	}
+	if (args == NULL) {
+		return err_badarg();
+	}
+	*p_arg = args;
+	return 1;
+}
+
+int
+getilongarg(args, nargs, i, p_arg)
+	register object *args;
+	int nargs, i;
+	long *p_arg;
+{
+	if (nargs != 1) {
+		if (args == NULL || !is_tupleobject(args) ||
+				nargs != gettuplesize(args) ||
+				i < 0 || i >= nargs) {
+			return err_badarg();
+		}
+		args = gettupleitem(args, i);
+	}
+	if (args == NULL || !is_intobject(args)) {
+		return err_badarg();
+	}
+	*p_arg = getintvalue(args);
+	return 1;
+}
+
+int
+getishortarg(args, nargs, i, p_arg)
+	register object *args;
+	int nargs, i;
+	short *p_arg;
+{
+	long x;
+	if (!getilongarg(args, nargs, i, &x))
+		return 0;
+	*p_arg = x;
+	return 1;
+}
+
+static int
+extractdouble(v, p_arg)
+	register object *v;
+	double *p_arg;
+{
+	if (v == NULL) {
+		/* Fall through to error return at end of function */
+	}
+	else if (is_floatobject(v)) {
+		*p_arg = GETFLOATVALUE((floatobject *)v);
+		return 1;
+	}
+	else if (is_intobject(v)) {
+		*p_arg = GETINTVALUE((intobject *)v);
+		return 1;
+	}
+	return err_badarg();
+}
+
+static int
+extractfloat(v, p_arg)
+	register object *v;
+	float *p_arg;
+{
+	if (v == NULL) {
+		/* Fall through to error return at end of function */
+	}
+	else if (is_floatobject(v)) {
+		*p_arg = GETFLOATVALUE((floatobject *)v);
+		return 1;
+	}
+	else if (is_intobject(v)) {
+		*p_arg = GETINTVALUE((intobject *)v);
+		return 1;
+	}
+	return err_badarg();
+}
+
+int
+getifloatarg(args, nargs, i, p_arg)
+	register object *args;
+	int nargs, i;
+	float *p_arg;
+{
+	object *v;
+	float x;
+	if (!getiobjectarg(args, nargs, i, &v))
+		return 0;
+	if (!extractfloat(v, &x))
+		return 0;
+	*p_arg = x;
+	return 1;
+}
+
+int
+getistringarg(args, nargs, i, p_arg)
+	object *args;
+	int nargs, i;
+	string *p_arg;
+{
+	object *v;
+	if (!getiobjectarg(args, nargs, i, &v))
+		return NULL;
+	if (!is_stringobject(v)) {
+		return err_badarg();
+	}
+	*p_arg = getstringvalue(v);
+	return 1;
+}
+
+int
+getichararg(args, nargs, i, p_arg)
+	object *args;
+	int nargs, i;
+	char *p_arg;
+{
+	string x;
+	if (!getistringarg(args, nargs, i, &x))
+		return 0;
+	if (x[0] == '\0' || x[1] != '\0') {
+		/* Not exactly one char */
+		return err_badarg();
+	}
+	*p_arg = x[0];
+	return 1;
+}
+
+int
+getilongarraysize(args, nargs, i, p_arg)
+	object *args;
+	int nargs, i;
+	long *p_arg;
+{
+	object *v;
+	if (!getiobjectarg(args, nargs, i, &v))
+		return 0;
+	if (is_tupleobject(v)) {
+		*p_arg = gettuplesize(v);
+		return 1;
+	}
+	if (is_listobject(v)) {
+		*p_arg = getlistsize(v);
+		return 1;
+	}
+	return err_badarg();
+}
+
+int
+getishortarraysize(args, nargs, i, p_arg)
+	object *args;
+	int nargs, i;
+	short *p_arg;
+{
+	long x;
+	if (!getilongarraysize(args, nargs, i, &x))
+		return 0;
+	*p_arg = x;
+	return 1;
+}
+
+/* XXX The following four are too similar.  Should share more code. */
+
+int
+getilongarray(args, nargs, i, n, p_arg)
+	object *args;
+	int nargs, i;
+	int n;
+	long *p_arg; /* [n] */
+{
+	object *v, *w;
+	if (!getiobjectarg(args, nargs, i, &v))
+		return 0;
+	if (is_tupleobject(v)) {
+		if (gettuplesize(v) != n) {
+			return err_badarg();
+		}
+		for (i = 0; i < n; i++) {
+			w = gettupleitem(v, i);
+			if (!is_intobject(w)) {
+				return err_badarg();
+			}
+			p_arg[i] = getintvalue(w);
+		}
+		return 1;
+	}
+	else if (is_listobject(v)) {
+		if (getlistsize(v) != n) {
+			return err_badarg();
+		}
+		for (i = 0; i < n; i++) {
+			w = getlistitem(v, i);
+			if (!is_intobject(w)) {
+				return err_badarg();
+			}
+			p_arg[i] = getintvalue(w);
+		}
+		return 1;
+	}
+	else {
+		return err_badarg();
+	}
+}
+
+int
+getishortarray(args, nargs, i, n, p_arg)
+	object *args;
+	int nargs, i;
+	int n;
+	short *p_arg; /* [n] */
+{
+	object *v, *w;
+	if (!getiobjectarg(args, nargs, i, &v))
+		return 0;
+	if (is_tupleobject(v)) {
+		if (gettuplesize(v) != n) {
+			return err_badarg();
+		}
+		for (i = 0; i < n; i++) {
+			w = gettupleitem(v, i);
+			if (!is_intobject(w)) {
+				return err_badarg();
+			}
+			p_arg[i] = getintvalue(w);
+		}
+		return 1;
+	}
+	else if (is_listobject(v)) {
+		if (getlistsize(v) != n) {
+			return err_badarg();
+		}
+		for (i = 0; i < n; i++) {
+			w = getlistitem(v, i);
+			if (!is_intobject(w)) {
+				return err_badarg();
+			}
+			p_arg[i] = getintvalue(w);
+		}
+		return 1;
+	}
+	else {
+		return err_badarg();
+	}
+}
+
+int
+getidoublearray(args, nargs, i, n, p_arg)
+	object *args;
+	int nargs, i;
+	int n;
+	double *p_arg; /* [n] */
+{
+	object *v, *w;
+	if (!getiobjectarg(args, nargs, i, &v))
+		return 0;
+	if (is_tupleobject(v)) {
+		if (gettuplesize(v) != n) {
+			return err_badarg();
+		}
+		for (i = 0; i < n; i++) {
+			w = gettupleitem(v, i);
+			if (!extractdouble(w, &p_arg[i]))
+				return 0;
+		}
+		return 1;
+	}
+	else if (is_listobject(v)) {
+		if (getlistsize(v) != n) {
+			return err_badarg();
+		}
+		for (i = 0; i < n; i++) {
+			w = getlistitem(v, i);
+			if (!extractdouble(w, &p_arg[i]))
+				return 0;
+		}
+		return 1;
+	}
+	else {
+		return err_badarg();
+	}
+}
+
+int
+getifloatarray(args, nargs, i, n, p_arg)
+	object *args;
+	int nargs, i;
+	int n;
+	float *p_arg; /* [n] */
+{
+	object *v, *w;
+	if (!getiobjectarg(args, nargs, i, &v))
+		return 0;
+	if (is_tupleobject(v)) {
+		if (gettuplesize(v) != n) {
+			return err_badarg();
+		}
+		for (i = 0; i < n; i++) {
+			w = gettupleitem(v, i);
+			if (!extractfloat(w, &p_arg[i]))
+				return 0;
+		}
+		return 1;
+	}
+	else if (is_listobject(v)) {
+		if (getlistsize(v) != n) {
+			return err_badarg();
+		}
+		for (i = 0; i < n; i++) {
+			w = getlistitem(v, i);
+			if (!extractfloat(w, &p_arg[i]))
+				return 0;
+		}
+		return 1;
+	}
+	else {
+		return err_badarg();
+	}
+}

Python/errors.c

@@ -0,0 +1,111 @@
+/* Error handling -- see also run.c */
+
+/* New error handling interface.
+
+   The following problem exists (existed): methods of built-in modules
+   are called with 'self' and 'args' arguments, but without a context
+   argument, so they have no way to raise a specific exception.
+   The same is true for the object implementations: no context argument.
+   The old convention was to set 'errno' and to return NULL.
+   The caller (usually call_function() in eval.c) detects the NULL
+   return value and then calls puterrno(ctx) to turn the errno value
+   into a true exception.  Problems with this approach are:
+   - it used standard errno values to indicate Python-specific errors,
+     but this means that when such an error code is reported by UNIX the
+     user gets a confusing message
+   - errno is a global variable, which makes extensions to a multi-
+     threading environment difficult; e.g., in IRIX, multi-threaded
+     programs must use the function getoserror() (sp.?) instead of
+     looking in errno
+   - there is no portable way to add new error numbers for specic
+     situations -- the value space for errno is reserved to the OS, yet
+     the way to turn module-specific errors into a module-specific
+     exception requires module-specific values for errno
+   - there is no way to add a more situation-specific message to an
+     error.
+  
+  The new interface solves all these problems.  To return an error, a
+  built-in function calls err_set(exception), err_set(valexception,
+  value) or err_setstr(exception, string), and returns NULL.  These
+  functions save the value for later use by puterrno().  To adapt this
+  scheme to a multi-threaded environment, only the implementation of
+  err_setval() has to be changed.
+*/
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "errors.h"
+
+/* Last exception stored by err_setval() */
+
+static object *last_exception;
+static object *last_exc_val;
+
+void
+err_setval(exception, value)
+	object *exception;
+	object *value;
+{
+	if (last_exception != NULL)
+		DECREF(last_exception);
+	if (exception != NULL)
+		INCREF(exception);
+	last_exception = exception;
+	
+	if (last_exc_val != NULL)
+		DECREF(last_exc_val);
+	if (value != NULL)
+		INCREF(value);
+	last_exc_val = value;
+}
+
+void
+err_set(exception)
+	object *exception;
+{
+	err_setval(exception, (object *)NULL);
+}
+
+void
+err_setstr(exception, string)
+	object *exception;
+	char *string;
+{
+	object *value = newstringobject(string);
+	err_setval(exception, value);
+	if (value != NULL)
+		DECREF(value);
+}
+
+int
+err_occurred()
+{
+	return last_exception != NULL;
+}
+
+void
+err_get(p_exc, p_val)
+	object **p_exc;
+	object **p_val;
+{
+	*p_exc = last_exception;
+	last_exception = NULL;
+	*p_val = last_exc_val;
+	last_exc_val = NULL;
+}
+
+void
+err_clear()
+{
+	if (last_exception != NULL) {
+		DECREF(last_exception);
+		last_exception = NULL;
+	}
+	if (last_exc_val != NULL) {
+		DECREF(last_exc_val);
+		last_exc_val = NULL;
+	}
+}

Python/fmod.c

@@ -0,0 +1,27 @@
+/* Portable fmod(x, y) implementation for systems that don't have it */
+
+#include <math.h>
+#include <errno.h>
+
+extern int errno;
+
+double
+fmod(x, y)
+	double x, y;
+{
+	double i, f;
+	
+	if (y == 0.0) {
+		errno = EDOM;
+		return 0.0;
+	}
+	
+	/* return f such that x = i*y + f for some integer i
+	   such that |f| < |y| and f has the same sign as x */
+	
+	i = floor(x/y);
+	f = x - i*y;
+	if ((x < 0.0) != (y < 0.0))
+		f = f-y;
+	return f;
+}

Python/import.c

@@ -0,0 +1,252 @@
+/* Module definition and import implementation */
+
+#include <stdio.h>
+#include "string.h"
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "listobject.h"
+#include "dictobject.h"
+#include "moduleobject.h"
+#include "node.h"
+#include "context.h"
+#include "token.h"
+#include "graminit.h"
+#include "run.h"
+#include "support.h"
+#include "import.h"
+#include "errcode.h"
+#include "sysmodule.h"
+
+/* Define pathname separator and delimiter in $PYTHONPATH */
+
+#ifdef THINK_C
+#define SEP ':'
+#define DELIM ' '
+#endif
+
+#ifndef SEP
+#define SEP '/'
+#endif
+
+#ifndef DELIM
+#define DELIM ':'
+#endif
+
+void
+initimport()
+{
+	object *v;
+	if ((v = newdictobject()) == NULL)
+		fatal("no mem for module table");
+	if (sysset("modules", v) != 0)
+		fatal("can't assign sys.modules");
+}
+
+object *
+new_module(name)
+	char *name;
+{
+	object *m;
+	object *mtab;
+	mtab = sysget("modules");
+	if (mtab == NULL || !is_dictobject(mtab)) {
+		errno = EBADF;
+		return NULL;
+	}
+	m = newmoduleobject(name);
+	if (m == NULL)
+		return NULL;
+	if (dictinsert(mtab, name, m) != 0) {
+		DECREF(m);
+		return NULL;
+	}
+	return m;
+}
+
+void
+define_module(ctx, name)
+	context *ctx;
+	char *name;
+{
+	object *m, *d;
+	m = new_module(name);
+	if (m == NULL) {
+		puterrno(ctx);
+		return;
+	}
+	d = getmoduledict(m);
+	INCREF(d);
+	DECREF(ctx->ctx_locals);
+	ctx->ctx_locals = d;
+	INCREF(d);
+	DECREF(ctx->ctx_globals);
+	ctx->ctx_globals = d;
+	DECREF(m);
+}
+
+object *
+parsepath(path, delim)
+	char *path;
+	int delim;
+{
+	int i, n;
+	char *p;
+	object *v, *w;
+	
+	n = 1;
+	p = path;
+	while ((p = strchr(p, delim)) != NULL) {
+		n++;
+		p++;
+	}
+	v = newlistobject(n);
+	if (v == NULL)
+		return NULL;
+	for (i = 0; ; i++) {
+		p = strchr(path, delim);
+		if (p == NULL)
+			p = strchr(path, '\0'); /* End of string */
+		w = newsizedstringobject(path, (int) (p - path));
+		if (w == NULL) {
+			DECREF(v);
+			return NULL;
+		}
+		setlistitem(v, i, w);
+		if (*p == '\0')
+			break;
+		path = p+1;
+	}
+	return v;
+}
+
+void
+setpythonpath(path)
+	char *path;
+{
+	object *v;
+	if ((v = parsepath(path, DELIM)) != NULL) {
+		if (sysset("path", v) != 0)
+			fatal("can't assign sys.path");
+		DECREF(v);
+	}
+}
+
+static FILE *
+open_module(name, suffix)
+	char *name;
+	char *suffix;
+{
+	object *path;
+	char namebuf[256];
+	FILE *fp;
+	
+	path = sysget("path");
+	if (path == NULL || !is_listobject(path)) {
+		strcpy(namebuf, name);
+		strcat(namebuf, suffix);
+		fp = fopen(namebuf, "r");
+	}
+	else {
+		int npath = getlistsize(path);
+		int i;
+		fp = NULL;
+		for (i = 0; i < npath; i++) {
+			object *v = getlistitem(path, i);
+			int len;
+			if (!is_stringobject(v))
+				continue;
+			strcpy(namebuf, getstringvalue(v));
+			len = getstringsize(v);
+			if (len > 0 && namebuf[len-1] != SEP)
+				namebuf[len++] = SEP;
+			strcpy(namebuf+len, name); /* XXX check for overflow */
+			strcat(namebuf, suffix); /* XXX ditto */
+			fp = fopen(namebuf, "r");
+			if (fp != NULL)
+				break;
+		}
+	}
+	return fp;
+}
+
+static object *
+load_module(ctx, name)
+	context *ctx;
+	char *name;
+{
+	object *m;
+	char **p;
+	FILE *fp;
+	node *n, *mh;
+	int err;
+	object *mtab;
+	object *save_locals, *save_globals;
+	
+	mtab = sysget("modules");
+	if (mtab == NULL || !is_dictobject(mtab)) {
+		errno = EBADF;
+		return NULL;
+	}
+	fp = open_module(name, ".py");
+	if (fp == NULL) {
+		/* XXX Compatibility hack */
+		fprintf(stderr,
+			"Can't find '%s.py' in sys.path, trying '%s'\n",
+			name, name);
+		fp = open_module(name, "");
+	}
+	if (fp == NULL) {
+		name_error(ctx, name);
+		return NULL;
+	}
+#ifdef DEBUG
+	fprintf(stderr, "Reading module %s from file '%s'\n", name, namebuf);
+#endif
+	err = parseinput(fp, file_input, &n);
+	fclose(fp);
+	if (err != E_DONE) {
+		input_error(ctx, err);
+		return NULL;
+	}
+	save_locals = ctx->ctx_locals;
+	INCREF(save_locals);
+	save_globals = ctx->ctx_globals;
+	INCREF(save_globals);
+	define_module(ctx, name);
+	exec_node(ctx, n);
+	DECREF(ctx->ctx_locals);
+	ctx->ctx_locals = save_locals;
+	DECREF(ctx->ctx_globals);
+	ctx->ctx_globals = save_globals;
+	/* XXX need to free the tree n here; except referenced defs */
+	if (ctx->ctx_exception) {
+		dictremove(mtab, name); /* Undefine the module */
+		return NULL;
+	}
+	m = dictlookup(mtab, name);
+	if (m == NULL) {
+		error(ctx, "module not defined after loading");
+		return NULL;
+	}
+	return m;
+}
+
+object *
+import_module(ctx, name)
+	context *ctx;
+	char *name;
+{
+	object *m;
+	object *mtab;
+	mtab = sysget("modules");
+	if (mtab == NULL || !is_dictobject(mtab)) {
+		error(ctx, "bad sys.modules");
+		return NULL;
+	}
+	if ((m = dictlookup(mtab, name)) == NULL) {
+		m = load_module(ctx, name);
+	}
+	return m;
+}

Python/modsupport.c

@@ -0,0 +1,398 @@
+/* Module support implementation */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+#include "listobject.h"
+#include "methodobject.h"
+#include "moduleobject.h"
+#include "modsupport.h"
+#include "import.h"
+#include "errors.h"
+
+
+/* Find a method in a module's method table.
+   Usually called from a module's getattr method. */
+
+object *
+findmethod(ml, op, name)
+	struct methodlist *ml;
+	object *op;
+	char *name;
+{
+	for (; ml->ml_name != NULL; ml++) {
+		if (strcmp(name, ml->ml_name) == 0)
+			return newmethodobject(ml->ml_name, ml->ml_meth, op);
+	}
+	err_setstr(NameError, name);
+	return NULL;
+}
+
+
+object *
+initmodule(name, methods)
+	char *name;
+	struct methodlist *methods;
+{
+	object *m, *d, *v;
+	struct methodlist *ml;
+	if ((m = new_module(name)) == NULL) {
+		fprintf(stderr, "initializing module: %s\n", name);
+		fatal("can't create a module");
+	}
+	d = getmoduledict(m);
+	for (ml = methods; ml->ml_name != NULL; ml++) {
+		v = newmethodobject(ml->ml_name, ml->ml_meth, (object *)NULL);
+		if (v == NULL || dictinsert(d, ml->ml_name, v) != 0) {
+			fprintf(stderr, "initializing module: %s\n", name);
+			fatal("can't initialize module");
+		}
+		DECREF(v);
+	}
+	DECREF(m);
+	return m; /* Yes, it still exists, in sys.modules... */
+}
+
+
+/* Convenience functions to set a type error exception and return 0 */
+
+int
+err_badarg()
+{
+	err_setstr(TypeError, "illegal argument type for built-in function");
+	return 0;
+}
+
+object *
+err_nomem()
+{
+	err_setstr(MemoryError, "in built-in function");
+	return NULL;
+}
+
+/* Argument list handling tools.
+   All return 1 for success, or call err_set*() and return 0 for failure */
+
+int
+getnoarg(v)
+	object *v;
+{
+	if (v != NULL) {
+		return err_badarg();
+	}
+	return 1;
+}
+
+int
+getintarg(v, a)
+	object *v;
+	int *a;
+{
+	if (v == NULL || !is_intobject(v)) {
+		return err_badarg();
+	}
+	*a = getintvalue(v);
+	return 1;
+}
+
+int
+getintintarg(v, a, b)
+	object *v;
+	int *a;
+	int *b;
+{
+	if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+		return err_badarg();
+	}
+	return getintarg(gettupleitem(v, 0), a) &&
+		getintarg(gettupleitem(v, 1), b);
+}
+
+int
+getlongarg(v, a)
+	object *v;
+	long *a;
+{
+	if (v == NULL || !is_intobject(v)) {
+		return err_badarg();
+	}
+	*a = getintvalue(v);
+	return 1;
+}
+
+int
+getlonglongargs(v, a, b)
+	object *v;
+	long *a, *b;
+{
+	if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+		return err_badarg();
+	}
+	return getlongarg(gettupleitem(v, 0), a) &&
+		getlongarg(gettupleitem(v, 1), b);
+}
+
+int
+getlonglongobjectargs(v, a, b, c)
+	object *v;
+	long *a, *b;
+	object **c;
+{
+	if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
+		return err_badarg();
+	}
+	if (getlongarg(gettupleitem(v, 0), a) &&
+		getlongarg(gettupleitem(v, 1), b)) {
+		*c = gettupleitem(v, 2);
+		return 1;
+	}
+	else {
+		return err_badarg();
+	}
+}
+
+int
+getstrarg(v, a)
+	object *v;
+	object **a;
+{
+	if (v == NULL || !is_stringobject(v)) {
+		return err_badarg();
+	}
+	*a = v;
+	return 1;
+}
+
+int
+getstrstrarg(v, a, b)
+	object *v;
+	object **a;
+	object **b;
+{
+	if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+		return err_badarg();
+	}
+	return getstrarg(gettupleitem(v, 0), a) &&
+		getstrarg(gettupleitem(v, 1), b);
+}
+
+int
+getstrstrintarg(v, a, b, c)
+	object *v;
+	object **a;
+	object **b;
+	int *c;
+{
+	if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
+		return err_badarg();
+	}
+	return getstrarg(gettupleitem(v, 0), a) &&
+		getstrarg(gettupleitem(v, 1), b) &&
+		getintarg(gettupleitem(v, 2), c);
+}
+
+int
+getstrintarg(v, a, b)
+	object *v;
+	object **a;
+	int *b;
+{
+	if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+		return err_badarg();
+	}
+	return getstrarg(gettupleitem(v, 0), a) &&
+		getintarg(gettupleitem(v, 1), b);
+}
+
+int
+getintstrarg(v, a, b)
+	object *v;
+	int *a;
+	object **b;
+{
+	if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+		return err_badarg();
+	}
+	return getintarg(gettupleitem(v, 0), a) &&
+		getstrarg(gettupleitem(v, 1), b);
+}
+
+int
+getpointarg(v, a)
+	object *v;
+	int *a; /* [2] */
+{
+	return getintintarg(v, a, a+1);
+}
+
+int
+get3pointarg(v, a)
+	object *v;
+	int *a; /* [6] */
+{
+	if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
+		return err_badarg();
+	}
+	return getpointarg(gettupleitem(v, 0), a) &&
+		getpointarg(gettupleitem(v, 1), a+2) &&
+		getpointarg(gettupleitem(v, 2), a+4);
+}
+
+int
+getrectarg(v, a)
+	object *v;
+	int *a; /* [2+2] */
+{
+	if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+		return err_badarg();
+	}
+	return getpointarg(gettupleitem(v, 0), a) &&
+		getpointarg(gettupleitem(v, 1), a+2);
+}
+
+int
+getrectintarg(v, a)
+	object *v;
+	int *a; /* [4+1] */
+{
+	if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+		return err_badarg();
+	}
+	return getrectarg(gettupleitem(v, 0), a) &&
+		getintarg(gettupleitem(v, 1), a+4);
+}
+
+int
+getpointintarg(v, a)
+	object *v;
+	int *a; /* [2+1] */
+{
+	if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+		return err_badarg();
+	}
+	return getpointarg(gettupleitem(v, 0), a) &&
+		getintarg(gettupleitem(v, 1), a+2);
+}
+
+int
+getpointstrarg(v, a, b)
+	object *v;
+	int *a; /* [2] */
+	object **b;
+{
+	if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+		return err_badarg();
+	}
+	return getpointarg(gettupleitem(v, 0), a) &&
+		getstrarg(gettupleitem(v, 1), b);
+}
+
+int
+getstrintintarg(v, a, b, c)
+	object *v;
+	object *a;
+	int *b, *c;
+{
+	if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
+		return err_badarg();
+	}
+	return getstrarg(gettupleitem(v, 0), a) &&
+		getintarg(gettupleitem(v, 1), b) &&
+		getintarg(gettupleitem(v, 2), c);
+}
+
+int
+getrectpointarg(v, a)
+	object *v;
+	int *a; /* [4+2] */
+{
+	if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+		return err_badarg();
+	}
+	return getrectarg(gettupleitem(v, 0), a) &&
+		getpointarg(gettupleitem(v, 1), a+4);
+}
+
+int
+getlongtuplearg(args, a, n)
+	object *args;
+	long *a; /* [n] */
+	int n;
+{
+	int i;
+	if (!is_tupleobject(args) || gettuplesize(args) != n) {
+		return err_badarg();
+	}
+	for (i = 0; i < n; i++) {
+		object *v = gettupleitem(args, i);
+		if (!is_intobject(v)) {
+			return err_badarg();
+		}
+		a[i] = getintvalue(v);
+	}
+	return 1;
+}
+
+int
+getshorttuplearg(args, a, n)
+	object *args;
+	short *a; /* [n] */
+	int n;
+{
+	int i;
+	if (!is_tupleobject(args) || gettuplesize(args) != n) {
+		return err_badarg();
+	}
+	for (i = 0; i < n; i++) {
+		object *v = gettupleitem(args, i);
+		if (!is_intobject(v)) {
+			return err_badarg();
+		}
+		a[i] = getintvalue(v);
+	}
+	return 1;
+}
+
+int
+getlonglistarg(args, a, n)
+	object *args;
+	long *a; /* [n] */
+	int n;
+{
+	int i;
+	if (!is_listobject(args) || getlistsize(args) != n) {
+		return err_badarg();
+	}
+	for (i = 0; i < n; i++) {
+		object *v = getlistitem(args, i);
+		if (!is_intobject(v)) {
+			return err_badarg();
+		}
+		a[i] = getintvalue(v);
+	}
+	return 1;
+}
+
+int
+getshortlistarg(args, a, n)
+	object *args;
+	short *a; /* [n] */
+	int n;
+{
+	int i;
+	if (!is_listobject(args) || getlistsize(args) != n) {
+		return err_badarg();
+	}
+	for (i = 0; i < n; i++) {
+		object *v = getlistitem(args, i);
+		if (!is_intobject(v)) {
+			return err_badarg();
+		}
+		a[i] = getintvalue(v);
+	}
+	return 1;
+}

Python/pythonmain.c

@@ -0,0 +1,297 @@
+/* Python interpreter main program */
+
+/* XXX This is still a mess */
+
+#ifdef THINK_C
+#define USE_STDWIN
+#endif
+
+#include <stdio.h>
+#include <ctype.h>
+#include "string.h"
+
+#ifdef USE_STDWIN
+#include "stdwin.h"
+int use_stdwin;
+#endif
+
+extern char *getenv();
+
+#include "PROTO.h"
+#include "grammar.h"
+#include "node.h"
+#include "parsetok.h"
+#include "graminit.h"
+#include "errcode.h"
+#include "object.h"
+#include "stringobject.h"
+#include "sysmodule.h"
+
+extern grammar gram; /* From graminit.c */
+
+#ifndef PYTHONPATH
+
+#ifdef THINK_C
+
+#define PYTHONPATH ": :mod"
+
+#else /* !THINK_C */
+
+#ifdef AMOEBA
+#define PYTHONPATH ".:/profile/module/python"
+#else /* !AMOEBA */
+#define PYTHONPATH ".:/usr/local/lib/python"
+#endif /* !AMOEBA */
+
+#endif /* !THINK_C */
+
+#endif /* !PYTHONPATH */
+
+int debugging;
+
+main(argc, argv)
+	int argc;
+	char **argv;
+{
+	char *path;
+	char *filename = NULL;
+	FILE *fp = stdin;
+	int ret;
+	
+#ifdef USE_STDWIN
+#ifdef THINK_C
+	wsetstdio(1);
+#else THINK_C
+	/* Must use "python -s" now to get stdwin support */
+	if (argc > 1 && strcmp(argv[1], "-s") == 0)
+		argv[1] = argv[0],
+		argc--, argv++,
+#endif /* !THINK_C */
+		use_stdwin = 1;
+	if (use_stdwin)
+		winitargs(&argc, &argv);
+#endif /* USE_STDWIN */
+	
+#ifdef THINK_C_not_today
+	printf("argc = %d, argv[0] = '%s'\n", argc, argv[0]);
+	if (argc <= 1)
+		askargs(&argc, &argv);
+#endif
+	
+	initintr(); /* For intrcheck() */
+	
+	if (argc > 1 && strcmp(argv[1], "-") != 0)
+		filename = argv[1];
+
+	if (filename != NULL) {
+		if ((fp = fopen(filename, "r")) == NULL) {
+			fprintf(stderr, "python: can't open file '%s'\n",
+				filename);
+			exit(2);
+		}
+	}
+	
+	/* XXX what is the ideal initialization order? */
+	
+	initsys(argc-1, argv+1);
+	inittime();
+	initmath();
+	
+#ifndef THINK_C
+	path = getenv("PYTHONPATH");
+	if (path == NULL)
+#endif
+		path = PYTHONPATH;
+	setpythonpath(path);
+	
+	initrun();
+	
+#ifdef USE_POSIX
+	initposix();
+#endif
+
+#ifdef THINK_C
+	initmac();
+#endif
+
+#ifdef USE_AUDIO
+	initaudio();
+#endif
+	
+#ifdef USE_AMOEBA
+	initamoeba();
+#endif
+	
+#ifdef USE_STDWIN
+	if (use_stdwin)
+		initstdwin();
+#endif
+	
+#ifdef USE_GL
+	initgl();
+#endif
+	
+#ifdef USE_PANEL
+	initpanel();
+#endif
+	
+	if (!isatty(fileno(fp))) {
+		ret = runfile(fp, file_input, (char *)NULL, (char *)NULL);
+	}
+	else {
+		sysset("ps1", newstringobject(">>> "));
+		sysset("ps2", newstringobject("... "));
+		for (;;) {
+			object *v = sysget("ps1"), *w = sysget("ps2");
+			char *ps1 = NULL, *ps2 = NULL;
+			if (v != NULL && is_stringobject(v)) {
+				INCREF(v);
+				ps1 = getstringvalue(v);
+			}
+			else
+				v = NULL;
+			if (w != NULL && is_stringobject(w)) {
+				INCREF(w);
+				ps2 = getstringvalue(w);
+			}
+			else
+				w = NULL;
+			ret = runfile(fp, single_input, ps1, ps2);
+			if (v != NULL)
+				DECREF(v);
+			if (w != NULL)
+				DECREF(w);
+			if (ret == E_EOF || ret == E_NOMEM)
+				break;
+		}
+	}
+	goaway(ret == E_DONE || ret == E_EOF ? 0 : 1);
+	/*NOTREACHED*/
+}
+
+goaway(sts)
+	int sts;
+{
+	closerun();
+#ifdef USE_STDWIN
+	if (use_stdwin)
+		wdone();
+#endif
+#ifdef THINK_C
+#ifndef TRACE_REFS
+	/* Avoid 'click mouse to continue' in Lightspeed C */
+	if (sts == 0)
+		Click_On(0);
+#endif
+#endif	
+	exit(sts);
+	/*NOTREACHED*/
+}
+
+/* Parse input from a file and execute it */
+
+static int
+runfile(fp, start, ps1, ps2)
+	FILE *fp;
+	int start;
+	char *ps1, *ps2;
+{
+	node *n;
+	int ret;
+	ret = parsefile(fp, &gram, start, ps1, ps2, &n);
+	if (ret != E_DONE)
+		return ret;
+	return execute(n) == 0 ? E_DONE : E_ERROR;
+}
+
+#ifdef THINK_C
+
+/* Ask a yes/no question */
+
+int
+askyesno(prompt)
+	char *prompt;
+{
+	char buf[256];
+	
+	printf("%s [ny] ", prompt);
+	if (fgets(buf, sizeof buf, stdin) == NULL)
+		return 0;
+	return buf[0] == 'y' || buf[0] == 'Y';
+}
+
+/* Check for file descriptor connected to interactive device.
+   Pretend that stdin is always interactive, other files never. */
+
+int
+isatty(fd)
+	int fd;
+{
+	return fd == fileno(stdin);
+}
+
+/* Kludge to get arguments on the Mac */
+
+#define MAXARGS 20
+
+static char *
+nextarg(pnext)
+	char **pnext;
+{
+	char *ret;
+	char *p = *pnext;
+	while (isspace(*p))
+		p++;
+	if (*p == '\0')
+		return NULL;
+	ret = p;
+	while (!isspace(*p))
+		p++;
+	if (*p != '\0')
+		*p++ = '\0';
+	*pnext = p;
+	return ret;
+}
+
+static
+askargs(pargc, pargv)
+	int *pargc;
+	char ***pargv; /* sic */
+{
+	static char buf[256];
+	static char *argv[MAXARGS];
+	int argc;
+	char *p, *next;
+	fprintf(stderr, "Args: ");
+	if (fgets(buf, sizeof buf, stdin) == NULL)
+		return;
+	next = buf;
+	if ((p = nextarg(&next)) == NULL)
+		return;
+	if (*pargc > 0)
+		argv[0] = (*pargv)[0];
+	else
+		argv[0] = "PYTHON";
+	argc = 1;
+	argv[argc++] = p;
+	while (argc+1 < MAXARGS && (p = nextarg(&next)) != NULL)
+		argv[argc++] = p;
+	argv[argc] = NULL;
+	*pargc = argc;
+	*pargv = argv;
+}
+
+#endif
+
+/*	WISH LIST
+
+	- improved per-module error handling; different use of errno
+	- possible new types:
+		- iterator (for range, keys, ...)
+	- improve interpreter error handling, e.g., true tracebacks
+	- release parse trees when no longer needed (make them objects?)
+	- faster parser (for long modules)
+	- save precompiled modules on file?
+	- fork threads, locking
+	- allow syntax extensions
+*/

Python/strerror.c

@@ -0,0 +1,18 @@
+/* PD implementation of strerror() for BSD derivatives that don't have it.
+   Author: Guido van Rossum, CWI Amsterdam, Oct. 1990, <guido@cwi.nl>. */
+
+#include <stdio.h>
+
+extern int sys_nerr;
+extern char *sys_errlist[];
+
+char *
+strerror(err)
+	int err;
+{
+	static char buf[20];
+	if (err >= 0 && err < sys_nerr)
+		return sys_errlist[err];
+	sprintf(buf, "Unknown errno %d", err);
+	return buf;
+}

Python/sysmodule.c

@@ -0,0 +1,156 @@
+/* System module */
+
+/*
+Various bits of information used by the interpreter are collected in
+module 'sys'.
+Data members:
+- stdin, stdout, stderr: standard file objects
+- ps1, ps2: primary and secondary prompts (strings)
+- path: module search path (list of strings)
+- modules: the table of modules (dictionary)
+Function members:
+- exit(sts): call exit()
+*/
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "stringobject.h"
+#include "listobject.h"
+#include "dictobject.h"
+#include "fileobject.h"
+#include "moduleobject.h"
+#include "sysmodule.h"
+#include "node.h" /* For context.h */
+#include "context.h" /* For import.h */
+#include "import.h"
+#include "methodobject.h"
+#include "modsupport.h"
+#include "errors.h"
+
+static object *sysdict;
+
+object *
+sysget(name)
+	char *name;
+{
+	return dictlookup(sysdict, name);
+}
+
+FILE *
+sysgetfile(name, def)
+	char *name;
+	FILE *def;
+{
+	FILE *fp = NULL;
+	object *v = sysget(name);
+	if (v != NULL)
+		fp = getfilefile(v);
+	if (fp == NULL)
+		fp = def;
+	return fp;
+}
+
+int
+sysset(name, v)
+	char *name;
+	object *v;
+{
+	if (v == NULL)
+		return dictremove(sysdict, name);
+	else
+		return dictinsert(sysdict, name, v);
+}
+
+static object *
+makeargv(argc, argv)
+	int argc;
+	char **argv;
+{
+	int i;
+	object *av, *v;
+	if (argc < 0 || argv == NULL)
+		argc = 0;
+	av = newlistobject(argc);
+	if (av != NULL) {
+		for (i = 0; i < argc; i++) {
+			v = newstringobject(argv[i]);
+			if (v == NULL) {
+				DECREF(av);
+				av = NULL;
+				break;
+			}
+			setlistitem(av, i, v);
+		}
+	}
+	if (av == NULL)
+		fatal("no mem for sys.argv");
+	return av;
+}
+
+/* sys.exit method */
+
+static object *
+sys_exit(self, args)
+	object *self;
+	object *args;
+{
+	int sts;
+	if (!getintarg(args, &sts))
+		return NULL;
+	goaway(sts);
+	exit(sts); /* Just in case */
+	/* NOTREACHED */
+}
+
+static object *sysin, *sysout, *syserr;
+
+void
+initsys(argc, argv)
+	int argc;
+	char **argv;
+{
+	object *v;
+	object *exit;
+	if ((sysdict = newdictobject()) == NULL)
+		fatal("can't create sys dict");
+	/* NB keep an extra ref to the std files to avoid closing them
+	   when the user deletes them */
+	sysin = newopenfileobject(stdin, "<stdin>", "r");
+	sysout = newopenfileobject(stdout, "<stdout>", "w");
+	syserr = newopenfileobject(stderr, "<stderr>", "w");
+	v = makeargv(argc, argv);
+	exit = newmethodobject("exit", sys_exit, (object *)NULL);
+	if (err_occurred())
+		fatal("can't create sys.* objects");
+	dictinsert(sysdict, "stdin", sysin);
+	dictinsert(sysdict, "stdout", sysout);
+	dictinsert(sysdict, "stderr", syserr);
+	dictinsert(sysdict, "argv", v);
+	dictinsert(sysdict, "exit", exit);
+	if (err_occurred())
+		fatal("can't insert sys.* objects in sys dict");
+	DECREF(v);
+	/* The other symbols are added elsewhere */
+	
+	/* Only now can we initialize the import stuff, after which
+	   we can turn ourselves into a module */
+	initimport();
+	if ((v = new_module("sys")) == NULL)
+		fatal("can't create sys module");
+	if (setmoduledict(v, sysdict) != 0)
+		fatal("can't assign sys dict to sys module");
+}
+
+void
+closesys()
+{
+	object *mtab;
+	mtab = sysget("modules");
+	if (mtab != NULL && is_dictobject(mtab))
+		dictremove(mtab, "sys"); /* Get rid of recursion */
+	else
+		fprintf(stderr, "[module sys not found]\n");
+	DECREF(sysdict);
+}