Initial revision

Modules/cgen.py

@@ -0,0 +1,458 @@
+# Python script to parse cstubs file for gl and generate C stubs.
+# usage: python cgen <cstubs >glmodule.c
+#
+# XXX BUG return arrays generate wrong code
+# XXX need to change error returns into gotos to free mallocked arrays
+
+
+import string
+import sys
+
+
+# Function to print to stderr
+#
+def err(args):
+	savestdout = sys.stdout
+	try:
+		sys.stdout = sys.stderr
+		for i in args:
+			print i,
+		print
+	finally:
+		sys.stdout = savestdout
+
+
+# The set of digits that form a number
+#
+digits = '0123456789'
+
+
+# Function to extract a string of digits from the front of the string.
+# Returns the leading string of digits and the remaining string.
+# If no number is found, returns '' and the original string.
+#
+def getnum(s):
+	n = ''
+	while s[:1] in digits:
+		n = n + s[:1]
+		s = s[1:]
+	return n, s
+
+
+# Function to check if a string is a number
+#
+def isnum(s):
+	if not s: return 0
+	for c in s:
+		if not c in digits: return 0
+	return 1
+
+
+# Allowed function return types
+#
+return_types = ['void', 'short', 'long']
+
+
+# Allowed function argument types
+#
+arg_types = ['char', 'string', 'short', 'float', 'long', 'double']
+
+
+# Need to classify arguments as follows
+#	simple input variable
+#	simple output variable
+#	input array
+#	output array
+#	input giving size of some array
+#
+# Array dimensions can be specified as follows
+#	constant
+#	argN
+#	constant * argN
+#	retval
+#	constant * retval
+#
+# The dimensions given as constants * something are really
+# arrays of points where points are 2- 3- or 4-tuples
+#
+# We have to consider three lists:
+#	python input arguments
+#	C stub arguments (in & out)
+#	python output arguments (really return values)
+#
+# There is a mapping from python input arguments to the input arguments
+# of the C stub, and a further mapping from C stub arguments to the
+# python return values
+
+
+# Exception raised by checkarg() and generate()
+#
+arg_error = 'bad arg'
+
+
+# Function to check one argument.
+# Arguments: the type and the arg "name" (really mode plus subscript).
+# Raises arg_error if something's wrong.
+# Return type, mode, factor, rest of subscript; factor and rest may be empty.
+#
+def checkarg(type, arg):
+	#
+	# Turn "char *x" into "string x".
+	#
+	if type = 'char' and arg[0] = '*':
+		type = 'string'
+		arg = arg[1:]
+	#
+	# Check that the type is supported.
+	#
+	if type not in arg_types:
+		raise arg_error, ('bad type', type)
+	#
+	# Split it in the mode (first character) and the rest.
+	#
+	mode, rest = arg[:1], arg[1:]
+	#
+	# The mode must be 's' for send (= input) or 'r' for return argument.
+	#
+	if mode not in ('r', 's'):
+		raise arg_error, ('bad arg mode', mode)
+	#
+	# Is it a simple argument: if so, we are done.
+	#
+	if not rest:
+		return type, mode, '', ''
+	#	
+	# Not a simple argument; must be an array.
+	# The 'rest' must be a subscript enclosed in [ and ].
+	# The subscript must be one of the following forms,
+	# otherwise we don't handle it (where N is a number):
+	#	N
+	#	argN
+	#	retval
+	#	N*argN
+	#	N*retval
+	#
+	if rest[:1] <> '[' or rest[-1:] <> ']':
+		raise arg_error, ('subscript expected', rest)
+	sub = rest[1:-1]
+	#
+	# Is there a leading number?
+	#
+	num, sub = getnum(sub)
+	if num:
+		# There is a leading number
+		if not sub:
+			# The subscript is just a number
+			return type, mode, num, ''
+		if sub[:1] = '*':
+			# There is a factor prefix
+			sub = sub[1:]
+		else:
+			raise arg_error, ('\'*\' expected', sub)
+	if sub = 'retval':
+		# size is retval -- must be a reply argument
+		if mode <> 'r':
+			raise arg_error, ('non-r mode with [retval]', mode)
+	elif sub[:3] <> 'arg' or not isnum(sub[3:]):
+		raise arg_error, ('bad subscript', sub)
+	#
+	return type, mode, num, sub
+
+
+# List of functions for which we have generated stubs
+#
+functions = []
+
+
+# Generate the stub for the given function, using the database of argument
+# information build by successive calls to checkarg()
+#
+def generate(type, func, database):
+	#
+	# Check that we can handle this case:
+	# no variable size reply arrays yet
+	#
+	n_in_args = 0
+	n_out_args = 0
+	#
+	for a_type, a_mode, a_factor, a_sub in database:
+		if a_mode = 's':
+			n_in_args = n_in_args + 1
+		elif a_mode = 'r':
+			n_out_args = n_out_args + 1
+		else:
+			# Can't happen
+			raise arg_error, ('bad a_mode', a_mode)
+		if (a_mode = 'r' and a_sub) or a_sub = 'retval':
+			e = 'Function', func, 'too complicated:'
+			err(e + (a_type, a_mode, a_factor, a_sub))
+			print '/* XXX Too complicated to generate code for */'
+			return
+	#
+	functions.append(func)
+	#
+	# Stub header
+	#
+	print
+	print 'static object *'
+	print 'gl_' + func + '(self, args)'
+	print '\tobject *self;'
+	print '\tobject *args;'
+	print '{'
+	#
+	# Declare return value if any
+	#
+	if type <> 'void':
+		print '\t' + type, 'retval;'
+	#
+	# Declare arguments
+	#
+	for i in range(len(database)):
+		a_type, a_mode, a_factor, a_sub = database[i]
+		print '\t' + a_type,
+		if a_sub:
+			print '*',
+		print 'arg' + `i+1`,
+		if a_factor and not a_sub:
+			print '[', a_factor, ']',
+		print ';'
+	#
+	# Find input arguments derived from array sizes
+	#
+	for i in range(len(database)):
+		a_type, a_mode, a_factor, a_sub = database[i]
+		if a_mode = 's' and a_sub[:3] = 'arg' and isnum(a_sub[3:]):
+			# Sending a variable-length array
+			n = eval(a_sub[3:])
+			if 1 <= n <= len(database):
+			    b_type, b_mode, b_factor, b_sub = database[n-1]
+			    if b_mode = 's':
+			        database[n-1] = b_type, 'i', a_factor, `i`
+			        n_in_args = n_in_args - 1
+	#
+	# Assign argument positions in the Python argument list
+	#
+	in_pos = []
+	i_in = 0
+	for i in range(len(database)):
+		a_type, a_mode, a_factor, a_sub = database[i]
+		if a_mode = 's':
+			in_pos.append(i_in)
+			i_in = i_in + 1
+		else:
+			in_pos.append(-1)
+	#
+	# Get input arguments
+	#
+	for i in range(len(database)):
+		a_type, a_mode, a_factor, a_sub = database[i]
+		if a_mode = 'i':
+			#
+			# Implicit argument;
+			# a_factor is divisor if present,
+			# a_sub indicates which arg (`database index`)
+			#
+			j = eval(a_sub)
+			print '\tif',
+			print '(!geti' + a_type + 'arraysize(args,',
+			print `n_in_args` + ',',
+			print `in_pos[j]` + ',',
+			print '&arg' + `i+1` + '))'
+			print '\t\treturn NULL;'
+			if a_factor:
+				print '\targ' + `i+1`,
+				print '= arg' + `i+1`,
+				print '/', a_factor + ';'
+		elif a_mode = 's':
+			if a_sub: # Allocate memory for varsize array
+				print '\tif ((arg' + `i+1`, '=',
+				print 'NEW(' + a_type + ',',
+				if a_factor: print a_factor, '*',
+				print a_sub, ')) == NULL)'
+				print '\t\treturn err_nomem();'
+			print '\tif',
+			if a_factor or a_sub: # Get a fixed-size array array
+				print '(!geti' + a_type + 'array(args,',
+				print `n_in_args` + ',',
+				print `in_pos[i]` + ',',
+				if a_factor: print a_factor,
+				if a_factor and a_sub: print '*',
+				if a_sub: print a_sub,
+				print ', arg' + `i+1` + '))'
+			else: # Get a simple variable
+				print '(!geti' + a_type + 'arg(args,',
+				print `n_in_args` + ',',
+				print `in_pos[i]` + ',',
+				print '&arg' + `i+1` + '))'
+			print '\t\treturn NULL;'
+	#
+	# Begin of function call
+	#
+	if type <> 'void':
+		print '\tretval =', func + '(',
+	else:
+		print '\t' + func + '(',
+	#
+	# Argument list
+	#
+	for i in range(len(database)):
+		if i > 0: print ',',
+		a_type, a_mode, a_factor, a_sub = database[i]
+		if a_mode = 'r' and not a_factor:
+			print '&',
+		print 'arg' + `i+1`,
+	#
+	# End of function call
+	#
+	print ');'
+	#
+	# Free varsize arrays
+	#
+	for i in range(len(database)):
+		a_type, a_mode, a_factor, a_sub = database[i]
+		if a_mode = 's' and a_sub:
+			print '\tDEL(arg' + `i+1` + ');'
+	#
+	# Return
+	#
+	if n_out_args:
+		#
+		# Multiple return values -- construct a tuple
+		#
+		if type <> 'void':
+			n_out_args = n_out_args + 1
+		if n_out_args = 1:
+			for i in range(len(database)):
+				a_type, a_mode, a_factor, a_sub = database[i]
+				if a_mode = 'r':
+					break
+			else:
+				raise arg_error, 'expected r arg not found'
+			print '\treturn',
+			print mkobject(a_type, 'arg' + `i+1`) + ';'
+		else:
+			print '\t{ object *v = newtupleobject(',
+			print n_out_args, ');'
+			print '\t  if (v == NULL) return NULL;'
+			i_out = 0
+			if type <> 'void':
+				print '\t  settupleitem(v,',
+				print `i_out` + ',',
+				print mkobject(type, 'retval') + ');'
+				i_out = i_out + 1
+			for i in range(len(database)):
+				a_type, a_mode, a_factor, a_sub = database[i]
+				if a_mode = 'r':
+					print '\t  settupleitem(v,',
+					print `i_out` + ',',
+					s = mkobject(a_type, 'arg' + `i+1`)
+					print s + ');'
+					i_out = i_out + 1
+			print '\t  return v;'
+			print '\t}'
+	else:
+		#
+		# Simple function return
+		# Return None or return value
+		#
+		if type = 'void':
+			print '\tINCREF(None);'
+			print '\treturn None;'
+		else:
+			print '\treturn', mkobject(type, 'retval') + ';'
+	#
+	# Stub body closing brace
+	#
+	print '}'
+
+
+# Subroutine to return a function call to mknew<type>object(<arg>)
+#
+def mkobject(type, arg):
+	return 'mknew' + type + 'object(' + arg + ')'
+
+
+# Input line number
+lno = 0
+
+
+# Input is divided in two parts, separated by a line containing '%%'.
+#	<part1>		-- literally copied to stdout
+#	<part2>		-- stub definitions
+
+# Variable indicating the current input part.
+#
+part = 1
+
+# Main loop over the input
+#
+while 1:
+	try:
+		line = raw_input()
+	except EOFError:
+		break
+	#
+	lno = lno+1
+	words = string.split(line)
+	#
+	if part = 1:
+		#
+		# In part 1, copy everything literally
+		# except look for a line of just '%%'
+		#
+		if words = ['%%']:
+			part = part + 1
+		else:
+			#
+			# Look for names of manually written
+			# stubs: a single percent followed by the name
+			# of the function in Python.
+			# The stub name is derived by prefixing 'gl_'.
+			#
+			if words and words[0][0] = '%':
+				func = words[0][1:]
+				if (not func) and words[1:]:
+					func = words[1]
+				if func:
+					functions.append(func)
+			else:
+				print line
+	elif not words:
+		pass			# skip empty line
+	elif words[0] = '#include':
+		print line
+	elif words[0][:1] = '#':
+		pass			# ignore comment
+	elif words[0] not in return_types:
+		err('Line', lno, ': bad return type :', words[0])
+	elif len(words) < 2:
+		err('Line', lno, ': no funcname :', line)
+	else:
+		if len(words) % 2 <> 0:
+			err('Line', lno, ': odd argument list :', words[2:])
+		else:
+			database = []
+			try:
+				for i in range(2, len(words), 2):
+					x = checkarg(words[i], words[i+1])
+					database.append(x)
+				print
+				print '/*',
+				for w in words: print w,
+				print '*/'
+				generate(words[0], words[1], database)
+			except arg_error, msg:
+				err('Line', lno, ':', msg)
+
+
+print
+print 'static struct methodlist gl_methods[] = {'
+for func in functions:
+	print '\t{"' + func + '", gl_' + func + '},'
+print '\t{NULL, NULL} /* Sentinel */'
+print '};'
+print
+print 'initgl()'
+print '{'
+print '\tinitmodule("gl", gl_methods);'
+print '}'

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();
+	}
+}

