Initial revision

1 files changed, 369 insertions, 0 deletions

diff --git a/Modules/cgensupport.c b/Modules/cgensupport.c
new file mode 100644
index 0000000..a81c90b
--- /dev/null
+++ b/Modules/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();
+	}
+}