From a19a216bc60160c162e616145ef091dd18ce4e61 Mon Sep 17 00:00:00 2001
From: Skip Montanaro <skip.montanaro@gmail.com>
Date: Tue, 16 Feb 2021 14:40:46 -0600
Subject: Python 0.9.1 as posted in alt.sources

---
 shar/python-0.9.1-09-21.shar | 2688 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 2688 insertions(+)
 create mode 100644 shar/python-0.9.1-09-21.shar

(limited to 'shar/python-0.9.1-09-21.shar')

diff --git a/shar/python-0.9.1-09-21.shar b/shar/python-0.9.1-09-21.shar
new file mode 100644
index 0000000..0aee04d
--- /dev/null
+++ b/shar/python-0.9.1-09-21.shar
@@ -0,0 +1,2688 @@
+: This is a shell archive.
+: Extract with 'sh this_file'.
+:
+: Extract part 01 first since it makes all directories
+echo 'Start of pack.out, part 09 out of 21:'
+if test -s 'doc/mod3.tex'
+then echo '*** I will not over-write existing file doc/mod3.tex'
+else
+echo 'x - doc/mod3.tex'
+sed 's/^X//' > 'doc/mod3.tex' << 'EOF'
+X\section{Standard Modules}
+X
+XThe following standard modules are defined.
+XThey are available in one of the directories in the default module
+Xsearch path (try printing
+X{\tt sys.path}
+Xto find out the default search path.)
+X
+X\subsection{Standard Module {\tt string}}
+X
+XThis module defines some constants useful for checking character
+Xclasses, some exceptions, and some useful string functions.
+XThe constants are:
+X\begin{description}
+X\funcitem{digits}
+XThe string
+X{\tt '0123456789'}.
+X\funcitem{hexdigits}
+XThe string
+X{\tt '0123456789abcdefABCDEF'}.
+X\funcitem{letters}
+XThe concatenation of the strings
+X{\tt lowercase}
+Xand
+X{\tt uppercase}
+Xdescribed below.
+X\funcitem{lowercase}
+XThe string
+X{\tt 'abcdefghijklmnopqrstuvwxyz'}.
+X\funcitem{octdigits}
+XThe string
+X{\tt '01234567'}.
+X\funcitem{uppercase}
+XThe string
+X{\tt 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'}.
+X\funcitem{whitespace}
+XA string containing all characters that are considered whitespace,
+Xi.e.,
+Xspace, tab and newline.
+XThis definition is used by
+X{\tt split()}
+Xand
+X{\tt strip()}.
+X\end{description}
+X
+XThe exceptions are:
+X\begin{description}
+X\excitem{atoi\_error}{non-numeric argument to string.atoi}
+X%.br
+XException raised by
+X{\tt atoi}
+Xwhen a non-numeric string argument is detected.
+XThe exception argument is the offending string.
+X\excitem{index\_error}{substring not found in string.index}
+X%.br
+XException raised by
+X{\tt index}
+Xwhen
+X{\tt sub}
+Xis not found.
+XThe argument are the offending arguments to index: {\tt (s, sub)}.
+X\end{description}
+X
+XThe functions are:
+X\begin{description}
+X\funcitem{atoi}{s}
+XConverts a string to a number.
+XThe string must consist of one or more digits, optionally preceded by a
+Xsign ({\tt '+'} or {\tt '-'}).
+X\funcitem{index}{s, sub}
+XReturns the lowest index in
+X{\tt s}
+Xwhere the substring
+X{\tt sub}
+Xis found.
+X\funcitem{lower}{s}
+XConvert letters to lower case.
+X\funcitem{split}{s}
+XReturns a list of the whitespace-delimited words of the string
+X{\tt s}.
+X\funcitem{splitfields}{s, sep}
+X%.br
+XReturns a list containing the fields of the string
+X{\tt s},
+Xusing the string
+X{\tt sep}
+Xas a separator.
+XThe list will have one more items than the number of non-overlapping
+Xoccurrences of the separator in the string.
+XThus,
+X{\tt string.splitfields(s, ' ')}
+Xis not the same as
+X{\tt string.split(s)},
+Xas the latter only returns non-empty words.
+X\funcitem{strip}{s}
+XRemoves leading and trailing whitespace from the string
+X{\tt s}.
+X\funcitem{swapcase}{s}
+XConverts lower case letters to upper case and vice versa.
+X\funcitem{upper}{s}
+XConvert letters to upper case.
+X\funcitem{ljust(s, width), rjust(s, width), center}{s, width}
+X%.br
+XThese functions respectively left-justify, right-justify and center a
+Xstring in a field of given width.
+XThey return a string that is at least
+X{\tt width}
+Xcharacters wide, created by padding the string
+X{\tt s}
+Xwith spaces until the given width on the right, left or both sides.
+XThe string is never truncated.
+X\end{description}
+X
+X\subsection{Standard Module {\tt path}}
+X
+XThis module implements some useful functions on POSIX pathnames.
+X\begin{description}
+X\funcitem{basename}{p}
+XReturns the base name of pathname
+X{\tt p}.
+XThis is the second half of the pair returned by
+X{\tt path.split(p)}.
+X\funcitem{cat}{p, q}
+XPerforms intelligent pathname concatenation on paths
+X{\tt p}
+Xand
+X{\tt q}:
+XIf
+X{\tt q}
+Xis an absolute path, the return value is
+X{\tt q}.
+XOtherwise, the concatenation of
+X{\tt p}
+Xand
+X{\tt q}
+Xis returned, with a slash ({\tt '/'}) inserted unless
+X{\tt p}
+Xis empty or ends in a slash.
+X\funcitem{commonprefix}{list}
+X%.br
+XReturns the longest string that is a prefix of all strings in
+X{\tt list}.
+XIf
+X{\tt list}
+Xis empty, the empty string ({\tt ''}) is returned.
+X\funcitem{exists}{p}
+XReturns true if
+X{\tt p}
+Xrefers to an existing path.
+X\funcitem{isdir}{p}
+XReturns true if
+X{\tt p}
+Xrefers to an existing directory.
+X\funcitem{islink}{p}
+XReturns true if
+X{\tt p}
+Xrefers to a directory entry that is a symbolic link.
+XAlways false if symbolic links are not supported.
+X\funcitem{ismount}{p}
+XReturns true if
+X{\tt p}
+Xis an absolute path that occurs in the mount table as output by the
+X{\tt /etc/mount}
+Xutility.
+XThis output is read once when the function is used for the first
+Xtime.%
+X\footnote{
+XIs there a better way to check for mount points?
+X}
+X\funcitem{split}{p}
+XReturns a pair
+X{\tt (head,~tail)}
+Xsuch that
+X{\tt tail}
+Xcontains no slashes and
+X{\tt path.cat(head, tail)}
+Xis equal to
+X{\tt p}.
+X\funcitem{walk}{p, visit, arg}
+X%.br
+XCalls the function
+X{\tt visit}
+Xwith arguments
+X{\tt (arg, dirname, names)}
+Xfor each directory in the directory tree rooted at
+X{\tt p}
+X(including
+X{\tt p}
+Xitself, if it is a directory).
+XThe argument
+X{\tt dirname}
+Xspecifies the visited directory, the argument
+X{\tt names}
+Xlists the files in the directory (gotten from
+X{\tt posix.listdir(dirname)}).
+XThe
+X{\tt visit}
+Xfunction may modify
+X{\tt names}
+Xto influence the set of directories visited below
+X{\tt dirname},
+Xe.g.,
+Xto avoid visiting certain parts of the tree.
+X(The object referred to by
+X{\tt names}
+Xmust be modified in place, using
+X{\tt del}
+Xor slice assignment.)
+X\end{description}
+X
+X\subsection{Standard Module {\tt getopt}}
+X
+XThis module helps scripts to parse the command line arguments in
+X{\tt sys.argv}.
+XIt uses the same conventions as the {\UNIX}
+X{\tt getopt()}
+Xfunction.
+XIt defines the function
+X{\tt getopt.getopt(args, options)}
+Xand the exception
+X{\tt getopt.error}.
+X
+XThe first argument to
+X{\tt getopt()}
+Xis the argument list passed to the script with its first element
+Xchopped off (i.e.,
+X{\tt sys.argv[1:]}).
+XThe second argument is the string of option letters that the
+Xscript wants to recognize, with options that require an argument
+Xfollowed by a colon (i.e., the same format that {\UNIX}
+X{\tt getopt()}
+Xuses).
+XThe return value consists of two elements: the first is a list of
+Xoption-and-value pairs; the second is the list of program arguments
+Xleft after the option list was stripped (this is a trailing slice of the
+Xfirst argument).
+XEach option-and-value pair returned has the option as its first element,
+Xprefixed with a hyphen (e.g.,
+X{\tt '-x'}),
+Xand the option argument as its second element, or an empty string if the
+Xoption has no argument.
+XThe options occur in the list in the same order in which they were
+Xfound, thus allowing multiple occurrences.
+XExample:
+X\bcode\begin{verbatim}
+X>>> import getopt, string
+X>>> args = string.split('-a -b -cfoo -d bar a1 a2')
+X>>> args
+X['-a', '-b', '-cfoo', '-d', 'bar', 'a1', 'a2']
+X>>> optlist, args = getopt.getopt(args, 'abc:d:')
+X>>> optlist
+X[('-a', ''), ('-b', ''), ('-c', 'foo'), ('-d', 'bar')]
+X>>> args
+X['a1', 'a2']
+X>>>
+X\end{verbatim}\ecode
+XThe exception
+X{\tt getopt.error = 'getopt error'}
+Xis raised when an unrecognized option is found in the argument list or
+Xwhen an option requiring an argument is given none.
+XThe argument to the exception is a string indicating the cause of the
+Xerror.
+X
+X\subsection{Standard Module {\tt rand}}
+X
+XThis module implements a pseudo-random number generator similar to
+X{\tt rand()}
+Xin C.
+XIt defines the following functions:
+X\begin{description}
+X\funcitem{rand}{}
+XReturns an integer random number in the range [0 ... 32768).
+X\funcitem{choice}{s}
+XReturns a random element from the sequence (string, tuple or list)
+X{\tt s.}
+X\funcitem{srand}{seed}
+XInitializes the random number generator with the given integral seed.
+XWhen the module is first imported, the random number is initialized with
+Xthe current time.
+X\end{description}
+X
+X\subsection{Standard Module {\tt whrandom}}
+X
+XThis module implements a Wichmann-Hill pseudo-random number generator.
+XIt defines the following functions:
+X\begin{description}
+X\funcitem{random}{}
+XReturns the next random floating point number in the range [0.0 ... 1.0).
+X\funcitem{seed}{x, y, z}
+XInitializes the random number generator from the integers
+X{\tt x},
+X{\tt y}
+Xand
+X{\tt z}.
+XWhen the module is first imported, the random number is initialized
+Xusing values derived from the current time.
+X\end{description}
+X
+X\subsection{Standard Module {\tt stdwinevents}}
+X
+XThis module defines constants used by STDWIN for event types
+X({\tt WE\_ACTIVATE} etc.), command codes ({\tt WC\_LEFT} etc.)
+Xand selection types ({\tt WS\_PRIMARY} etc.).
+XRead the file for details.
+XSuggested usage is
+X\bcode\begin{verbatim}
+X>>> from stdwinevents import *
+X>>>
+X\end{verbatim}\ecode
+X
+X\subsection{Standard Module {\tt rect}}
+X
+XThis module contains useful operations on rectangles.
+XA rectangle is defined as in module
+X{\tt stdwin}:
+Xa pair of points, where a point is a pair of integers.
+XFor example, the rectangle
+X\bcode\begin{verbatim}
+X(10, 20), (90, 80)
+X\end{verbatim}\ecode
+Xis a rectangle whose left, top, right and bottom edges are 10, 20, 90
+Xand 80, respectively.
+XNote that the positive vertical axis points down (as in
+X{\tt stdwin}).
+X
+XThe module defines the following objects:
+X\begin{description}
+X\excitem{error}{rect.error}
+X%.br
+XThe exception raised by functions in this module when they detect an
+Xerror.
+XThe exception argument is a string describing the problem in more
+Xdetail.
+X\funcitem{empty}
+X%.br
+XThe rectangle returned when some operations return an empty result.
+XThis makes it possible to quickly check whether a result is empty:
+X\bcode\begin{verbatim}
+X>>> import rect
+X>>> r1 = (10, 20), (90, 80)
+X>>> r2 = (0, 0), (10, 20)
+X>>> r3 = rect.intersect(r1, r2)
+X>>> if r3 is rect.empty: print 'Empty intersection'
+XEmpty intersection
+X>>>
+X\end{verbatim}\ecode
+X\funcitem{is\_empty}{r}
+X%.br
+XReturns true if the given rectangle is empty.
+XA rectangle
+X{\em (left,~top), (right,~bottom)}
+Xis empty if
+X{\em left~$\geq$~right}
+Xor
+X{\em top~$\leq$~bottom}.
+X\funcitem{intersect}{list}
+X%.br
+XReturns the intersection of all rectangles in the list argument.
+XIt may also be called with a tuple argument or with two or more
+Xrectangles as arguments.
+XRaises
+X{\tt rect.error}
+Xif the list is empty.
+XReturns
+X{\tt rect.empty}
+Xif the intersection of the rectangles is empty.
+X\funcitem{union}{list}
+X%.br
+XReturns the smallest rectangle that contains all non-empty rectangles in
+Xthe list argument.
+XIt may also be called with a tuple argument or with two or more
+Xrectangles as arguments.
+XReturns
+X{\tt rect.empty}
+Xif the list is empty or all its rectangles are empty.
+X\funcitem{pointinrect}{point, rect}
+X%.br
+XReturns true if the point is inside the rectangle.
+XBy definition, a point
+X{\em (h,~v)}
+Xis inside a rectangle
+X{\em (left,~top),}
+X{\em (right,~bottom)}
+Xif
+X{\em left~$\leq$~h~$<$~right}
+Xand
+X{\em top~$\leq$~v~$<$~bottom}.
+X\funcitem{inset(rect, }{dh, dv)}
+X%.br
+XReturns a rectangle that lies inside the
+X{\tt rect}
+Xargument by
+X{\tt dh}
+Xpixels horizontally
+Xand
+X{\tt dv}
+Xpixels
+Xvertically.
+XIf
+X{\tt dh}
+Xor
+X{\tt dv}
+Xis negative, the result lies outside
+X{\tt rect}.
+X\funcitem{rect2geom}{rect}
+X%.br
+XConverts a rectangle to geometry representation:
+X{\em (left,~top),}
+X{\em (width,~height)}.
+X\funcitem{geom2rect}{geom}
+X%.br
+XConverts a rectangle given in geometry representation back to the
+Xstandard rectangle representation
+X{\em (left,~top),}
+X{\em (right,~bottom)}.
+X\end{description}
+X
+X\subsection{Standard Modules {\tt GL} and {\tt DEVICE}}
+X
+XThese modules define the constants used by the Silicon Graphics
+X{\em Graphics Library}
+Xthat C programmers find in the header files
+X{\tt <gl/gl.h>}
+Xand
+X{\tt <gl/device.h>}.
+XRead the module files for details.
+X
+X\subsection{Standard Module {\tt panel}}
+X
+XThis module should be used instead of the built-in module
+X{\tt pnl}
+Xto interface with the
+X{\em Panel Library}.
+X
+XThe module is too large to document here in its entirety.
+XOne interesting function:
+X\begin{description}
+X\funcitem{defpanellist}{filename}
+X%.br
+XParses a panel description file containing S-expressions written by the
+X{\em Panel Editor}
+Xthat accompanies the Panel Library and creates the described panels.
+XIt returns a list of panel objects.
+X\end{description}
+X
+X{\bf Warning:}
+Xthe {\Python} interpreter will dump core if you don't create a GL window
+Xbefore calling
+X{\tt panel.mkpanel()}
+Xor
+X{\tt panel.defpanellist()}.
+X
+X\subsection{Standard Module {\tt panelparser}}
+X
+XThis module defines a self-contained parser for S-expressions as output
+Xby the Panel Editor (which is written in Scheme so it can't help writing
+XS-expressions).
+XThe relevant function is
+X{\tt panelparser.parse\_file(file)}
+Xwhich has a file object (not a filename!) as argument and returns a list
+Xof parsed S-expressions.
+XEach S-expression is converted into a {\Python} list, with atoms converted
+Xto {\Python} strings and sub-expressions (recursively) to {\Python} lists.
+XFor more details, read the module file.
+X
+X\section{P.M.}
+X
+X\begin{verse}
+X
+Xcommands
+X
+Xcmp?
+X
+X*cache?
+X
+Xlocaltime?
+X
+Xcalendar?
+X
+X\_\_dict?
+X
+Xmac?
+X
+X\end{verse}
+EOF
+fi
+if test -s 'src/audiomodule.c'
+then echo '*** I will not over-write existing file src/audiomodule.c'
+else
+echo 'x - src/audiomodule.c'
+sed 's/^X//' > 'src/audiomodule.c' << 'EOF'
+X/***********************************************************
+XCopyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+XNetherlands.
+X
+X All Rights Reserved
+X
+XPermission to use, copy, modify, and distribute this software and its
+Xdocumentation for any purpose and without fee is hereby granted,
+Xprovided that the above copyright notice appear in all copies and that
+Xboth that copyright notice and this permission notice appear in
+Xsupporting documentation, and that the names of Stichting Mathematisch
+XCentrum or CWI not be used in advertising or publicity pertaining to
+Xdistribution of the software without specific, written prior permission.
+X
+XSTICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+XTHIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+XFITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+XFOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+XWHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+XACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+XOF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+X
+X******************************************************************/
+X
+X/* Silicon Graphics audio module implementation */
+X/* For SGI Personal IRIS 4D/20 under IRIX 3.3; <sys/audio.h> mentions "IP6" */
+X/* Note: The set-in-gain ioctl exists but is non-functional */
+X
+X#include <errno.h>
+X#include <sys/audio.h>
+X#include "asa.h"
+X
+X#include "allobjects.h"
+X#include "modsupport.h"
+X
+Xstatic int audio_fd = -1;
+X
+Xstatic int
+Xinit()
+X{
+X if (audio_fd >= 0)
+X return 1;
+X if ((audio_fd = asa_init()) >= 0)
+X return 1;
+X err_setstr(RuntimeError, "can't initialize async audio");
+X return 0;
+X}
+X
+X
+X/* POSIX methods */
+X
+Xstatic object *
+Xaudio_get_ioctl(self, args, code)
+X object *self;
+X object *args;
+X long code;
+X{
+X long x;
+X if (!getnoarg(args))
+X return NULL;
+X if (!init())
+X return NULL;
+X if ((x = ioctl(audio_fd, code, (char *) NULL)) < 0) {
+X return NULL;
+X }
+X return newintobject(x);
+X}
+X
+Xstatic object *
+Xaudio_set_ioctl(self, args, code)
+X object *self;
+X object *args;
+X long code;
+X{
+X long x;
+X if (!getlongarg(args, &x))
+X return NULL;
+X if (!init())
+X return NULL;
+X if (ioctl(audio_fd, code, (char *) x) != 0)
+X return NULL;
+X INCREF(None);
+X return None;
+X}
+X
+Xstatic object *
+Xaudio_getingain(self, args)
+X object *self;
+X object *args;
+X{
+X return audio_get_ioctl(self, args, AUDIOCGETINGAIN);
+X}
+X
+Xstatic object *
+Xaudio_getoutgain(self, args)
+X object *self;
+X object *args;
+X{
+X return audio_get_ioctl(self, args, AUDIOCGETOUTGAIN);
+X}
+X
+Xstatic object *
+Xaudio_setingain(self, args)
+X object *self;
+X object *args;
+X{
+X return audio_set_ioctl(self, args, AUDIOCSETINGAIN);
+X}
+X
+Xstatic object *
+Xaudio_setoutgain(self, args)
+X object *self;
+X object *args;
+X{
+X return audio_set_ioctl(self, args, AUDIOCSETOUTGAIN);
+X}
+X
+Xstatic object *
+Xaudio_setrate(self, args)
+X object *self;
+X object *args;
+X{
+X return audio_set_ioctl(self, args, AUDIOCSETRATE);
+X}
+X
+Xstatic object *
+Xaudio_setduration(self, args)
+X object *self;
+X object *args;
+X{
+X return audio_set_ioctl(self, args, AUDIOCDURATION);
+X}
+X
+X/* Compute average bias, and remove it */
+X
+Xstatic void
+Xunbias(buf, len)
+X char *buf;
+X int len;
+X{
+X register int i;
+X register int c;
+X register long bias;
+X if (len == 0)
+X return;
+X bias = 0;
+X for (i = 0; i < len; i++) {
+X c = buf[i];
+X if (c > 127)
+X c -= 256;
+X bias += c;
+X }
+X bias = (bias + len/2) / len; /* Rounded average */
+X if (bias != 0) {
+X for (i = 0; i < len; i++) {
+X buf[i] -= bias;
+X }
+X }
+X}
+X
+Xstatic object *
+Xaudio_read(self, args)
+X object *self;
+X object *args;
+X{
+X int c, i, n;
+X object *v;
+X char *s;
+X if (!getintarg(args, &n))
+X return NULL;
+X if (n <= 0) {
+X err_setstr(RuntimeError, "audio.read: arg <= 0");
+X return NULL;
+X }
+X if (!init())
+X return NULL;
+X v = newsizedstringobject((char *)NULL, n);
+X if (v == NULL)
+X return err_nomem();
+X s = getstringvalue(v);
+X n = read(audio_fd, s, n);
+X if (intrcheck()) {
+X DECREF(v);
+X err_set(KeyboardInterrupt);
+X return NULL;
+X }
+X /* Check for errors */
+X if (n < 0) {
+X DECREF(v);
+X return NULL;
+X }
+X /* But EOF is reported as an empty string */
+X
+X unbias(s, n);
+X resizestring(&v, n);
+X return v;
+X}
+X
+Xstatic object *
+Xaudio_write(self, args)
+X object *self;
+X object *args;
+X{
+X int n, n2;
+X object *v;
+X if (!getstrarg(args, &v))
+X return NULL;
+X if (!init())
+X return NULL;
+X errno = 0;
+X n2 = write(audio_fd, getstringvalue(v), n = getstringsize(v));
+X if (intrcheck()) {
+X err_set(KeyboardInterrupt);
+X return NULL;
+X }
+X /* Check for other errors */
+X if (n2 != n) {
+X if (errno == 0)
+X errno = EIO;
+X return NULL;
+X }
+X INCREF(None);
+X return None;
+X}
+X
+X/* audio.amplify(sample, f1, f2).
+X Amplify a sample by a factor changing from f1/256 to (almost) f2/256.
+X Negative factors are allowed. Sound values that are to large
+X to fit in a byte are clipped. */
+X
+Xstatic object *
+Xaudio_amplify(self, args)
+X object *self;
+X object *args;
+X{
+X object *v;
+X char *s, *t;
+X int f1, f2;
+X int i, n;
+X int c;
+X if (!getstrintintarg(args, &v, &f1, &f2))
+X return NULL;
+X n = getstringsize(v);
+X s = getstringvalue(v);
+X v = newsizedstringobject((char *)NULL, n);
+X if (v == NULL)
+X return err_nomem();
+X t = getstringvalue(v);
+X for (i = 0; i < n; i++) {
+X c = s[i];
+X if (c > 127) c -= 256; /* If chars are unsigned */
+X c = c * ( f1*(n-i) + f2*i ) / ( n*256 );
+X if (c > 127) c = 127;
+X else if (c < -128) c = -128;
+X t[i] = c;
+X }
+X return v;
+X}
+X
+X/* audio.reverse(s): return a sample backwards */
+X
+Xstatic object *
+Xaudio_reverse(self, args)
+X object *self;
+X object *args;
+X{
+X object *v;
+X char *s, *t;
+X int i, n;
+X if (!getstrarg(args, &v))
+X return NULL;
+X n = getstringsize(v);
+X s = getstringvalue(v);
+X v = newsizedstringobject((char *)NULL, n);
+X if (v == NULL)
+X return err_nomem();
+X t = getstringvalue(v);
+X for (i = 0; i < n; i++) {
+X t[n-1-i] = s[i];
+X }
+X return v;
+X}
+X
+X/* audio.add(a, b): add two samples.
+X Bytes that exceed the range are clipped.
+X If one is shorter, the rest of the longer sample is returned unchanged. */
+X
+Xstatic object *
+Xaudio_add(self, args)
+X object *self;
+X object *args;
+X{
+X object *a, *b, *v;
+X char *sa, *sb, *t;
+X int i, n, na, nb, c, ca, cb;
+X if (!getstrstrarg(args, &a, &b))
+X return NULL;
+X na = getstringsize(a);
+X sa = getstringvalue(a);
+X nb = getstringsize(b);
+X sb = getstringvalue(b);
+X n = (na > nb) ? na : nb;
+X v = newsizedstringobject((char *)NULL, n);
+X if (v == NULL)
+X return err_nomem();
+X t = getstringvalue(v);
+X for (i = 0; i < n; i++) {
+X c = 0;
+X if (i < na) {
+X ca = sa[i];
+X if (ca > 127) ca = ca - 256;
+X c = c + ca;
+X }
+X if (i < nb) {
+X cb = sb[i];
+X if (cb > 127) cb = cb - 256;
+X c = c + cb;
+X }
+X if (c > 127) c = 127;
+X else if (c < -128) c = -128;
+X t[i] = c;
+X }
+X return v;
+X}
+X
+X/* audio.chr2num(s) returns a list containing the numeric values
+X of the samples. */
+X
+Xstatic object *
+Xaudio_chr2num(self, args)
+X object *self;
+X object *args;
+X{
+X object *v, *w;
+X char *s;
+X int c, i, n;
+X static object *ints[256];
+X
+X /* To avoid filling memory with all those int objects, we create
+X integer objects for all the desired values and reference these. */
+X if (ints[255] == NULL) {
+X for (i = 0; i < 256; i++) {
+X if (ints[i] != NULL)
+X continue;
+X c = i;
+X if (c > 127) c -= 256;
+X ints[i] = newintobject((long)c);
+X if (ints[i] == NULL)
+X return NULL;
+X }
+X }
+X
+X if (!getstrarg(args, &v))
+X return NULL;
+X n = getstringsize(v);
+X s = getstringvalue(v);
+X v = newlistobject(n);
+X if (v == NULL)
+X return err_nomem();
+X for (i = 0; i < n; i++) {
+X c = s[i] & 0xff;
+X w = ints[c];
+X INCREF(w);
+X if (setlistitem(v, i, w) != 0) {
+X DECREF(v);
+X return NULL;
+X }
+X }
+X return v;
+X}
+X
+X/* audio.num2chr is the inverse of audio.chr2num.
+X Excess values are clipped. */
+X
+Xstatic object *
+Xaudio_num2chr(self, args)
+X object *self;
+X object *args;
+X{
+X object *v, *w;
+X char *s;
+X int c, i, n;
+X if (!is_listobject(args)) {
+X err_badarg();
+X return NULL;
+X }
+X n = getlistsize(args);
+X v = newsizedstringobject((char *)NULL, n);
+X if (v == NULL)
+X return NULL;
+X s = getstringvalue(v);
+X for (i = 0; i < n; i++) {
+X w = getlistitem(args, i);
+X if (!is_intobject(w)) {
+X DECREF(v);
+X err_badarg();
+X return NULL;
+X }
+X s[i] = getintvalue(w);
+X }
+X return v;
+X}
+X
+Xstatic object *stdaudio_buffer = NULL;
+X
+Xstatic object *
+Xaudio_start_recording(self, args)
+X object *self;
+X object *args;
+X{
+X int n;
+X object *v;
+X char *s;
+X if (!getintarg(args, &n))
+X return NULL;
+X if (stdaudio_buffer != NULL) {
+X err_setstr(RuntimeError, "audio.start_recording: device busy");
+X return NULL;
+X }
+X if (n <= 0) {
+X err_setstr(TypeError, "audio.start_recording: arg <= 0");
+X return NULL;
+X }
+X if (!init())
+X return NULL;
+X v = newsizedstringobject((char *)NULL, n);
+X if (v == NULL)
+X return err_nomem();
+X s = getstringvalue(v);
+X asa_start_read(s, n);
+X stdaudio_buffer = v;
+X INCREF(None);
+X return None;
+X}
+X
+Xstatic object *
+Xaudio_poll(self, args)
+X object *self;
+X object *args;
+X{
+X int n;
+X if (!getnoarg(args))
+X return NULL;
+X if (stdaudio_buffer == NULL) {
+X err_setstr(RuntimeError, "audio.poll: not busy");
+X return NULL;
+X }
+X if (!init())
+X return NULL;
+X if ((n = asa_poll()) < 0)
+X return NULL;
+X return newintobject(n);
+X}
+X
+Xstatic object *
+Xaudio_wait_recording(self, args)
+X object *self;
+X object *args;
+X{
+X object *v;
+X int n;
+X if (!getnoarg(args))
+X return NULL;
+X if (stdaudio_buffer == NULL) {
+X err_setstr(RuntimeError, "audio.wait_recording: not busy");
+X return NULL;
+X }
+X if (!init())
+X return NULL;
+X if ((n = asa_wait()) < 0)
+X return NULL;
+X v = stdaudio_buffer;
+X stdaudio_buffer = NULL;
+X unbias(getstringvalue(v), n);
+X resizestring(&v, n);
+X return v;
+X}
+X
+Xstatic object *
+Xaudio_stop_recording(self, args)
+X object *self;
+X object *args;
+X{
+X int n;
+X object *v;
+X char *s;
+X if (!getnoarg(args))
+X return NULL;
+X if (stdaudio_buffer == NULL) {
+X err_setstr(RuntimeError, "audio.stop_recording: not busy");
+X return NULL;
+X }
+X if ((n = asa_cancel()) < 0)
+X return NULL;
+X v = stdaudio_buffer;
+X stdaudio_buffer = NULL;
+X s = getstringvalue(v);
+X unbias(s, n);
+X resizestring(&v, n);
+X return v;
+X}
+X
+Xstatic object *
+Xaudio_start_playing(self, args)
+X object *self;
+X object *args;
+X{
+X object *v;
+X if (!getstrarg(args, &v))
+X return NULL;
+X if (stdaudio_buffer != NULL) {
+X err_setstr(RuntimeError, "audio.start_recording: device rbusy");
+X return NULL;
+X }
+X asa_start_write(getstringvalue(v), (int)getstringsize(v));
+X INCREF(v);
+X stdaudio_buffer = v;
+X INCREF(None);
+X return None;
+X}
+X
+Xstatic object *
+Xaudio_wait_playing(self, args)
+X object *self;
+X object *args;
+X{
+X int n;
+X if (!getnoarg(args))
+X return NULL;
+X if (stdaudio_buffer == NULL) {
+X err_setstr(RuntimeError, "audio.wait_playing: not busy");
+X return NULL;
+X }
+X if ((n = asa_wait()) < 0)
+X return NULL;
+X DECREF(stdaudio_buffer);
+X stdaudio_buffer = NULL;
+X /* XXX return newintobject((long)n); ??? */
+X INCREF(None);
+X return None;
+X}
+X
+Xstatic object *
+Xaudio_stop_playing(self, args)
+X object *self;
+X object *args;
+X{
+X int n;
+X if (!getnoarg(args))
+X return NULL;
+X if (stdaudio_buffer == NULL) {
+X err_setstr(RuntimeError, "audio.stop_playing: not busy");
+X return NULL;
+X }
+X if ((n = asa_cancel()) < 0)
+X return NULL;
+X DECREF(stdaudio_buffer);
+X stdaudio_buffer = NULL;
+X return newintobject((long)n);
+X}
+X
+Xstatic object *
+Xaudio_audio_done(self, args)
+X object *self;
+X object *args;
+X{
+X if (!getnoarg(args))
+X return NULL;
+X asa_done();
+X if (stdaudio_buffer != NULL)
+X DECREF(stdaudio_buffer);
+X stdaudio_buffer = NULL;
+X audio_fd = -1;
+X INCREF(None);
+X return None;
+X}
+X
+X
+Xstatic struct methodlist audio_methods[] = {
+X {"getingain", audio_getingain},
+X {"getoutgain", audio_getoutgain},
+X {"setingain", audio_setingain},
+X {"setoutgain", audio_setoutgain},
+X {"setrate", audio_setrate},
+X {"setduration", audio_setduration},
+X {"read", audio_read},
+X {"write", audio_write},
+X {"amplify", audio_amplify},
+X {"reverse", audio_reverse},
+X {"add", audio_add},
+X {"chr2num", audio_chr2num},
+X {"num2chr", audio_num2chr},
+X
+X /* "asa" interface: */
+X
+X {"start_recording", audio_start_recording},
+X {"poll_recording", audio_poll},
+X {"wait_recording", audio_wait_recording},
+X {"stop_recording", audio_stop_recording},
+X
+X {"start_playing", audio_start_playing},
+X {"poll_playing", audio_poll},
+X {"wait_playing", audio_wait_playing},
+X {"stop_playing", audio_stop_playing},
+X
+X {"done", audio_audio_done},
+X
+X {NULL, NULL} /* Sentinel */
+X};
+X
+Xvoid
+Xinitaudio()
+X{
+X initmodule("audio", audio_methods);
+X}
+EOF
+fi
+if test -s 'src/dictobject.c'
+then echo '*** I will not over-write existing file src/dictobject.c'
+else
+echo 'x - src/dictobject.c'
+sed 's/^X//' > 'src/dictobject.c' << 'EOF'
+X/***********************************************************
+XCopyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+XNetherlands.
+X
+X All Rights Reserved
+X
+XPermission to use, copy, modify, and distribute this software and its
+Xdocumentation for any purpose and without fee is hereby granted,
+Xprovided that the above copyright notice appear in all copies and that
+Xboth that copyright notice and this permission notice appear in
+Xsupporting documentation, and that the names of Stichting Mathematisch
+XCentrum or CWI not be used in advertising or publicity pertaining to
+Xdistribution of the software without specific, written prior permission.
+X
+XSTICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+XTHIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+XFITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+XFOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+XWHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+XACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+XOF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+X
+X******************************************************************/
+X
+X/* Dictionary object implementation; using a hash table */
+X
+X/*
+XXXX Note -- although this may look professional, I didn't think very hard
+Xabout the problem and it is possible that obvious improvements exist.
+XA similar module that I saw by Chris Torek:
+X- uses chaining instead of hashed linear probing
+X- remembers the hash value with the entry to speed up table resizing
+X- sets the table size to a power of 2
+X- uses a different hash function:
+X h = 0; p = str; while (*p) h = (h<<5) - h + *p++;
+X*/
+X
+X#include "allobjects.h"
+X
+X
+X/*
+XTable of primes suitable as keys, in ascending order.
+XThe first line are the largest primes less than some powers of two,
+Xthe second line is the largest prime less than 6000,
+Xand the third line is a selection from Knuth, Vol. 3, Sec. 6.1, Table 1.
+XThe final value is a sentinel and should cause the memory allocation
+Xof that many entries to fail (if none of the earlier values cause such
+Xfailure already).
+X*/
+Xstatic unsigned int primes[] = {
+X 3, 7, 13, 31, 61, 127, 251, 509, 1021, 2017, 4093,
+X 5987,
+X 9551, 15683, 19609, 31397,
+X 0xffffffff /* All bits set -- truncation OK */
+X};
+X
+X/* String used as dummy key to fill deleted entries */
+Xstatic stringobject *dummy; /* Initialized by first call to newdictobject() */
+X
+X/*
+XInvariant for entries: when in use, de_value is not NULL and de_key is
+Xnot NULL and not dummy; when not in use, de_value is NULL and de_key
+Xis either NULL or dummy. A dummy key value cannot be replaced by NULL,
+Xsince otherwise other keys may be lost.
+X*/
+Xtypedef struct {
+X stringobject *de_key;
+X object *de_value;
+X} dictentry;
+X
+X/*
+XTo ensure the lookup algorithm terminates, the table size must be a
+Xprime number and there must be at least one NULL key in the table.
+XThe value di_fill is the number of non-NULL keys; di_used is the number
+Xof non-NULL, non-dummy keys.
+XTo avoid slowing down lookups on a near-full table, we resize the table
+Xwhen it is more than half filled.
+X*/
+Xtypedef struct {
+X OB_HEAD
+X int di_fill;
+X int di_used;
+X int di_size;
+X dictentry *di_table;
+X} dictobject;
+X
+Xobject *
+Xnewdictobject()
+X{
+X register dictobject *dp;
+X if (dummy == NULL) { /* Auto-initialize dummy */
+X dummy = (stringobject *) newstringobject("");
+X if (dummy == NULL)
+X return NULL;
+X }
+X dp = NEWOBJ(dictobject, &Dicttype);
+X if (dp == NULL)
+X return NULL;
+X dp->di_size = primes[0];
+X dp->di_table = (dictentry *) calloc(sizeof(dictentry), dp->di_size);
+X if (dp->di_table == NULL) {
+X DEL(dp);
+X return err_nomem();
+X }
+X dp->di_fill = 0;
+X dp->di_used = 0;
+X return (object *)dp;
+X}
+X
+X/*
+XThe basic lookup function used by all operations.
+XThis is essentially Algorithm D from Knuth Vol. 3, Sec. 6.4.
+XOpen addressing is preferred over chaining since the link overhead for
+Xchaining would be substantial (100% with typical malloc overhead).
+X
+XFirst a 32-bit hash value, 'sum', is computed from the key string.
+XThe first character is added an extra time shifted by 8 to avoid hashing
+Xsingle-character keys (often heavily used variables) too close together.
+XAll arithmetic on sum should ignore overflow.
+X
+XThe initial probe index is then computed as sum mod the table size.
+XSubsequent probe indices are incr apart (mod table size), where incr
+Xis also derived from sum, with the additional requirement that it is
+Xrelative prime to the table size (i.e., 1 <= incr < size, since the size
+Xis a prime number). My choice for incr is somewhat arbitrary.
+X*/
+Xstatic dictentry *lookdict PROTO((dictobject *, char *));
+Xstatic dictentry *
+Xlookdict(dp, key)
+X register dictobject *dp;
+X char *key;
+X{
+X register int i, incr;
+X register dictentry *freeslot = NULL;
+X register unsigned char *p = (unsigned char *) key;
+X register unsigned long sum = *p << 7;
+X while (*p != '\0')
+X sum = sum + sum + *p++;
+X i = sum % dp->di_size;
+X do {
+X sum = sum + sum + 1;
+X incr = sum % dp->di_size;
+X } while (incr == 0);
+X for (;;) {
+X register dictentry *ep = &dp->di_table[i];
+X if (ep->de_key == NULL) {
+X if (freeslot != NULL)
+X return freeslot;
+X else
+X return ep;
+X }
+X if (ep->de_key == dummy) {
+X if (freeslot != NULL)
+X freeslot = ep;
+X }
+X else if (GETSTRINGVALUE(ep->de_key)[0] == key[0]) {
+X if (strcmp(GETSTRINGVALUE(ep->de_key), key) == 0) {
+X return ep;
+X }
+X }
+X i = (i + incr) % dp->di_size;
+X }
+X}
+X
+X/*
+XInternal routine to insert a new item into the table.
+XUsed both by the internal resize routine and by the public insert routine.
+XEats a reference to key and one to value.
+X*/
+Xstatic void insertdict PROTO((dictobject *, stringobject *, object *));
+Xstatic void
+Xinsertdict(dp, key, value)
+X register dictobject *dp;
+X stringobject *key;
+X object *value;
+X{
+X register dictentry *ep;
+X ep = lookdict(dp, GETSTRINGVALUE(key));
+X if (ep->de_value != NULL) {
+X DECREF(ep->de_value);
+X DECREF(key);
+X }
+X else {
+X if (ep->de_key == NULL)
+X dp->di_fill++;
+X else
+X DECREF(ep->de_key);
+X ep->de_key = key;
+X dp->di_used++;
+X }
+X ep->de_value = value;
+X}
+X
+X/*
+XRestructure the table by allocating a new table and reinserting all
+Xitems again. When entries have been deleted, the new table may
+Xactually be smaller than the old one.
+X*/
+Xstatic int dictresize PROTO((dictobject *));
+Xstatic int
+Xdictresize(dp)
+X dictobject *dp;
+X{
+X register int oldsize = dp->di_size;
+X register int newsize;
+X register dictentry *oldtable = dp->di_table;
+X register dictentry *newtable;
+X register dictentry *ep;
+X register int i;
+X newsize = dp->di_size;
+X for (i = 0; ; i++) {
+X if (primes[i] > dp->di_used*2) {
+X newsize = primes[i];
+X break;
+X }
+X }
+X newtable = (dictentry *) calloc(sizeof(dictentry), newsize);
+X if (newtable == NULL) {
+X err_nomem();
+X return -1;
+X }
+X dp->di_size = newsize;
+X dp->di_table = newtable;
+X dp->di_fill = 0;
+X dp->di_used = 0;
+X for (i = 0, ep = oldtable; i < oldsize; i++, ep++) {
+X if (ep->de_value != NULL)
+X insertdict(dp, ep->de_key, ep->de_value);
+X else if (ep->de_key != NULL)
+X DECREF(ep->de_key);
+X }
+X DEL(oldtable);
+X return 0;
+X}
+X
+Xobject *
+Xdictlookup(op, key)
+X object *op;
+X char *key;
+X{
+X if (!is_dictobject(op))
+X fatal("dictlookup on non-dictionary");
+X return lookdict((dictobject *)op, key) -> de_value;
+X}
+X
+X#ifdef NOT_USED
+Xstatic object *
+Xdict2lookup(op, key)
+X register object *op;
+X register object *key;
+X{
+X register object *res;
+X if (!is_dictobject(op)) {
+X err_badcall();
+X return NULL;
+X }
+X if (!is_stringobject(key)) {
+X err_badarg();
+X return NULL;
+X }
+X res = lookdict((dictobject *)op, ((stringobject *)key)->ob_sval)
+X -> de_value;
+X if (res == NULL)
+X err_setstr(KeyError, "key not in dictionary");
+X return res;
+X}
+X#endif
+X
+Xstatic int
+Xdict2insert(op, key, value)
+X register object *op;
+X object *key;
+X object *value;
+X{
+X register dictobject *dp;
+X register stringobject *keyobj;
+X if (!is_dictobject(op)) {
+X err_badcall();
+X return -1;
+X }
+X dp = (dictobject *)op;
+X if (!is_stringobject(key)) {
+X err_badarg();
+X return -1;
+X }
+X keyobj = (stringobject *)key;
+X /* if fill >= 2/3 size, resize */
+X if (dp->di_fill*3 >= dp->di_size*2) {
+X if (dictresize(dp) != 0) {
+X if (dp->di_fill+1 > dp->di_size)
+X return -1;
+X }
+X }
+X INCREF(keyobj);
+X INCREF(value);
+X insertdict(dp, keyobj, value);
+X return 0;
+X}
+X
+Xint
+Xdictinsert(op, key, value)
+X object *op;
+X char *key;
+X object *value;
+X{
+X register object *keyobj;
+X register int err;
+X keyobj = newstringobject(key);
+X if (keyobj == NULL) {
+X err_nomem();
+X return -1;
+X }
+X err = dict2insert(op, keyobj, value);
+X DECREF(keyobj);
+X return err;
+X}
+X
+Xint
+Xdictremove(op, key)
+X object *op;
+X char *key;
+X{
+X register dictobject *dp;
+X register dictentry *ep;
+X if (!is_dictobject(op)) {
+X err_badcall();
+X return -1;
+X }
+X dp = (dictobject *)op;
+X ep = lookdict(dp, key);
+X if (ep->de_value == NULL) {
+X err_setstr(KeyError, "key not in dictionary");
+X return -1;
+X }
+X DECREF(ep->de_key);
+X INCREF(dummy);
+X ep->de_key = dummy;
+X DECREF(ep->de_value);
+X ep->de_value = NULL;
+X dp->di_used--;
+X return 0;
+X}
+X
+Xstatic int
+Xdict2remove(op, key)
+X object *op;
+X register object *key;
+X{
+X if (!is_stringobject(key)) {
+X err_badarg();
+X return -1;
+X }
+X return dictremove(op, GETSTRINGVALUE((stringobject *)key));
+X}
+X
+Xint
+Xgetdictsize(op)
+X register object *op;
+X{
+X if (!is_dictobject(op)) {
+X err_badcall();
+X return -1;
+X }
+X return ((dictobject *)op) -> di_size;
+X}
+X
+Xstatic object *
+Xgetdict2key(op, i)
+X object *op;
+X register int i;
+X{
+X /* XXX This can't return errors since its callers assume
+X that NULL means there was no key at that point */
+X register dictobject *dp;
+X if (!is_dictobject(op)) {
+X /* err_badcall(); */
+X return NULL;
+X }
+X dp = (dictobject *)op;
+X if (i < 0 || i >= dp->di_size) {
+X /* err_badarg(); */
+X return NULL;
+X }
+X if (dp->di_table[i].de_value == NULL) {
+X /* Not an error! */
+X return NULL;
+X }
+X return (object *) dp->di_table[i].de_key;
+X}
+X
+Xchar *
+Xgetdictkey(op, i)
+X object *op;
+X int i;
+X{
+X register object *keyobj = getdict2key(op, i);
+X if (keyobj == NULL)
+X return NULL;
+X return GETSTRINGVALUE((stringobject *)keyobj);
+X}
+X
+X/* Methods */
+X
+Xstatic void
+Xdict_dealloc(dp)
+X register dictobject *dp;
+X{
+X register int i;
+X register dictentry *ep;
+X for (i = 0, ep = dp->di_table; i < dp->di_size; i++, ep++) {
+X if (ep->de_key != NULL)
+X DECREF(ep->de_key);
+X if (ep->de_value != NULL)
+X DECREF(ep->de_value);
+X }
+X if (dp->di_table != NULL)
+X DEL(dp->di_table);
+X DEL(dp);
+X}
+X
+Xstatic void
+Xdict_print(dp, fp, flags)
+X register dictobject *dp;
+X register FILE *fp;
+X register int flags;
+X{
+X register int i;
+X register int any;
+X register dictentry *ep;
+X fprintf(fp, "{");
+X any = 0;
+X for (i = 0, ep = dp->di_table; i < dp->di_size && !StopPrint;
+X i++, ep++) {
+X if (ep->de_value != NULL) {
+X if (any++ > 0)
+X fprintf(fp, "; ");
+X printobject((object *)ep->de_key, fp, flags);
+X fprintf(fp, ": ");
+X printobject(ep->de_value, fp, flags);
+X }
+X }
+X fprintf(fp, "}");
+X}
+X
+Xstatic void
+Xjs(pv, w)
+X object **pv;
+X object *w;
+X{
+X joinstring(pv, w);
+X if (w != NULL)
+X DECREF(w);
+X}
+X
+Xstatic object *
+Xdict_repr(dp)
+X dictobject *dp;
+X{
+X auto object *v;
+X register object *w;
+X object *semi, *colon;
+X register int i;
+X register int any;
+X register dictentry *ep;
+X v = newstringobject("{");
+X semi = newstringobject("; ");
+X colon = newstringobject(": ");
+X any = 0;
+X for (i = 0, ep = dp->di_table; i < dp->di_size && !StopPrint;
+X i++, ep++) {
+X if (ep->de_value != NULL) {
+X if (any++)
+X joinstring(&v, semi);
+X js(&v, w = reprobject((object *)ep->de_key));
+X joinstring(&v, colon);
+X js(&v, w = reprobject(ep->de_value));
+X }
+X }
+X js(&v, w = newstringobject("}"));
+X if (semi != NULL)
+X DECREF(semi);
+X if (colon != NULL)
+X DECREF(colon);
+X return v;
+X}
+X
+Xstatic int
+Xdict_length(dp)
+X dictobject *dp;
+X{
+X return dp->di_used;
+X}
+X
+Xstatic object *
+Xdict_subscript(dp, v)
+X dictobject *dp;
+X register object *v;
+X{
+X if (!is_stringobject(v)) {
+X err_badarg();
+X return NULL;
+X }
+X v = lookdict(dp, GETSTRINGVALUE((stringobject *)v)) -> de_value;
+X if (v == NULL)
+X err_setstr(KeyError, "key not in dictionary");
+X else
+X INCREF(v);
+X return v;
+X}
+X
+Xstatic int
+Xdict_ass_sub(dp, v, w)
+X dictobject *dp;
+X object *v, *w;
+X{
+X if (w == NULL)
+X return dict2remove((object *)dp, v);
+X else
+X return dict2insert((object *)dp, v, w);
+X}
+X
+Xstatic mapping_methods dict_as_mapping = {
+X dict_length, /*mp_length*/
+X dict_subscript, /*mp_subscript*/
+X dict_ass_sub, /*mp_ass_subscript*/
+X};
+X
+Xstatic object *
+Xdict_keys(dp, args)
+X register dictobject *dp;
+X object *args;
+X{
+X register object *v;
+X register int i, j;
+X if (!getnoarg(args))
+X return NULL;
+X v = newlistobject(dp->di_used);
+X if (v == NULL)
+X return NULL;
+X for (i = 0, j = 0; i < dp->di_size; i++) {
+X if (dp->di_table[i].de_value != NULL) {
+X stringobject *key = dp->di_table[i].de_key;
+X INCREF(key);
+X setlistitem(v, j, (object *)key);
+X j++;
+X }
+X }
+X return v;
+X}
+X
+Xobject *
+Xgetdictkeys(dp)
+X object *dp;
+X{
+X if (dp == NULL || !is_dictobject(dp)) {
+X err_badcall();
+X return NULL;
+X }
+X return dict_keys((dictobject *)dp, (object *)NULL);
+X}
+X
+Xstatic object *
+Xdict_has_key(dp, args)
+X register dictobject *dp;
+X object *args;
+X{
+X object *key;
+X register long ok;
+X if (!getstrarg(args, &key))
+X return NULL;
+X ok = lookdict(dp, GETSTRINGVALUE((stringobject *)key))->de_value
+X != NULL;
+X return newintobject(ok);
+X}
+X
+Xstatic struct methodlist dict_methods[] = {
+X {"keys", dict_keys},
+X {"has_key", dict_has_key},
+X {NULL, NULL} /* sentinel */
+X};
+X
+Xstatic object *
+Xdict_getattr(dp, name)
+X dictobject *dp;
+X char *name;
+X{
+X return findmethod(dict_methods, (object *)dp, name);
+X}
+X
+Xtypeobject Dicttype = {
+X OB_HEAD_INIT(&Typetype)
+X 0,
+X "dictionary",
+X sizeof(dictobject),
+X 0,
+X dict_dealloc, /*tp_dealloc*/
+X dict_print, /*tp_print*/
+X dict_getattr, /*tp_getattr*/
+X 0, /*tp_setattr*/
+X 0, /*tp_compare*/
+X dict_repr, /*tp_repr*/
+X 0, /*tp_as_number*/
+X 0, /*tp_as_sequence*/
+X &dict_as_mapping, /*tp_as_mapping*/
+X};
+EOF
+fi
+if test -s 'src/pgen.c'
+then echo '*** I will not over-write existing file src/pgen.c'
+else
+echo 'x - src/pgen.c'
+sed 's/^X//' > 'src/pgen.c' << 'EOF'
+X/***********************************************************
+XCopyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+XNetherlands.
+X
+X All Rights Reserved
+X
+XPermission to use, copy, modify, and distribute this software and its
+Xdocumentation for any purpose and without fee is hereby granted,
+Xprovided that the above copyright notice appear in all copies and that
+Xboth that copyright notice and this permission notice appear in
+Xsupporting documentation, and that the names of Stichting Mathematisch
+XCentrum or CWI not be used in advertising or publicity pertaining to
+Xdistribution of the software without specific, written prior permission.
+X
+XSTICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+XTHIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+XFITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+XFOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+XWHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+XACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+XOF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+X
+X******************************************************************/
+X
+X/* Parser generator */
+X/* XXX This file is not yet fully PROTOized */
+X
+X/* For a description, see the comments at end of this file */
+X
+X#include "pgenheaders.h"
+X#include "assert.h"
+X#include "token.h"
+X#include "node.h"
+X#include "grammar.h"
+X#include "metagrammar.h"
+X#include "pgen.h"
+X
+Xextern int debugging;
+X
+X
+X/* PART ONE -- CONSTRUCT NFA -- Cf. Algorithm 3.2 from [Aho&Ullman 77] */
+X
+Xtypedef struct _nfaarc {
+X int ar_label;
+X int ar_arrow;
+X} nfaarc;
+X
+Xtypedef struct _nfastate {
+X int st_narcs;
+X nfaarc *st_arc;
+X} nfastate;
+X
+Xtypedef struct _nfa {
+X int nf_type;
+X char *nf_name;
+X int nf_nstates;
+X nfastate *nf_state;
+X int nf_start, nf_finish;
+X} nfa;
+X
+Xstatic int
+Xaddnfastate(nf)
+X nfa *nf;
+X{
+X nfastate *st;
+X
+X RESIZE(nf->nf_state, nfastate, nf->nf_nstates + 1);
+X if (nf->nf_state == NULL)
+X fatal("out of mem");
+X st = &nf->nf_state[nf->nf_nstates++];
+X st->st_narcs = 0;
+X st->st_arc = NULL;
+X return st - nf->nf_state;
+X}
+X
+Xstatic void
+Xaddnfaarc(nf, from, to, lbl)
+X nfa *nf;
+X int from, to, lbl;
+X{
+X nfastate *st;
+X nfaarc *ar;
+X
+X st = &nf->nf_state[from];
+X RESIZE(st->st_arc, nfaarc, st->st_narcs + 1);
+X if (st->st_arc == NULL)
+X fatal("out of mem");
+X ar = &st->st_arc[st->st_narcs++];
+X ar->ar_label = lbl;
+X ar->ar_arrow = to;
+X}
+X
+Xstatic nfa *
+Xnewnfa(name)
+X char *name;
+X{
+X nfa *nf;
+X static type = NT_OFFSET; /* All types will be disjunct */
+X
+X nf = NEW(nfa, 1);
+X if (nf == NULL)
+X fatal("no mem for new nfa");
+X nf->nf_type = type++;
+X nf->nf_name = name; /* XXX strdup(name) ??? */
+X nf->nf_nstates = 0;
+X nf->nf_state = NULL;
+X nf->nf_start = nf->nf_finish = -1;
+X return nf;
+X}
+X
+Xtypedef struct _nfagrammar {
+X int gr_nnfas;
+X nfa **gr_nfa;
+X labellist gr_ll;
+X} nfagrammar;
+X
+Xstatic nfagrammar *
+Xnewnfagrammar()
+X{
+X nfagrammar *gr;
+X
+X gr = NEW(nfagrammar, 1);
+X if (gr == NULL)
+X fatal("no mem for new nfa grammar");
+X gr->gr_nnfas = 0;
+X gr->gr_nfa = NULL;
+X gr->gr_ll.ll_nlabels = 0;
+X gr->gr_ll.ll_label = NULL;
+X addlabel(&gr->gr_ll, ENDMARKER, "EMPTY");
+X return gr;
+X}
+X
+Xstatic nfa *
+Xaddnfa(gr, name)
+X nfagrammar *gr;
+X char *name;
+X{
+X nfa *nf;
+X
+X nf = newnfa(name);
+X RESIZE(gr->gr_nfa, nfa *, gr->gr_nnfas + 1);
+X if (gr->gr_nfa == NULL)
+X fatal("out of mem");
+X gr->gr_nfa[gr->gr_nnfas++] = nf;
+X addlabel(&gr->gr_ll, NAME, nf->nf_name);
+X return nf;
+X}
+X
+X#ifdef DEBUG
+X
+Xstatic char REQNFMT[] = "metacompile: less than %d children\n";
+X
+X#define REQN(i, count) \
+X if (i < count) { \
+X fprintf(stderr, REQNFMT, count); \
+X abort(); \
+X } else
+X
+X#else
+X#define REQN(i, count) /* empty */
+X#endif
+X
+Xstatic nfagrammar *
+Xmetacompile(n)
+X node *n;
+X{
+X nfagrammar *gr;
+X int i;
+X
+X printf("Compiling (meta-) parse tree into NFA grammar\n");
+X gr = newnfagrammar();
+X REQ(n, MSTART);
+X i = n->n_nchildren - 1; /* Last child is ENDMARKER */
+X n = n->n_child;
+X for (; --i >= 0; n++) {
+X if (n->n_type != NEWLINE)
+X compile_rule(gr, n);
+X }
+X return gr;
+X}
+X
+Xstatic
+Xcompile_rule(gr, n)
+X nfagrammar *gr;
+X node *n;
+X{
+X nfa *nf;
+X
+X REQ(n, RULE);
+X REQN(n->n_nchildren, 4);
+X n = n->n_child;
+X REQ(n, NAME);
+X nf = addnfa(gr, n->n_str);
+X n++;
+X REQ(n, COLON);
+X n++;
+X REQ(n, RHS);
+X compile_rhs(&gr->gr_ll, nf, n, &nf->nf_start, &nf->nf_finish);
+X n++;
+X REQ(n, NEWLINE);
+X}
+X
+Xstatic
+Xcompile_rhs(ll, nf, n, pa, pb)
+X labellist *ll;
+X nfa *nf;
+X node *n;
+X int *pa, *pb;
+X{
+X int i;
+X int a, b;
+X
+X REQ(n, RHS);
+X i = n->n_nchildren;
+X REQN(i, 1);
+X n = n->n_child;
+X REQ(n, ALT);
+X compile_alt(ll, nf, n, pa, pb);
+X if (--i <= 0)
+X return;
+X n++;
+X a = *pa;
+X b = *pb;
+X *pa = addnfastate(nf);
+X *pb = addnfastate(nf);
+X addnfaarc(nf, *pa, a, EMPTY);
+X addnfaarc(nf, b, *pb, EMPTY);
+X for (; --i >= 0; n++) {
+X REQ(n, VBAR);
+X REQN(i, 1);
+X --i;
+X n++;
+X REQ(n, ALT);
+X compile_alt(ll, nf, n, &a, &b);
+X addnfaarc(nf, *pa, a, EMPTY);
+X addnfaarc(nf, b, *pb, EMPTY);
+X }
+X}
+X
+Xstatic
+Xcompile_alt(ll, nf, n, pa, pb)
+X labellist *ll;
+X nfa *nf;
+X node *n;
+X int *pa, *pb;
+X{
+X int i;
+X int a, b;
+X
+X REQ(n, ALT);
+X i = n->n_nchildren;
+X REQN(i, 1);
+X n = n->n_child;
+X REQ(n, ITEM);
+X compile_item(ll, nf, n, pa, pb);
+X --i;
+X n++;
+X for (; --i >= 0; n++) {
+X if (n->n_type == COMMA) { /* XXX Temporary */
+X REQN(i, 1);
+X --i;
+X n++;
+X }
+X REQ(n, ITEM);
+X compile_item(ll, nf, n, &a, &b);
+X addnfaarc(nf, *pb, a, EMPTY);
+X *pb = b;
+X }
+X}
+X
+Xstatic
+Xcompile_item(ll, nf, n, pa, pb)
+X labellist *ll;
+X nfa *nf;
+X node *n;
+X int *pa, *pb;
+X{
+X int i;
+X int a, b;
+X
+X REQ(n, ITEM);
+X i = n->n_nchildren;
+X REQN(i, 1);
+X n = n->n_child;
+X if (n->n_type == LSQB) {
+X REQN(i, 3);
+X n++;
+X REQ(n, RHS);
+X *pa = addnfastate(nf);
+X *pb = addnfastate(nf);
+X addnfaarc(nf, *pa, *pb, EMPTY);
+X compile_rhs(ll, nf, n, &a, &b);
+X addnfaarc(nf, *pa, a, EMPTY);
+X addnfaarc(nf, b, *pb, EMPTY);
+X REQN(i, 1);
+X n++;
+X REQ(n, RSQB);
+X }
+X else {
+X compile_atom(ll, nf, n, pa, pb);
+X if (--i <= 0)
+X return;
+X n++;
+X addnfaarc(nf, *pb, *pa, EMPTY);
+X if (n->n_type == STAR)
+X *pb = *pa;
+X else
+X REQ(n, PLUS);
+X }
+X}
+X
+Xstatic
+Xcompile_atom(ll, nf, n, pa, pb)
+X labellist *ll;
+X nfa *nf;
+X node *n;
+X int *pa, *pb;
+X{
+X int i;
+X
+X REQ(n, ATOM);
+X i = n->n_nchildren;
+X REQN(i, 1);
+X n = n->n_child;
+X if (n->n_type == LPAR) {
+X REQN(i, 3);
+X n++;
+X REQ(n, RHS);
+X compile_rhs(ll, nf, n, pa, pb);
+X n++;
+X REQ(n, RPAR);
+X }
+X else if (n->n_type == NAME || n->n_type == STRING) {
+X *pa = addnfastate(nf);
+X *pb = addnfastate(nf);
+X addnfaarc(nf, *pa, *pb, addlabel(ll, n->n_type, n->n_str));
+X }
+X else
+X REQ(n, NAME);
+X}
+X
+Xstatic void
+Xdumpstate(ll, nf, istate)
+X labellist *ll;
+X nfa *nf;
+X int istate;
+X{
+X nfastate *st;
+X int i;
+X nfaarc *ar;
+X
+X printf("%c%2d%c",
+X istate == nf->nf_start ? '*' : ' ',
+X istate,
+X istate == nf->nf_finish ? '.' : ' ');
+X st = &nf->nf_state[istate];
+X ar = st->st_arc;
+X for (i = 0; i < st->st_narcs; i++) {
+X if (i > 0)
+X printf("\n ");
+X printf("-> %2d %s", ar->ar_arrow,
+X labelrepr(&ll->ll_label[ar->ar_label]));
+X ar++;
+X }
+X printf("\n");
+X}
+X
+Xstatic void
+Xdumpnfa(ll, nf)
+X labellist *ll;
+X nfa *nf;
+X{
+X int i;
+X
+X printf("NFA '%s' has %d states; start %d, finish %d\n",
+X nf->nf_name, nf->nf_nstates, nf->nf_start, nf->nf_finish);
+X for (i = 0; i < nf->nf_nstates; i++)
+X dumpstate(ll, nf, i);
+X}
+X
+X
+X/* PART TWO -- CONSTRUCT DFA -- Algorithm 3.1 from [Aho&Ullman 77] */
+X
+Xstatic int
+Xaddclosure(ss, nf, istate)
+X bitset ss;
+X nfa *nf;
+X int istate;
+X{
+X if (addbit(ss, istate)) {
+X nfastate *st = &nf->nf_state[istate];
+X nfaarc *ar = st->st_arc;
+X int i;
+X
+X for (i = st->st_narcs; --i >= 0; ) {
+X if (ar->ar_label == EMPTY)
+X addclosure(ss, nf, ar->ar_arrow);
+X ar++;
+X }
+X }
+X}
+X
+Xtypedef struct _ss_arc {
+X bitset sa_bitset;
+X int sa_arrow;
+X int sa_label;
+X} ss_arc;
+X
+Xtypedef struct _ss_state {
+X bitset ss_ss;
+X int ss_narcs;
+X ss_arc *ss_arc;
+X int ss_deleted;
+X int ss_finish;
+X int ss_rename;
+X} ss_state;
+X
+Xtypedef struct _ss_dfa {
+X int sd_nstates;
+X ss_state *sd_state;
+X} ss_dfa;
+X
+Xstatic
+Xmakedfa(gr, nf, d)
+X nfagrammar *gr;
+X nfa *nf;
+X dfa *d;
+X{
+X int nbits = nf->nf_nstates;
+X bitset ss;
+X int xx_nstates;
+X ss_state *xx_state, *yy;
+X ss_arc *zz;
+X int istate, jstate, iarc, jarc, ibit;
+X nfastate *st;
+X nfaarc *ar;
+X
+X ss = newbitset(nbits);
+X addclosure(ss, nf, nf->nf_start);
+X xx_state = NEW(ss_state, 1);
+X if (xx_state == NULL)
+X fatal("no mem for xx_state in makedfa");
+X xx_nstates = 1;
+X yy = &xx_state[0];
+X yy->ss_ss = ss;
+X yy->ss_narcs = 0;
+X yy->ss_arc = NULL;
+X yy->ss_deleted = 0;
+X yy->ss_finish = testbit(ss, nf->nf_finish);
+X if (yy->ss_finish)
+X printf("Error: nonterminal '%s' may produce empty.\n",
+X nf->nf_name);
+X
+X /* This algorithm is from a book written before
+X the invention of structured programming... */
+X
+X /* For each unmarked state... */
+X for (istate = 0; istate < xx_nstates; ++istate) {
+X yy = &xx_state[istate];
+X ss = yy->ss_ss;
+X /* For all its states... */
+X for (ibit = 0; ibit < nf->nf_nstates; ++ibit) {
+X if (!testbit(ss, ibit))
+X continue;
+X st = &nf->nf_state[ibit];
+X /* For all non-empty arcs from this state... */
+X for (iarc = 0; iarc < st->st_narcs; iarc++) {
+X ar = &st->st_arc[iarc];
+X if (ar->ar_label == EMPTY)
+X continue;
+X /* Look up in list of arcs from this state */
+X for (jarc = 0; jarc < yy->ss_narcs; ++jarc) {
+X zz = &yy->ss_arc[jarc];
+X if (ar->ar_label == zz->sa_label)
+X goto found;
+X }
+X /* Add new arc for this state */
+X RESIZE(yy->ss_arc, ss_arc, yy->ss_narcs + 1);
+X if (yy->ss_arc == NULL)
+X fatal("out of mem");
+X zz = &yy->ss_arc[yy->ss_narcs++];
+X zz->sa_label = ar->ar_label;
+X zz->sa_bitset = newbitset(nbits);
+X zz->sa_arrow = -1;
+X found: ;
+X /* Add destination */
+X addclosure(zz->sa_bitset, nf, ar->ar_arrow);
+X }
+X }
+X /* Now look up all the arrow states */
+X for (jarc = 0; jarc < xx_state[istate].ss_narcs; jarc++) {
+X zz = &xx_state[istate].ss_arc[jarc];
+X for (jstate = 0; jstate < xx_nstates; jstate++) {
+X if (samebitset(zz->sa_bitset,
+X xx_state[jstate].ss_ss, nbits)) {
+X zz->sa_arrow = jstate;
+X goto done;
+X }
+X }
+X RESIZE(xx_state, ss_state, xx_nstates + 1);
+X if (xx_state == NULL)
+X fatal("out of mem");
+X zz->sa_arrow = xx_nstates;
+X yy = &xx_state[xx_nstates++];
+X yy->ss_ss = zz->sa_bitset;
+X yy->ss_narcs = 0;
+X yy->ss_arc = NULL;
+X yy->ss_deleted = 0;
+X yy->ss_finish = testbit(yy->ss_ss, nf->nf_finish);
+X done: ;
+X }
+X }
+X
+X if (debugging)
+X printssdfa(xx_nstates, xx_state, nbits, &gr->gr_ll,
+X "before minimizing");
+X
+X simplify(xx_nstates, xx_state);
+X
+X if (debugging)
+X printssdfa(xx_nstates, xx_state, nbits, &gr->gr_ll,
+X "after minimizing");
+X
+X convert(d, xx_nstates, xx_state);
+X
+X /* XXX cleanup */
+X}
+X
+Xstatic
+Xprintssdfa(xx_nstates, xx_state, nbits, ll, msg)
+X int xx_nstates;
+X ss_state *xx_state;
+X int nbits;
+X labellist *ll;
+X char *msg;
+X{
+X int i, ibit, iarc;
+X ss_state *yy;
+X ss_arc *zz;
+X
+X printf("Subset DFA %s\n", msg);
+X for (i = 0; i < xx_nstates; i++) {
+X yy = &xx_state[i];
+X if (yy->ss_deleted)
+X continue;
+X printf(" Subset %d", i);
+X if (yy->ss_finish)
+X printf(" (finish)");
+X printf(" { ");
+X for (ibit = 0; ibit < nbits; ibit++) {
+X if (testbit(yy->ss_ss, ibit))
+X printf("%d ", ibit);
+X }
+X printf("}\n");
+X for (iarc = 0; iarc < yy->ss_narcs; iarc++) {
+X zz = &yy->ss_arc[iarc];
+X printf(" Arc to state %d, label %s\n",
+X zz->sa_arrow,
+X labelrepr(&ll->ll_label[zz->sa_label]));
+X }
+X }
+X}
+X
+X
+X/* PART THREE -- SIMPLIFY DFA */
+X
+X/* Simplify the DFA by repeatedly eliminating states that are
+X equivalent to another oner. This is NOT Algorithm 3.3 from
+X [Aho&Ullman 77]. It does not always finds the minimal DFA,
+X but it does usually make a much smaller one... (For an example
+X of sub-optimal behaviour, try S: x a b+ | y a b+.)
+X*/
+X
+Xstatic int
+Xsamestate(s1, s2)
+X ss_state *s1, *s2;
+X{
+X int i;
+X
+X if (s1->ss_narcs != s2->ss_narcs || s1->ss_finish != s2->ss_finish)
+X return 0;
+X for (i = 0; i < s1->ss_narcs; i++) {
+X if (s1->ss_arc[i].sa_arrow != s2->ss_arc[i].sa_arrow ||
+X s1->ss_arc[i].sa_label != s2->ss_arc[i].sa_label)
+X return 0;
+X }
+X return 1;
+X}
+X
+Xstatic void
+Xrenamestates(xx_nstates, xx_state, from, to)
+X int xx_nstates;
+X ss_state *xx_state;
+X int from, to;
+X{
+X int i, j;
+X
+X if (debugging)
+X printf("Rename state %d to %d.\n", from, to);
+X for (i = 0; i < xx_nstates; i++) {
+X if (xx_state[i].ss_deleted)
+X continue;
+X for (j = 0; j < xx_state[i].ss_narcs; j++) {
+X if (xx_state[i].ss_arc[j].sa_arrow == from)
+X xx_state[i].ss_arc[j].sa_arrow = to;
+X }
+X }
+X}
+X
+Xstatic
+Xsimplify(xx_nstates, xx_state)
+X int xx_nstates;
+X ss_state *xx_state;
+X{
+X int changes;
+X int i, j, k;
+X
+X do {
+X changes = 0;
+X for (i = 1; i < xx_nstates; i++) {
+X if (xx_state[i].ss_deleted)
+X continue;
+X for (j = 0; j < i; j++) {
+X if (xx_state[j].ss_deleted)
+X continue;
+X if (samestate(&xx_state[i], &xx_state[j])) {
+X xx_state[i].ss_deleted++;
+X renamestates(xx_nstates, xx_state, i, j);
+X changes++;
+X break;
+X }
+X }
+X }
+X } while (changes);
+X}
+X
+X
+X/* PART FOUR -- GENERATE PARSING TABLES */
+X
+X/* Convert the DFA into a grammar that can be used by our parser */
+X
+Xstatic
+Xconvert(d, xx_nstates, xx_state)
+X dfa *d;
+X int xx_nstates;
+X ss_state *xx_state;
+X{
+X int i, j;
+X ss_state *yy;
+X ss_arc *zz;
+X
+X for (i = 0; i < xx_nstates; i++) {
+X yy = &xx_state[i];
+X if (yy->ss_deleted)
+X continue;
+X yy->ss_rename = addstate(d);
+X }
+X
+X for (i = 0; i < xx_nstates; i++) {
+X yy = &xx_state[i];
+X if (yy->ss_deleted)
+X continue;
+X for (j = 0; j < yy->ss_narcs; j++) {
+X zz = &yy->ss_arc[j];
+X addarc(d, yy->ss_rename,
+X xx_state[zz->sa_arrow].ss_rename,
+X zz->sa_label);
+X }
+X if (yy->ss_finish)
+X addarc(d, yy->ss_rename, yy->ss_rename, 0);
+X }
+X
+X d->d_initial = 0;
+X}
+X
+X
+X/* PART FIVE -- GLUE IT ALL TOGETHER */
+X
+Xstatic grammar *
+Xmaketables(gr)
+X nfagrammar *gr;
+X{
+X int i;
+X nfa *nf;
+X dfa *d;
+X grammar *g;
+X
+X if (gr->gr_nnfas == 0)
+X return NULL;
+X g = newgrammar(gr->gr_nfa[0]->nf_type);
+X /* XXX first rule must be start rule */
+X g->g_ll = gr->gr_ll;
+X
+X for (i = 0; i < gr->gr_nnfas; i++) {
+X nf = gr->gr_nfa[i];
+X if (debugging) {
+X printf("Dump of NFA for '%s' ...\n", nf->nf_name);
+X dumpnfa(&gr->gr_ll, nf);
+X }
+X printf("Making DFA for '%s' ...\n", nf->nf_name);
+X d = adddfa(g, nf->nf_type, nf->nf_name);
+X makedfa(gr, gr->gr_nfa[i], d);
+X }
+X
+X return g;
+X}
+X
+Xgrammar *
+Xpgen(n)
+X node *n;
+X{
+X nfagrammar *gr;
+X grammar *g;
+X
+X gr = metacompile(n);
+X g = maketables(gr);
+X translatelabels(g);
+X addfirstsets(g);
+X return g;
+X}
+X
+X
+X/*
+X
+XDescription
+X-----------
+X
+XInput is a grammar in extended BNF (using * for repetition, + for
+Xat-least-once repetition, [] for optional parts, | for alternatives and
+X() for grouping). This has already been parsed and turned into a parse
+Xtree.
+X
+XEach rule is considered as a regular expression in its own right.
+XIt is turned into a Non-deterministic Finite Automaton (NFA), which
+Xis then turned into a Deterministic Finite Automaton (DFA), which is then
+Xoptimized to reduce the number of states. See [Aho&Ullman 77] chapter 3,
+Xor similar compiler books (this technique is more often used for lexical
+Xanalyzers).
+X
+XThe DFA's are used by the parser as parsing tables in a special way
+Xthat's probably unique. Before they are usable, the FIRST sets of all
+Xnon-terminals are computed.
+X
+XReference
+X---------
+X
+X[Aho&Ullman 77]
+X Aho&Ullman, Principles of Compiler Design, Addison-Wesley 1977
+X (first edition)
+X
+X*/
+EOF
+fi
+if test -s 'src/regexpmodule.c'
+then echo '*** I will not over-write existing file src/regexpmodule.c'
+else
+echo 'x - src/regexpmodule.c'
+sed 's/^X//' > 'src/regexpmodule.c' << 'EOF'
+X/***********************************************************
+XCopyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+XNetherlands.
+X
+X All Rights Reserved
+X
+XPermission to use, copy, modify, and distribute this software and its
+Xdocumentation for any purpose and without fee is hereby granted,
+Xprovided that the above copyright notice appear in all copies and that
+Xboth that copyright notice and this permission notice appear in
+Xsupporting documentation, and that the names of Stichting Mathematisch
+XCentrum or CWI not be used in advertising or publicity pertaining to
+Xdistribution of the software without specific, written prior permission.
+X
+XSTICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+XTHIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+XFITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+XFOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+XWHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+XACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+XOF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+X
+X******************************************************************/
+X
+X/* Regular expression objects */
+X/* This needs V8 or Henry Spencer's regexp! */
+X
+X#include "allobjects.h"
+X#include "modsupport.h"
+X
+X#include "regexp.h"
+X
+Xstatic object *RegexpError; /* Exception */
+X
+Xtypedef struct {
+X OB_HEAD
+X object *re_string; /* The string (for printing) */
+X regexp *re_prog; /* The compiled regular expression */
+X} regexpobject;
+X
+Xextern typeobject Regexptype; /* Really static, forward */
+X
+Xstatic regexpobject *
+Xnewregexpobject(string, prog)
+X object *string;
+X regexp *prog;
+X{
+X regexpobject *re;
+X re = NEWOBJ(regexpobject, &Regexptype);
+X if (re != NULL) {
+X XINCREF(string);
+X re->re_string = string;
+X re->re_prog = prog;
+X }
+X return re;
+X}
+X
+X/* Regexp methods */
+X
+Xstatic void
+Xregexp_dealloc(re)
+X regexpobject *re;
+X{
+X XDECREF(re->re_string);
+X XDEL(re->re_prog);
+X DEL(re);
+X}
+X
+Xstatic object *
+Xmakeresult(prog, buffer)
+X regexp *prog;
+X char *buffer;
+X{
+X int n;
+X object *v;
+X /* Count substrings found, including \0, the main one */
+X for (n = 0; n < 10 && prog->startp[n] != NULL; n++)
+X ;
+X v = newtupleobject(n);
+X if (v != NULL) {
+X int i;
+X for (i = 0; i < n; i++) {
+X object *w, *u;
+X long start, end;
+X start = prog->startp[i] - buffer;
+X end = prog->endp[i] - buffer;
+X if ( (w = newtupleobject(2)) == NULL ||
+X (u = newintobject(start)) == NULL ||
+X settupleitem(w, 0, u) != 0 ||
+X (u = newintobject(end)) == NULL ||
+X settupleitem(w, 1, u) != 0) {
+X XDECREF(w);
+X DECREF(v);
+X return NULL;
+X }
+X settupleitem(v, i, w);
+X }
+X }
+X return v;
+X}
+X
+Xstatic object *
+Xregexp_exec(re, args)
+X regexpobject *re;
+X object *args;
+X{
+X object *v;
+X char *buffer;
+X int offset;
+X if (args != NULL && is_stringobject(args)) {
+X v = args;
+X offset = 0;
+X }
+X else if (!getstrintarg(args, &v, &offset))
+X return NULL;
+X buffer = getstringvalue(v);
+X#ifndef MULTILINE
+X#define reglexec(prog, str, offset) regexec((prog), (str)+(offset))
+X#endif
+X if (!reglexec(re->re_prog, buffer, offset))
+X return newtupleobject(0);
+X return makeresult(re->re_prog, buffer);
+X}
+X
+Xstatic struct methodlist regexp_methods[] = {
+X "exec", regexp_exec,
+X {NULL, NULL} /* sentinel */
+X};
+X
+Xstatic object *
+Xregexp_getattr(re, name)
+X regexpobject *re;
+X char *name;
+X{
+X return findmethod(regexp_methods, (object *)re, name);
+X}
+X
+Xstatic typeobject Regexptype = {
+X OB_HEAD_INIT(&Typetype)
+X 0, /*ob_size*/
+X "regexp", /*tp_name*/
+X sizeof(regexpobject), /*tp_size*/
+X 0, /*tp_itemsize*/
+X /* methods */
+X regexp_dealloc, /*tp_dealloc*/
+X 0, /*tp_print*/
+X regexp_getattr, /*tp_getattr*/
+X 0, /*tp_setattr*/
+X 0, /*tp_compare*/
+X 0, /*tp_repr*/
+X};
+X
+Xvoid
+Xregerror(str)
+X char *str;
+X{
+X err_setstr(RegexpError, str);
+X}
+X
+Xstatic object *
+Xregexp_compile(self, args)
+X object *self;
+X object *args;
+X{
+X object *string;
+X regexp *prog;
+X if (!getstrarg(args, &string))
+X return NULL;
+X prog = regcomp(getstringvalue(string));
+X if (prog == NULL)
+X return NULL; /* regerror() has called err_seterr() */
+X return (object *)newregexpobject(string, prog);
+X}
+X
+Xstatic struct methodlist regexp_global_methods[] = {
+X {"compile", regexp_compile},
+X {NULL, NULL} /* sentinel */
+X};
+X
+Xinitregexp()
+X{
+X object *m, *d;
+X
+X m = initmodule("regexp", regexp_global_methods);
+X d = getmoduledict(m);
+X
+X /* Initialize regexp.error exception */
+X RegexpError = newstringobject("regexp.error");
+X if (RegexpError == NULL || dictinsert(d, "error", RegexpError) != 0)
+X fatal("can't define regexp.error");
+X}
+EOF
+fi
+echo 'Part 09 out of 21 of pack.out complete.'
+exit 0
-- 
cgit v1.2.3