Modules/cgensupport.h

@@ -0,0 +1,15 @@
+/* Definitions used by cgen output */
+
+typedef char *string;
+
+#define mknewlongobject(x) newintobject(x)
+#define mknewshortobject(x) newintobject((long)x)
+#define mknewfloatobject(x) newfloatobject(x)
+
+extern object *mknewcharobject PROTO((int c));
+
+extern int getiobjectarg PROTO((object *args, int nargs, int i, object **p_a));
+extern int getilongarg PROTO((object *args, int nargs, int i, long *p_a));
+extern int getishortarg PROTO((object *args, int nargs, int i, short *p_a));
+extern int getifloatarg PROTO((object *args, int nargs, int i, float *p_a));
+extern int getistringarg PROTO((object *args, int nargs, int i, string *p_a));

Modules/mathmodule.c

@@ -0,0 +1,167 @@
+/* Math module -- standard C math library functions, pi and e */
+
+#include <stdio.h>
+#include <math.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "tupleobject.h"
+#include "floatobject.h"
+#include "dictobject.h"
+#include "methodobject.h"
+#include "moduleobject.h"
+#include "objimpl.h"
+#include "import.h"
+#include "modsupport.h"
+
+static int
+getdoublearg(args, px)
+	register object *args;
+	double *px;
+{
+	if (args == NULL)
+		return err_badarg();
+	if (is_floatobject(args)) {
+		*px = getfloatvalue(args);
+		return 1;
+	}
+	if (is_intobject(args)) {
+		*px = getintvalue(args);
+		return 1;
+	}
+	return err_badarg();
+}
+
+static int
+get2doublearg(args, px, py)
+	register object *args;
+	double *px, *py;
+{
+	if (args == NULL || !is_tupleobject(args) || gettuplesize(args) != 2)
+		return err_badarg();
+	return getdoublearg(gettupleitem(args, 0), px) &&
+		getdoublearg(gettupleitem(args, 1), py);
+}
+
+static object *
+math_1(args, func)
+	object *args;
+	double (*func) FPROTO((double));
+{
+	double x;
+	if (!getdoublearg(args, &x))
+		return NULL;
+	errno = 0;
+	x = (*func)(x);
+	if (errno != 0)
+		return NULL;
+	else
+		return newfloatobject(x);
+}
+
+static object *
+math_2(args, func)
+	object *args;
+	double (*func) FPROTO((double, double));
+{
+	double x, y;
+	if (!get2doublearg(args, &x, &y))
+		return NULL;
+	errno = 0;
+	x = (*func)(x, y);
+	if (errno != 0)
+		return NULL;
+	else
+		return newfloatobject(x);
+}
+
+#define FUNC1(stubname, func) \
+	static object * stubname(self, args) object *self, *args; { \
+		return math_1(args, func); \
+	}
+
+#define FUNC2(stubname, func) \
+	static object * stubname(self, args) object *self, *args; { \
+		return math_2(args, func); \
+	}
+
+FUNC1(math_acos, acos)
+FUNC1(math_asin, asin)
+FUNC1(math_atan, atan)
+FUNC2(math_atan2, atan2)
+FUNC1(math_ceil, ceil)
+FUNC1(math_cos, cos)
+FUNC1(math_cosh, cosh)
+FUNC1(math_exp, exp)
+FUNC1(math_fabs, fabs)
+FUNC1(math_floor, floor)
+#if 0
+/* XXX This one is not in the Amoeba library yet, so what the heck... */
+FUNC2(math_fmod, fmod)
+#endif
+FUNC1(math_log, log)
+FUNC1(math_log10, log10)
+FUNC2(math_pow, pow)
+FUNC1(math_sin, sin)
+FUNC1(math_sinh, sinh)
+FUNC1(math_sqrt, sqrt)
+FUNC1(math_tan, tan)
+FUNC1(math_tanh, tanh)
+
+#if 0
+/* What about these? */
+double	frexp(double x, int *i);
+double	ldexp(double x, int n);
+double	modf(double x, double *i);
+#endif
+
+static struct methodlist math_methods[] = {
+	{"acos", math_acos},
+	{"asin", math_asin},
+	{"atan", math_atan},
+	{"atan2", math_atan2},
+	{"ceil", math_ceil},
+	{"cos", math_cos},
+	{"cosh", math_cosh},
+	{"exp", math_exp},
+	{"fabs", math_fabs},
+	{"floor", math_floor},
+#if 0
+	{"fmod", math_fmod},
+	{"frexp", math_freqp},
+	{"ldexp", math_ldexp},
+#endif
+	{"log", math_log},
+	{"log10", math_log10},
+#if 0
+	{"modf", math_modf},
+#endif
+	{"pow", math_pow},
+	{"sin", math_sin},
+	{"sinh", math_sinh},
+	{"sqrt", math_sqrt},
+	{"tan", math_tan},
+	{"tanh", math_tanh},
+	{NULL,		NULL}		/* sentinel */
+};
+
+void
+initmath()
+{
+	object *m, *d, *v;
+	struct methodlist *ml;
+	if ((m = new_module("math")) == NULL)
+		fatal("can't create math module");
+	d = getmoduledict(m);
+	for (ml = math_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) {
+			fatal("can't initialize math module");
+		}
+		DECREF(v);
+	}
+	dictinsert(d, "pi", newfloatobject(atan(1.0) * 4.0));
+	dictinsert(d, "e", newfloatobject(exp(1.0)));
+	DECREF(m);
+}

