Python 0.9.1 part 09/21
Guido van Rossum
guido at cwi.nl
Wed Feb 20 04:41:53 AEST 1991
: 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
More information about the Alt.sources
mailing list