Modules/posixmodule.c

@@ -0,0 +1,444 @@
+/* POSIX module implementation */
+
+#include <stdio.h>
+#include <signal.h>
+#include <string.h>
+#include <setjmp.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <sys/time.h>
+#ifdef SYSV
+#include <dirent.h>
+#define direct dirent
+#else
+#include <sys/dir.h>
+#endif
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+#include "listobject.h"
+#include "dictobject.h"
+#include "methodobject.h"
+#include "moduleobject.h"
+#include "objimpl.h"
+#include "import.h"
+#include "sigtype.h"
+#include "modsupport.h"
+#include "errors.h"
+
+extern char *strerror();
+
+#ifdef AMOEBA
+#define NO_LSTAT
+#endif
+
+
+/* Return a dictionary corresponding to the POSIX environment table */
+
+extern char **environ;
+
+static object *
+convertenviron()
+{
+	object *d;
+	char **e;
+	d = newdictobject();
+	if (d == NULL)
+		return NULL;
+	if (environ == NULL)
+		return d;
+	/* XXX This part ignores errors */
+	for (e = environ; *e != NULL; e++) {
+		object *v;
+		char *p = strchr(*e, '=');
+		if (p == NULL)
+			continue;
+		v = newstringobject(p+1);
+		if (v == NULL)
+			continue;
+		*p = '\0';
+		(void) dictinsert(d, *e, v);
+		*p = '=';
+		DECREF(v);
+	}
+	return d;
+}
+
+
+static object *PosixError; /* Exception posix.error */
+
+/* Set a POSIX-specific error from errno, and return NULL */
+
+static object *
+posix_error()
+{
+	object *v = newtupleobject(2);
+	if (v != NULL) {
+		settupleitem(v, 0, newintobject((long)errno));
+		settupleitem(v, 1, newstringobject(strerror(errno)));
+	}
+	err_setval(PosixError, v);
+	if (v != NULL)
+		DECREF(v);
+	return NULL;
+}
+
+
+/* POSIX generic methods */
+
+static object *
+posix_1str(args, func)
+	object *args;
+	int (*func) FPROTO((const char *));
+{
+	object *path1;
+	if (!getstrarg(args, &path1))
+		return NULL;
+	if ((*func)(getstringvalue(path1)) < 0)
+		return posix_error();
+	INCREF(None);
+	return None;
+}
+
+static object *
+posix_2str(args, func)
+	object *args;
+	int (*func) FPROTO((const char *, const char *));
+{
+	object *path1, *path2;
+	if (!getstrstrarg(args, &path1, &path2))
+		return NULL;
+	if ((*func)(getstringvalue(path1), getstringvalue(path2)) < 0)
+		return posix_error();
+	INCREF(None);
+	return None;
+}
+
+static object *
+posix_strint(args, func)
+	object *args;
+	int (*func) FPROTO((const char *, int));
+{
+	object *path1;
+	int i;
+	if (!getstrintarg(args, &path1, &i))
+		return NULL;
+	if ((*func)(getstringvalue(path1), i) < 0)
+		return posix_error();
+	INCREF(None);
+	return None;
+}
+
+static object *
+posix_do_stat(self, args, statfunc)
+	object *self;
+	object *args;
+	int (*statfunc) FPROTO((const char *, struct stat *));
+{
+	struct stat st;
+	object *path;
+	object *v;
+	if (!getstrarg(args, &path))
+		return NULL;
+	if ((*statfunc)(getstringvalue(path), &st) != 0)
+		return posix_error();
+	v = newtupleobject(10);
+	if (v == NULL)
+		return NULL;
+	errno = 0;
+#define SET(i, st_member) settupleitem(v, i, newintobject((long)st.st_member))
+	SET(0, st_mode);
+	SET(1, st_ino);
+	SET(2, st_dev);
+	SET(3, st_nlink);
+	SET(4, st_uid);
+	SET(5, st_gid);
+	SET(6, st_size);
+	SET(7, st_atime);
+	SET(8, st_mtime);
+	SET(9, st_ctime);
+#undef SET
+	if (errno != 0) {
+		DECREF(v);
+		return err_nomem();
+	}
+	return v;
+}
+
+
+/* POSIX methods */
+
+static object *
+posix_chdir(self, args)
+	object *self;
+	object *args;
+{
+	extern int chdir PROTO((const char *));
+	return posix_1str(args, chdir);
+}
+
+static object *
+posix_chmod(self, args)
+	object *self;
+	object *args;
+{
+	extern int chmod PROTO((const char *, mode_t));
+	return posix_strint(args, chmod);
+}
+
+static object *
+posix_getcwd(self, args)
+	object *self;
+	object *args;
+{
+	char buf[1026];
+	extern char *getcwd PROTO((char *, int));
+	if (!getnoarg(args))
+		return NULL;
+	if (getcwd(buf, sizeof buf) == NULL)
+		return posix_error();
+	return newstringobject(buf);
+}
+
+static object *
+posix_link(self, args)
+	object *self;
+	object *args;
+{
+	extern int link PROTO((const char *, const char *));
+	return posix_2str(args, link);
+}
+
+static object *
+posix_listdir(self, args)
+	object *self;
+	object *args;
+{
+	object *name, *d, *v;
+	DIR *dirp;
+	struct direct *ep;
+	if (!getstrarg(args, &name))
+		return NULL;
+	if ((dirp = opendir(getstringvalue(name))) == NULL)
+		return posix_error();
+	if ((d = newlistobject(0)) == NULL) {
+		closedir(dirp);
+		return NULL;
+	}
+	while ((ep = readdir(dirp)) != NULL) {
+		v = newstringobject(ep->d_name);
+		if (v == NULL) {
+			DECREF(d);
+			d = NULL;
+			break;
+		}
+		if (addlistitem(d, v) != 0) {
+			DECREF(v);
+			DECREF(d);
+			d = NULL;
+			break;
+		}
+		DECREF(v);
+	}
+	closedir(dirp);
+	return d;
+}
+
+static object *
+posix_mkdir(self, args)
+	object *self;
+	object *args;
+{
+	extern int mkdir PROTO((const char *, mode_t));
+	return posix_strint(args, mkdir);
+}
+
+static object *
+posix_rename(self, args)
+	object *self;
+	object *args;
+{
+	extern int rename PROTO((const char *, const char *));
+	return posix_2str(args, rename);
+}
+
+static object *
+posix_rmdir(self, args)
+	object *self;
+	object *args;
+{
+	extern int rmdir PROTO((const char *));
+	return posix_1str(args, rmdir);
+}
+
+static object *
+posix_stat(self, args)
+	object *self;
+	object *args;
+{
+	extern int stat PROTO((const char *, struct stat *));
+	return posix_do_stat(self, args, stat);
+}
+
+static object *
+posix_system(self, args)
+	object *self;
+	object *args;
+{
+	object *command;
+	int sts;
+	if (!getstrarg(args, &command))
+		return NULL;
+	sts = system(getstringvalue(command));
+	return newintobject((long)sts);
+}
+
+static object *
+posix_umask(self, args)
+	object *self;
+	object *args;
+{
+	int i;
+	if (!getintarg(args, &i))
+		return NULL;
+	i = umask(i);
+	if (i < 0)
+		return posix_error();
+	return newintobject((long)i);
+}
+
+static object *
+posix_unlink(self, args)
+	object *self;
+	object *args;
+{
+	extern int unlink PROTO((const char *));
+	return posix_1str(args, unlink);
+}
+
+static object *
+posix_utimes(self, args)
+	object *self;
+	object *args;
+{
+	object *path;
+	struct timeval tv[2];
+	if (args == NULL || !is_tupleobject(args) || gettuplesize(args) != 2) {
+		err_badarg();
+		return NULL;
+	}
+	if (!getstrarg(gettupleitem(args, 0), &path) ||
+				!getlonglongargs(gettupleitem(args, 1),
+					&tv[0].tv_sec, &tv[1].tv_sec))
+		return NULL;
+	tv[0].tv_usec = tv[1].tv_usec = 0;
+	if (utimes(getstringvalue(path), tv) < 0)
+		return posix_error();
+	INCREF(None);
+	return None;
+}
+
+#ifdef NO_GETCWD
+
+/* Quick hack to get posix.getcwd() working for pure BSD 4.3 */
+/* XXX This assumes MAXPATHLEN = 1024 !!! */
+
+static char *
+getcwd(buf, size)
+	char *buf;
+	int size;
+{
+	extern char *getwd PROTO((char *));
+	register char *ret = getwd(buf);
+	if (ret == NULL)
+		errno = EACCES; /* Most likely error */
+	return ret;
+}
+
+#endif /* NO_GETCWD */
+
+
+#ifndef NO_LSTAT
+
+static object *
+posix_lstat(self, args)
+	object *self;
+	object *args;
+{
+	extern int lstat PROTO((const char *, struct stat *));
+	return posix_do_stat(self, args, lstat);
+}
+
+static object *
+posix_readlink(self, args)
+	object *self;
+	object *args;
+{
+	char buf[1024]; /* XXX Should use MAXPATHLEN */
+	object *path;
+	int n;
+	if (!getstrarg(args, &path))
+		return NULL;
+	n = readlink(getstringvalue(path), buf, sizeof buf);
+	if (n < 0)
+		return posix_error();
+	return newsizedstringobject(buf, n);
+}
+
+static object *
+posix_symlink(self, args)
+	object *self;
+	object *args;
+{
+	extern int symlink PROTO((const char *, const char *));
+	return posix_2str(args, symlink);
+}
+
+#endif /* NO_LSTAT */
+
+
+static struct methodlist posix_methods[] = {
+	{"chdir",	posix_chdir},
+	{"chmod",	posix_chmod},
+	{"getcwd",	posix_getcwd},
+	{"link",	posix_link},
+	{"listdir",	posix_listdir},
+	{"mkdir",	posix_mkdir},
+	{"rename",	posix_rename},
+	{"rmdir",	posix_rmdir},
+	{"stat",	posix_stat},
+	{"system",	posix_system},
+	{"umask",	posix_umask},
+	{"unlink",	posix_unlink},
+	{"utimes",	posix_utimes},
+#ifndef NO_LSTAT
+	{"lstat",	posix_lstat},
+	{"readlink",	posix_readlink},
+	{"symlink",	posix_symlink},
+#endif
+	{NULL,		NULL}		 /* Sentinel */
+};
+
+
+void
+initposix()
+{
+	object *m, *d, *v;
+	
+	m = initmodule("posix", posix_methods);
+	d = getmoduledict(m);
+	
+	/* Initialize posix.environ dictionary */
+	v = convertenviron();
+	if (v == NULL || dictinsert(d, "environ", v) != 0)
+		fatal("can't define posix.environ");
+	DECREF(v);
+	
+	/* Initialize posix.error exception */
+	PosixError = newstringobject("posix.error");
+	if (PosixError == NULL || dictinsert(d, "error", PosixError) != 0)
+		fatal("can't define posix.error");
+}

Modules/timemodule.c

@@ -0,0 +1,178 @@
+/* Time module */
+
+#include <stdio.h>
+#include <signal.h>
+#include <setjmp.h>
+
+#ifdef __STDC__
+#include <time.h>
+#else /* !__STDC__ */
+typedef unsigned long time_t;
+extern time_t time();
+#endif /* !__STDC__ */
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "dictobject.h"
+#include "methodobject.h"
+#include "moduleobject.h"
+#include "objimpl.h"
+#include "import.h"
+#include "sigtype.h"
+#include "modsupport.h"
+#include "errors.h"
+
+
+/* Time methods */
+
+static object *
+time_time(self, args)
+	object *self;
+	object *args;
+{
+	long secs;
+	if (!getnoarg(args))
+		return NULL;
+	secs = time((time_t *)NULL);
+	return newintobject(secs);
+}
+
+static jmp_buf sleep_intr;
+
+static void
+sleep_catcher(sig)
+	int sig;
+{
+	longjmp(sleep_intr, 1);
+}
+
+static object *
+time_sleep(self, args)
+	object *self;
+	object *args;
+{
+	int secs;
+	SIGTYPE (*sigsave)();
+	if (!getintarg(args, &secs))
+		return NULL;
+	if (setjmp(sleep_intr)) {
+		signal(SIGINT, sigsave);
+		err_set(KeyboardInterrupt);
+		return NULL;
+	}
+	sigsave = signal(SIGINT, SIG_IGN);
+	if (sigsave != (SIGTYPE (*)()) SIG_IGN)
+		signal(SIGINT, sleep_catcher);
+	sleep(secs);
+	signal(SIGINT, sigsave);
+	INCREF(None);
+	return None;
+}
+
+#ifdef THINK_C
+#define DO_MILLI
+#endif /* THINK_C */
+
+#ifdef AMOEBA
+#define DO_MILLI
+extern long sys_milli();
+#define millitimer sys_milli
+#endif /* AMOEBA */
+
+#ifdef DO_MILLI
+
+static object *
+time_millisleep(self, args)
+	object *self;
+	object *args;
+{
+	long msecs;
+	SIGTYPE (*sigsave)();
+	if (!getlongarg(args, &msecs))
+		return NULL;
+	if (setjmp(sleep_intr)) {
+		signal(SIGINT, sigsave);
+		err_set(KeyboardInterrupt);
+		return NULL;
+	}
+	sigsave = signal(SIGINT, SIG_IGN);
+	if (sigsave != (SIGTYPE (*)()) SIG_IGN)
+		signal(SIGINT, sleep_catcher);
+	millisleep(msecs);
+	signal(SIGINT, sigsave);
+	INCREF(None);
+	return None;
+}
+
+static object *
+time_millitimer(self, args)
+	object *self;
+	object *args;
+{
+	long msecs;
+	extern long millitimer();
+	if (!getnoarg(args))
+		return NULL;
+	msecs = millitimer();
+	return newintobject(msecs);
+}
+
+#endif /* DO_MILLI */
+
+
+static struct methodlist time_methods[] = {
+#ifdef DO_MILLI
+	{"millisleep",	time_millisleep},
+	{"millitimer",	time_millitimer},
+#endif /* DO_MILLI */
+	{"sleep",	time_sleep},
+	{"time",	time_time},
+	{NULL,		NULL}		/* sentinel */
+};
+
+
+void
+inittime()
+{
+	initmodule("time", time_methods);
+}
+
+
+#ifdef THINK_C
+
+#define MacTicks	(* (long *)0x16A)
+
+static
+sleep(msecs)
+	int msecs;
+{
+	register long deadline;
+	
+	deadline = MacTicks + msecs * 60;
+	while (MacTicks < deadline) {
+		if (intrcheck())
+			sleep_catcher(SIGINT);
+	}
+}
+
+static
+millisleep(msecs)
+	long msecs;
+{
+	register long deadline;
+	
+	deadline = MacTicks + msecs * 3 / 50; /* msecs * 60 / 1000 */
+	while (MacTicks < deadline) {
+		if (intrcheck())
+			sleep_catcher(SIGINT);
+	}
+}
+
+static long
+millitimer()
+{
+	return MacTicks * 50 / 3; /* MacTicks * 1000 / 60 */
+}
+
+#endif /* THINK_C */