Python 0.9.1 as posted in alt.sources

125 files changed, 29287 insertions, 0 deletions

diff --git a/src/Grammar b/src/Grammar
new file mode 100644
index 0000000..574acd6
--- /dev/null
+++ b/src/Grammar
@@ -0,0 +1,72 @@
+# Grammar for Python, version 4
+
+# Changes compared to version 3:
+# Removed 'dir' statement.
+# Function call argument is a testlist instead of exprlist.
+
+# Changes compared to version 2:
+# The syntax of Boolean operations is changed to use more
+# conventional priorities: or < and < not.
+
+# Changes compared to version 1:
+# modules and scripts are unified;
+# 'quit' is gone (use ^D);
+# empty_stmt is gone, replaced by explicit NEWLINE where appropriate;
+# 'import' and 'def' aren't special any more;
+# added 'from' NAME option on import clause, and '*' to import all;
+# added class definition.
+
+# Start symbols for the grammar:
+# single_input is a single interactive statement;
+# file_input is a module or sequence of commands read from an input file;
+# expr_input is the input for the input() function;
+# eval_input is the input for the eval() function.
+
+# NB: compound_stmt in single_input is followed by extra NEWLINE!
+single_input: NEWLINE | simple_stmt | compound_stmt NEWLINE
+file_input: (NEWLINE | stmt)* ENDMARKER
+expr_input: testlist NEWLINE
+eval_input: testlist ENDMARKER
+
+funcdef: 'def' NAME parameters ':' suite
+parameters: '(' [fplist] ')'
+fplist: fpdef (',' fpdef)*
+fpdef: NAME | '(' fplist ')'
+
+stmt: simple_stmt | compound_stmt
+simple_stmt: expr_stmt | print_stmt | pass_stmt | del_stmt | flow_stmt | import_stmt
+expr_stmt: (exprlist '=')* exprlist NEWLINE
+# For assignments, additional restrictions enforced by the interpreter
+print_stmt: 'print' (test ',')* [test] NEWLINE
+del_stmt: 'del' exprlist NEWLINE
+pass_stmt: 'pass' NEWLINE
+flow_stmt: break_stmt | return_stmt | raise_stmt
+break_stmt: 'break' NEWLINE
+return_stmt: 'return' [testlist] NEWLINE
+raise_stmt: 'raise' expr [',' expr] NEWLINE
+import_stmt: 'import' NAME (',' NAME)* NEWLINE | 'from' NAME 'import' ('*' | NAME (',' NAME)*) NEWLINE
+compound_stmt: if_stmt | while_stmt | for_stmt | try_stmt | funcdef | classdef
+if_stmt: 'if' test ':' suite ('elif' test ':' suite)* ['else' ':' suite]
+while_stmt: 'while' test ':' suite ['else' ':' suite]
+for_stmt: 'for' exprlist 'in' exprlist ':' suite ['else' ':' suite]
+try_stmt: 'try' ':' suite (except_clause ':' suite)* ['finally' ':' suite]
+except_clause: 'except' [expr [',' expr]]
+suite: simple_stmt | NEWLINE INDENT NEWLINE* (stmt NEWLINE*)+ DEDENT
+
+test: and_test ('or' and_test)*
+and_test: not_test ('and' not_test)*
+not_test: 'not' not_test | comparison
+comparison: expr (comp_op expr)*
+comp_op: '<'|'>'|'='|'>' '='|'<' '='|'<' '>'|'in'|'not' 'in'|'is'|'is' 'not'
+expr: term (('+'|'-') term)*
+term: factor (('*'|'/'|'%') factor)*
+factor: ('+'|'-') factor | atom trailer*
+atom: '(' [testlist] ')' | '[' [testlist] ']' | '{' '}' | '`' testlist '`' | NAME | NUMBER | STRING
+trailer: '(' [testlist] ')' | '[' subscript ']' | '.' NAME
+subscript: expr | [expr] ':' [expr]
+exprlist: expr (',' expr)* [',']
+testlist: test (',' test)* [',']
+
+classdef: 'class' NAME parameters ['=' baselist] ':' suite
+baselist: atom arguments (',' atom arguments)*
+arguments: '(' [testlist] ')'
diff --git a/src/Makefile b/src/Makefile
new file mode 100644
index 0000000..d47eceb
--- /dev/null
+++ b/src/Makefile
@@ -0,0 +1,508 @@
+# /***********************************************************
+# Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+# Netherlands.
+#
+# All Rights Reserved
+#
+# Permission to use, copy, modify, and distribute this software and its
+# documentation for any purpose and without fee is hereby granted,
+# provided that the above copyright notice appear in all copies and that
+# both that copyright notice and this permission notice appear in
+# supporting documentation, and that the names of Stichting Mathematisch
+# Centrum or CWI not be used in advertising or publicity pertaining to
+# distribution of the software without specific, written prior permission.
+#
+# STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+# THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+# FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+# FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+# OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+#
+# ******************************************************************/
+
+# Makefile for Python
+# ===================
+#
+# If you are in a hurry, you can just edit this Makefile to choose the
+# correct settings for SYSV and RANLIB below, and type "make" in this
+# directory. If you are using a recent version of SunOS (or Ultrix?)
+# you don't even have to edit: the Makefile comes pre-configured for
+# such systems with all configurable options turned off, building the
+# minimal portable version of the Python interpreter.
+#
+# If have more time, read the section on configurable options below.
+# It may still be wise to begin building the minimal portable Python,
+# to see if it works at all, and select options later. You don't have
+# to rebuild all objects when you turn on options; all dependencies
+# are concentrated in the file "config.c" which is rebuilt whenever
+# the Makefile changes. (Except if you turn on the GNU Readline option
+# you may have to toss out the tokenizer.o object.)
+
+
+# Operating System Defines (ALWAYS READ THIS)
+# ===========================================
+
+# Uncomment the following line if you are using a System V derivative.
+# This must be used, for instance, on an SGI IRIS. Don't use it for
+# SunOS. (This is only needed by posixmodule.c...)
+
+#SYSVDEF= -DSYSV
+
+# Choose one of the following two lines depending on whether your system
+# requires the use of 'ranlib' after creating a library, or not.
+
+#RANLIB = true # For System V
+RANLIB = ranlib # For BSD
+
+# If your system doesn't have symbolic links, uncomment the following
+# line.
+
+#NOSYMLINKDEF= -DNO_LSTAT
+
+
+# Installation Options
+# ====================
+
+# You may want to change DEFPYTHONPATH to reflect where you install the
+# Python module library. The default contains "../lib" so running
+# the interpreter from the source/build directory as distributed will
+# find the library (admittedly a hack).
+
+DEFPYTHONPATH= .:/usr/local/lib/python:/ufs/guido/lib/python:../lib
+
+
+# For "Pure" BSD Systems
+# ======================
+#
+# "Pure" BSD systems (as opposed to enhanced BSD derivatives like SunOS)
+# often miss certain standard library functions. Source for
+# these is provided, you just have to turn it on. This may work for
+# other systems as well, where these things are needed.
+
+# If your system does not have a strerror() function in the library,
+# uncomment the following two lines to use one I wrote. (Actually, this
+# is missing in most systems I have encountered, so it is turned on
+# in the Makefile. Turn it off if your system doesn't have sys_errlist.)
+
+STRERROR_SRC= strerror.c
+STRERROR_OBJ= strerror.o
+
+# If your BSD system does not have a fmod() function in the library,
+# uncomment the following two lines to use one I wrote.
+
+#FMOD_SRC= fmod.c
+#FMOD_OBJ= fmod.o
+
+# If your BSD system does not have a strtol() function in the library,
+# uncomment the following two lines to use one I wrote.
+
+#STRTOL_SRC= strtol.c
+#STRTOL_OBJ= strtol.o
+
+# If your BSD system does not have a getcwd() function in the library,
+# but it does have a getwd() function, uncomment the following two lines
+# to use one I wrote. (If you don't have getwd() either, turn on the
+# NO_GETWD #define in getcwd.c.)
+
+#GETCWD_SRC= getcwd.c
+#GETCWD_OBJ= getcwd.o
+
+# If your signal() function believes signal handlers return int,
+# uncomment the following line.
+
+#SIGTYPEDEF= -DSIGTYPE=int
+
+
+# Further porting hints
+# =====================
+#
+# If you don't have the header file <string.h>, but you do have
+# <strings.h>, create a file "string.h" in this directory which contains
+# the single line "#include <strings.h>", and add "-I." to CFLAGS.
+# If you don't have the functions strchr and strrchr, add definitions
+# "-Dstrchr=index -Dstrrchr=rindex" to CFLAGS. (NB: CFLAGS is not
+# defined in this Makefile.)
+
+
+# Configurable Options
+# ====================
+#
+# Python can be configured to interface to various system libraries that
+# are not available on all systems. It is also possible to configure
+# the input module to use the GNU Readline library for interactive
+# input. For each configuration choice you must uncomment the relevant
+# section of the Makefile below. Note: you may also have to change a
+# pathname and/or an architecture identifier that is hardcoded in the
+# Makefile.
+#
+# Read the comments to determine if you can use the option. (You can
+# always leave all options off and build a minimal portable version of
+# Python.)
+
+
+# BSD Time Option
+# ===============
+#
+# This option does not add a new module but adds two functions to
+# an existing module.
+#
+# It implements time.millisleep() and time.millitimer()
+# using the BSD system calls select() and gettimeofday().
+#
+# Uncomment the following line to select this option.
+
+#BSDTIMEDEF= -DBSD_TIME
+
+
+# GNU Readline Option
+# ===================
+#
+# If you have the sources of the GNU Readline library you can have
+# full interactive command line editing and history in Python.
+# The GNU Readline library is distributed with the BASH shell
+# (I only know of version 1.05). You must build the GNU Readline
+# library and the alloca routine it needs in their own source
+# directories (which are subdirectories of the basg source directory),
+# and plant a pointer to the BASH source directory in this Makefile.
+#
+# Uncomment and edit the following block to use the GNU Readline option.
+# - Edit the definition of BASHDIR to point to the bash source tree.
+# You may have to fix the definition of LIBTERMCAP; leave the LIBALLOCA
+# definition commented if alloca() is in your C library.
+
+#BASHDIR= ../../bash-1.05
+#LIBREADLINE= $(BASHDIR)/readline/libreadline.a
+#LIBALLOCA= $(BASHDIR)/alloc-files/alloca.o
+#LIBTERMCAP= -ltermcap
+#RL_USE = -DUSE_READLINE
+#RL_LIBS= $(LIBREADLINE) $(LIBALLOCA) $(LIBTERMCAP)
+#RL_LIBDEPS= $(LIBREADLINE) $(LIBALLOCA)
+
+
+# STDWIN Option
+# =============
+#
+# If you have the sources of STDWIN (by the same author) you can
+# configure Python to incorporate the built-in module 'stdwin'.
+# This requires a fairly recent version of STDWIN (dated late 1990).
+#
+# Uncomment and edit the following block to use the STDWIN option.
+# - Edit the STDWINDIR defition to reflect the top of the STDWIN source
+# tree.
+# - Edit the ARCH definition to reflect your system's architecture
+# (usually the program 'arch' or 'machine' returns this).
+# You may have to edit the LIBX11 defition to reflect the location of
+# the X11 runtime library if it is non-standard.
+
+#STDWINDIR= ../../stdwin
+#ARCH= sgi
+#LIBSTDWIN= $(STDWINDIR)/Build/$(ARCH)/x11/lib/lib.a
+#LIBX11 = -lX11
+#STDW_INCL= -I$(STDWINDIR)/H
+#STDW_USE= -DUSE_STDWIN
+#STDW_LIBS= $(LIBSTDWIN) $(LIBX11)
+#STDW_LIBDEPS= $(LIBSTDWIN)
+#STDW_SRC= stdwinmodule.c
+#STDW_OBJ= stdwinmodule.o
+
+
+# Amoeba Option
+# =============
+#
+# If you have the Amoeba 4.0 distribution (Beta or otherwise) you can
+# configure Python to incorporate the built-in module 'amoeba'.
+# (Python can also be built for native Amoeba, but it requires more
+# work and thought. Contact the author.)
+#
+# Uncomment and edit the following block to use the Amoeba option.
+# - Edit the AMOEBADIR defition to reflect the top of the Amoeba source
+# tree.
+# - Edit the AM_CONF definition to reflect the machine/operating system
+# configuration needed by Amoeba (this is the name of a subdirectory
+# of $(AMOEBADIR)/conf/unix, e.g., vax.ultrix).
+
+#AMOEBADIR= /usr/amoeba
+#AM_CONF= mipseb.irix
+#LIBAMUNIX= $(AMOEBADIR)/conf/unix/$(AM_CONF)/lib/amunix/libamunix.a
+#AM_INCL= -I$(AMOEBADIR)/src/h
+#AM_USE = -DUSE_AMOEBA
+#AM_LIBDEPS= $(LIBAMUNIX)
+#AM_LIBS= $(LIBAMUNIX)
+#AM_SRC = amoebamodule.c sc_interpr.c sc_errors.c
+#AM_OBJ = amoebamodule.o sc_interpr.o sc_errors.o
+
+
+# Silicon Graphics IRIS Options
+# =============================
+#
+# The following three options are only relevant if you are using a
+# Silicon Graphics IRIS machine. These have been tested with IRIX 3.3.1
+# on a 4D/25.
+
+
+# GL Option
+# =========
+#
+# This option incorporates the built-in module 'gl', which provides a
+# complete interface to the Silicon Graphics GL library. It adds
+# about 70K to the Python text size and about 260K to the unstripped
+# binary size.
+#
+# NOTE WHEN BUILDING FOR THE FIRST TIME:
+# There is a circular dependency in the build process: you need to have
+# a working Python interpreter before you can build a Python interpreter
+# that incorporates the 'gl' module -- the source file 'glmodule.c' is
+# not distributed (it's about 140K!) and a Python script is used to
+# create it. Thus, you first have to build python without the the GL
+# and Panel options, then edit the Makefile to turn them (or at least GL)
+# on and rebuild. You may also have to set PYTHONPATH to point to
+# the place where the module library is for the generation script to
+# work.
+#
+# Uncomment the following block to use the GL option.
+
+#GL_USE = -DUSE_GL
+#GL_LIBDEPS=
+#GL_LIBS= -lgl_s
+#GL_SRC = glmodule.c cgensupport.c
+#GL_OBJ = glmodule.o cgensupport.o
+
+
+# Panel Option
+# ============
+#
+# If you have source to the NASA Ames Panel Library, you can configure
+# Python to incorporate the built-in module 'pnl', which is used byu
+# the standard module 'panel' to provide an interface to most features
+# of the Panel Library. This option requires that you also turn on the
+# GL option. It adds about 100K to the Python text size and about 160K
+# to the unstripped binary size. This requires Panel Library version 9.7
+# (for lower versions you may have to remove some functionality -- send
+# me the patches if you bothered to do this).
+#
+# Uncomment and edit the following block to use the Panel option.
+# - Edit the PANELDIR definition to point to the top-level directory
+# of the Panel distribution tree.
+
+#PANELDIR= /usr/people/guido/src/pl
+#PANELLIBDIR= $(PANELDIR)/library
+#LIBPANEL= $(PANELLIBDIR)/lib/libpanel.a
+#PANEL_USE= -DUSE_PANEL
+#PANEL_INCL= -I$(PANELLIBDIR)/include
+#PANEL_LIBDEPS= $(LIBPANEL)
+#PANEL_LIBS= $(LIBPANEL)
+#PANEL_SRC= panelmodule.c
+#PANEL_OBJ= panelmodule.o
+
+
+# Audio Option
+# ============
+#
+# This option lets you play with /dev/audio on the IRIS 4D/25.
+# It incorporates the built-in module 'audio'.
+# Warning: using the asynchronous I/O facilities of this module can
+# create a second 'thread', which looks in the listings of 'ps' like a
+# forked child. However, it shares its address space with the parent.
+#
+# Uncomment the following block to use the Audio option.
+
+#AUDIO_USE= -DUSE_AUDIO
+#AUDIO_SRC= audiomodule.c asa.c
+#AUDIO_OBJ= audiomodule.o asa.o
+
+
+# Major Definitions
+# =================
+
+STANDARD_OBJ= acceler.o bltinmodule.o ceval.o classobject.o \
+ compile.o dictobject.o errors.o fgetsintr.o \
+ fileobject.o floatobject.o $(FMOD_OBJ) frameobject.o \
+ funcobject.o $(GETCWD_OBJ) \
+ graminit.o grammar1.o import.o \
+ intobject.o intrcheck.o listnode.o listobject.o \
+ mathmodule.o methodobject.o modsupport.o \
+ moduleobject.o node.o object.o parser.o \
+ parsetok.o posixmodule.o regexp.o regexpmodule.o \
+ strdup.o $(STRERROR_OBJ) \
+ stringobject.o $(STRTOL_OBJ) structmember.o \
+ sysmodule.o timemodule.o tokenizer.o traceback.o \
+ tupleobject.o typeobject.o
+
+STANDARD_SRC= acceler.c bltinmodule.c ceval.c classobject.c \
+ compile.c dictobject.c errors.c fgetsintr.c \
+ fileobject.c floatobject.c $(FMOD_SRC) frameobject.c \
+ funcobject.c $(GETCWD_SRC) \
+ graminit.c grammar1.c import.c \
+ intobject.c intrcheck.c listnode.c listobject.c \
+ mathmodule.c methodobject.c modsupport.c \
+ moduleobject.c node.c object.c parser.c \
+ parsetok.c posixmodule.c regexp.c regexpmodule.c \
+ strdup.c $(STRERROR_SRC) \
+ stringobject.c $(STRTOL_SRC) structmember.c \
+ sysmodule.c timemodule.c tokenizer.c traceback.c \
+ tupleobject.c typeobject.c
+
+CONFIGDEFS= $(STDW_USE) $(AM_USE) $(AUDIO_USE) $(GL_USE) $(PANEL_USE) \
+ '-DPYTHONPATH="$(DEFPYTHONPATH)"'
+
+CONFIGINCLS= $(STDW_INCL)
+
+LIBDEPS= libpython.a $(STDW_LIBDEPS) $(AM_LIBDEPS) \
+ $(GL_LIBDEPS) $(PANEL_LIBSDEP) $(RL_LIBDEPS)
+
+# NB: the ordering of items in LIBS is significant!
+LIBS= libpython.a $(STDW_LIBS) $(AM_LIBS) \
+ $(PANEL_LIBS) $(GL_LIBS) $(RL_LIBS) -lm
+
+LIBOBJECTS= $(STANDARD_OBJ) $(STDW_OBJ) $(AM_OBJ) $(AUDIO_OBJ) \
+ $(GL_OBJ) $(PANEL_OBJ)
+
+LIBSOURCES= $(STANDARD_SRC) $(STDW_SRC) $(AM_SRC) $(AUDIO_SRC) \
+ $(GL_SRC) $(PANEL_SRC)
+
+OBJECTS= pythonmain.o config.o
+
+SOURCES= $(LIBSOURCES) pythonmain.c config.c
+
+GENOBJECTS= acceler.o fgetsintr.o grammar1.o \
+ intrcheck.o listnode.o node.o parser.o \
+ parsetok.o strdup.o tokenizer.o bitset.o \
+ firstsets.o grammar.o metagrammar.o pgen.o \
+ pgenmain.o printgrammar.o
+
+GENSOURCES= acceler.c fgetsintr.c grammar1.c \
+ intrcheck.c listnode.c node.c parser.c \
+ parsetok.c strdup.c tokenizer.c bitset.c \
+ firstsets.c grammar.c metagrammar.c pgen.c \
+ pgenmain.c printgrammar.c
+
+
+# Main Targets
+# ============
+
+python: libpython.a $(OBJECTS) $(LIBDEPS) Makefile
+ $(CC) $(CFLAGS) $(OBJECTS) $(LIBS) -o @python
+ mv @python python
+
+libpython.a: $(LIBOBJECTS)
+ -rm -f @lib
+ ar cr @lib $(LIBOBJECTS)
+ $(RANLIB) @lib
+ mv @lib libpython.a
+
+python_gen: $(GENOBJECTS) $(RL_LIBDEPS)
+ $(CC) $(CFLAGS) $(GENOBJECTS) $(RL_LIBS) -o python_gen
+
+
+# Utility Targets
+# ===============
+
+# Don't take the output from lint too seriously. I have not attempted
+# to make Python lint-free. But I use function prototypes.
+
+LINTFLAGS= -h
+
+LINTCPPFLAGS= $(CONFIGDEFS) $(CONFIGINCLS) $(SYSVDEF) \
+ $(AM_INCL) $(PANEL_INCL)
+
+LINT= lint
+
+lint:: $(SOURCES)
+ $(LINT) $(LINTFLAGS) $(LINTCPPFLAGS) $(SOURCES)
+
+lint:: $(GENSOURCES)
+ $(LINT) $(LINTFLAGS) $(GENSOURCES)
+
+# Generating dependencies is only necessary if you intend to hack Python.
+# You may change $(MKDEP) to your favorite dependency generator (it should
+# edit the Makefile in place).
+
+MKDEP= mkdep
+
+depend::
+ $(MKDEP) $(LINTCPPFLAGS) $(SOURCES) $(GENSOURCES)
+
+# You may change $(CTAGS) to suit your taste...
+
+CTAGS= ctags -t -w
+
+HEADERS= *.h
+
+tags: $(SOURCES) $(GENSOURCES) $(HEADERS)
+ $(CTAGS) $(SOURCES) $(GENSOURCES) $(HEADERS)
+
+clean::
+ -rm -f *.o core [,#@]*
+
+clobber:: clean
+ -rm -f python python_gen libpython.a tags
+
+
+# Build Special Objects
+# =====================
+
+# You may change $(COMPILE) to reflect the default .c.o rule...
+
+COMPILE= $(CC) -c $(CFLAGS)
+
+amoebamodule.o: amoebamodule.c
+ $(COMPILE) $(AM_INCL) $*.c
+
+config.o: config.c Makefile
+ $(COMPILE) $(CONFIGDEFS) $(CONFIGINCLS) $*.c
+
+fgetsintr.o: fgetsintr.c
+ $(COMPILE) $(SIGTYPEDEF) $*.c
+
+intrcheck.o: intrcheck.c
+ $(COMPILE) $(SIGTYPEDEF) $*.c
+
+panelmodule.o: panelmodule.c
+ $(COMPILE) $(PANEL_INCL) $*.c
+
+posixmodule.o: posixmodule.c
+ $(COMPILE) $(SYSVDEF) $(NOSYMLINKDEF) $*.c
+
+sc_interpr.o: sc_interpr.c
+ $(COMPILE) $(AM_INCL) $*.c
+
+sc_error.o: sc_error.c
+ $(COMPILE) $(AM_INCL) $*.c
+
+stdwinmodule.o: stdwinmodule.c
+ $(COMPILE) $(STDW_INCL) $*.c
+
+timemodule.o: timemodule.c
+ $(COMPILE) $(SIGTYPEDEF) $(BSDTIMEDEF) $*.c
+
+tokenizer.o: tokenizer.c
+ $(COMPILE) $(RL_USE) $*.c
+
+.PRECIOUS: python libpython.a glmodule.c graminit.c graminit.h
+
+
+# Generated Sources
+# =================
+#
+# Some source files are (or may be) generated.
+# The rules for doing so are given here.
+
+# Build "glmodule.c", the GL interface.
+# See important note at "GL Option" above.
+# You may have to set and export PYTHONPATH for this to work.
+# Ignore the messages emitted by the cgen script as long as its exit
+# status is zero.
+# Also ignore the warnings emitted while compiling glmodule.c; it works.
+
+glmodule.c: cstubs cgen
+ python cgen <cstubs >@glmodule.c
+ mv @glmodule.c glmodule.c
+
+# The dependencies for graminit.[ch] are not turned on in the
+# distributed Makefile because the files themselves are distributed.
+# Turn them on if you want to hack the grammar.
+
+#graminit.c graminit.h: Grammar python_gen
+# python_gen Grammar
diff --git a/src/PROTO.h b/src/PROTO.h
new file mode 100644
index 0000000..88b94fe
--- /dev/null
+++ b/src/PROTO.h
@@ -0,0 +1,79 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/*
+The macro PROTO(x) is used to put function prototypes in the source.
+This is defined differently for compilers that support prototypes than
+for compilers that don't. It should be used as follows:
+ int some_function PROTO((int arg1, char *arg2));
+A variant FPROTO(x) is used for cases where Standard C allows prototypes
+but Think C doesn't (mostly function pointers).
+
+This file also defines the macro HAVE_PROTOTYPES if and only if
+the PROTO() macro expands the prototype. It is also allowed to predefine
+HAVE_PROTOTYPES to force prototypes on.
+*/
+
+#ifndef PROTO
+
+#ifdef __STDC__
+#define HAVE_PROTOTYPES
+#endif
+
+#ifdef THINK_C
+#undef HAVE_PROTOTYPES
+#define HAVE_PROTOTYPES
+#endif
+
+#ifdef sgi
+#ifdef mips
+#define HAVE_PROTOTYPES
+#endif
+#endif
+
+#ifdef HAVE_PROTOTYPES
+#define PROTO(x) x
+#else
+#define PROTO(x) ()
+#endif
+
+#endif /* PROTO */
+
+
+/* FPROTO() is for cases where Think C doesn't like prototypes */
+
+#ifdef THINK_C
+#define FPROTO(arglist) ()
+#else /* !THINK_C */
+#define FPROTO(arglist) PROTO(arglist)
+#endif /* !THINK_C */
+
+#ifndef HAVE_PROTOTYPES
+#define const /*empty*/
+#else /* HAVE_PROTOTYPES */
+#ifdef THINK_C
+#undef const
+#define const /*empty*/
+#endif /* THINK_C */
+#endif /* HAVE_PROTOTYPES */
diff --git a/src/README b/src/README
new file mode 100644
index 0000000..714cd5b
--- /dev/null
+++ b/src/README
@@ -0,0 +1,11 @@
+This directory contains the source for the Python interpreter.
+
+To build the interpreter, edit the Makefile, follow the instructions
+there, and type "make python".
+
+To use the interpreter, you must set the environment variable PYTHONPATH
+to point to the directory containing the standard modules. These are
+distributed as a sister directory called 'lib' of this source directory.
+Try importing the module 'testall' to see if everything works.
+
+Good Luck!
diff --git a/src/To.do b/src/To.do
new file mode 100644
index 0000000..893e96d
--- /dev/null
+++ b/src/To.do
@@ -0,0 +1,11 @@
+- return better errors for file objects (also check read/write allowed, etc.)
+
+- introduce more specific exceptions (e.g., zero divide, index failure, ...)
+
+- why do reads from stdin fail when I suspend the process?
+
+- introduce macros to set/inspect errno for syscalls, to support things
+ like getoserr()
+
+- fix interrupt handling (interruptable system calls should call
+ intrcheck() to clear the interrupt status)
diff --git a/src/acceler.c b/src/acceler.c
new file mode 100644
index 0000000..5ed37d3
--- /dev/null
+++ b/src/acceler.c
@@ -0,0 +1,136 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Parser accelerator module */
+
+/* The parser as originally conceived had disappointing performance.
+ This module does some precomputation that speeds up the selection
+ of a DFA based upon a token, turning a search through an array
+ into a simple indexing operation. The parser now cannot work
+ without the accelerators installed. Note that the accelerators
+ are installed dynamically when the parser is initialized, they
+ are not part of the static data structure written on graminit.[ch]
+ by the parser generator. */
+
+#include "pgenheaders.h"
+#include "grammar.h"
+#include "token.h"
+#include "parser.h"
+
+/* Forward references */
+static void fixdfa PROTO((grammar *, dfa *));
+static void fixstate PROTO((grammar *, dfa *, state *));
+
+void
+addaccelerators(g)
+ grammar *g;
+{
+ dfa *d;
+ int i;
+#ifdef DEBUG
+ printf("Adding parser accellerators ...\n");
+#endif
+ d = g->g_dfa;
+ for (i = g->g_ndfas; --i >= 0; d++)
+ fixdfa(g, d);
+ g->g_accel = 1;
+#ifdef DEBUG
+ printf("Done.\n");
+#endif
+}
+
+static void
+fixdfa(g, d)
+ grammar *g;
+ dfa *d;
+{
+ state *s;
+ int j;
+ s = d->d_state;
+ for (j = 0; j < d->d_nstates; j++, s++)
+ fixstate(g, d, s);
+}
+
+static void
+fixstate(g, d, s)
+ grammar *g;
+ dfa *d;
+ state *s;
+{
+ arc *a;
+ int k;
+ int *accel;
+ int nl = g->g_ll.ll_nlabels;
+ s->s_accept = 0;
+ accel = NEW(int, nl);
+ for (k = 0; k < nl; k++)
+ accel[k] = -1;
+ a = s->s_arc;
+ for (k = s->s_narcs; --k >= 0; a++) {
+ int lbl = a->a_lbl;
+ label *l = &g->g_ll.ll_label[lbl];
+ int type = l->lb_type;
+ if (a->a_arrow >= (1 << 7)) {
+ printf("XXX too many states!\n");
+ continue;
+ }
+ if (ISNONTERMINAL(type)) {
+ dfa *d1 = finddfa(g, type);
+ int ibit;
+ if (type - NT_OFFSET >= (1 << 7)) {
+ printf("XXX too high nonterminal number!\n");
+ continue;
+ }
+ for (ibit = 0; ibit < g->g_ll.ll_nlabels; ibit++) {
+ if (testbit(d1->d_first, ibit)) {
+ if (accel[ibit] != -1)
+ printf("XXX ambiguity!\n");
+ accel[ibit] = a->a_arrow | (1 << 7) |
+ ((type - NT_OFFSET) << 8);
+ }
+ }
+ }
+ else if (lbl == EMPTY)
+ s->s_accept = 1;
+ else if (lbl >= 0 && lbl < nl)
+ accel[lbl] = a->a_arrow;
+ }
+ while (nl > 0 && accel[nl-1] == -1)
+ nl--;
+ for (k = 0; k < nl && accel[k] == -1;)
+ k++;
+ if (k < nl) {
+ int i;
+ s->s_accel = NEW(int, nl-k);
+ if (s->s_accel == NULL) {
+ fprintf(stderr, "no mem to add parser accelerators\n");
+ exit(1);
+ }
+ s->s_lower = k;
+ s->s_upper = nl;
+ for (i = 0; k < nl; i++, k++)
+ s->s_accel[i] = accel[k];
+ }
+ DEL(accel);
+}
diff --git a/src/allobjects.h b/src/allobjects.h
new file mode 100644
index 0000000..b6b487b
--- /dev/null
+++ b/src/allobjects.h
@@ -0,0 +1,50 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* "allobjects.c" -- Source for precompiled header "allobjects.h" */
+
+#include <stdio.h>
+#include <string.h>
+
+#include "PROTO.h"
+
+#include "object.h"
+#include "objimpl.h"
+
+#include "intobject.h"
+#include "floatobject.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+#include "listobject.h"
+#include "dictobject.h"
+#include "methodobject.h"
+#include "moduleobject.h"
+#include "funcobject.h"
+#include "classobject.h"
+#include "fileobject.h"
+
+#include "errors.h"
+#include "malloc.h"
+
+extern char *strdup PROTO((const char *));
diff --git a/src/amoebamodule.c b/src/amoebamodule.c
new file mode 100644
index 0000000..c9131b7
--- /dev/null
+++ b/src/amoebamodule.c
@@ -0,0 +1,774 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Amoeba module implementation */
+
+/* Amoeba includes */
+#include <amoeba.h>
+#include <cmdreg.h>
+#include <stdcom.h>
+#include <stderr.h>
+#include <caplist.h>
+#include <server/bullet/bullet.h>
+#include <server/tod/tod.h>
+#include <module/name.h>
+#include <module/direct.h>
+#include <module/mutex.h>
+#include <module/prv.h>
+#include <module/stdcmd.h>
+
+/* C includes */
+#include <stdlib.h>
+#include <ctype.h>
+
+/* POSIX includes */
+#include <fcntl.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+
+/* Python includes */
+#include "allobjects.h"
+#include "modsupport.h"
+#include "sc_global.h"
+#include "stubcode.h"
+
+extern char *err_why();
+extern char *ar_cap();
+
+#define STUBCODE "+stubcode"
+
+static object *AmoebaError;
+object *StubcodeError;
+
+static object *sc_dict;
+
+/* Module initialization */
+
+extern struct methodlist amoeba_methods[]; /* Forward */
+extern object *convertcapv(); /* Forward */
+
+static void
+ins(d, name, v)
+ object *d;
+ char *name;
+ object *v;
+{
+ if (v == NULL || dictinsert(d, name, v) != 0)
+ fatal("can't initialize amoeba module");
+}
+
+void
+initamoeba()
+{
+ object *m, *d, *v;
+
+ m = initmodule("amoeba", amoeba_methods);
+ d = getmoduledict(m);
+
+ /* Define capv */
+ v = convertcapv();
+ ins(d, "capv", v);
+ DECREF(v);
+
+ /* Set timeout */
+ timeout((interval)2000);
+
+ /* Initialize amoeba.error exception */
+ AmoebaError = newstringobject("amoeba.error");
+ ins(d, "error", AmoebaError);
+ StubcodeError = newstringobject("amoeba.stubcode_error");
+ ins(d, "stubcode_error", StubcodeError);
+ sc_dict = newdictobject();
+}
+
+
+/* Set an Amoeba-specific error, and return NULL */
+
+object *
+amoeba_error(err)
+ errstat err;
+{
+ object *v = newtupleobject(2);
+ if (v != NULL) {
+ settupleitem(v, 0, newintobject((long)err));
+ settupleitem(v, 1, newstringobject(err_why(err)));
+ }
+ err_setval(AmoebaError, v);
+ if (v != NULL)
+ DECREF(v);
+ return NULL;
+}
+
+
+/* Capability object implementation */
+
+extern typeobject Captype; /* Forward */
+
+#define is_capobject(v) ((v)->ob_type == &Captype)
+
+typedef struct {
+ OB_HEAD
+ capability ob_cap;
+} capobject;
+
+object *
+newcapobject(cap)
+ capability *cap;
+{
+ capobject *v = NEWOBJ(capobject, &Captype);
+ if (v == NULL)
+ return NULL;
+ v->ob_cap = *cap;
+ return (object *)v;
+}
+
+getcapability(v, cap)
+ object *v;
+ capability *cap;
+{
+
+ if (!is_capobject(v))
+ return err_badarg();
+ *cap = ((capobject *)v)->ob_cap;
+ return 0;
+}
+
+/*
+ * is_capobj exports the is_capobject macro to the stubcode modules
+ */
+
+int
+is_capobj(v)
+ object *v;
+{
+
+ return is_capobject(v);
+}
+
+/* Methods */
+
+static void
+capprint(v, fp, flags)
+ capobject *v;
+ FILE *fp;
+ int flags;
+{
+ /* XXX needs lock when multi-threading */
+ fputs(ar_cap(&v->ob_cap), fp);
+}
+
+static object *
+caprepr(v)
+ capobject *v;
+{
+ /* XXX needs lock when multi-threading */
+ return newstringobject(ar_cap(&v->ob_cap));
+}
+
+extern object *sc_interpreter();
+
+extern struct methodlist cap_methods[]; /* Forward */
+
+object *
+sc_makeself(cap, stubcode, name)
+ object *cap, *stubcode;
+ char *name;
+{
+ object *sc_name, *sc_self;
+
+ sc_name = newstringobject(name);
+ if (sc_name == NULL)
+ return NULL;
+ sc_self = newtupleobject(3);
+ if (sc_self == NULL) {
+ DECREF(sc_name);
+ return NULL;
+ }
+ if (settupleitem(sc_self, NAME, sc_name) != 0) {
+ DECREF(sc_self);
+ return NULL;
+ }
+ INCREF(cap);
+ if (settupleitem(sc_self, CAP, cap) != 0) {
+ DECREF(sc_self);
+ return NULL;
+ }
+ INCREF(stubcode);
+ if (settupleitem(sc_self, STUBC, stubcode) != 0) {
+ DECREF(sc_self);
+ return NULL;
+ }
+ return sc_self;
+}
+
+
+static void
+swapcode(code, len)
+ char *code;
+ int len;
+{
+ int i = sizeof(TscOperand);
+ TscOpcode opcode;
+ TscOperand operand;
+
+ while (i < len) {
+ memcpy(&opcode, &code[i], sizeof(TscOpcode));
+ SwapOpcode(opcode);
+ memcpy(&code[i], &opcode, sizeof(TscOpcode));
+ i += sizeof(TscOpcode);
+ if (opcode & OPERAND) {
+ memcpy(&operand, &code[i], sizeof(TscOperand));
+ SwapOperand(operand);
+ memcpy(&code[i], &operand, sizeof(TscOperand));
+ i += sizeof(TscOperand);
+ }
+ }
+}
+
+object *
+sc_findstubcode(v, name)
+ object *v;
+ char *name;
+{
+ int fd, fsize;
+ char *fname, *buffer;
+ struct stat statbuf;
+ object *sc_stubcode, *ret;
+ TscOperand sc_magic;
+
+ /*
+ * Only look in the current directory for now.
+ */
+ fname = malloc(strlen(name) + 4);
+ if (fname == NULL) {
+ return err_nomem();
+ }
+ sprintf(fname, "%s.sc", name);
+ if ((fd = open(fname, O_RDONLY)) == -1) {
+ extern int errno;
+
+ if (errno == 2) {
+ /*
+ ** errno == 2 is file not found.
+ */
+ err_setstr(NameError, fname);
+ return NULL;
+ }
+ free(fname);
+ return err_errno(newstringobject(name));
+ }
+ fstat(fd, &statbuf);
+ fsize = (int)statbuf.st_size;
+ buffer = malloc(fsize);
+ if (buffer == NULL) {
+ free(fname);
+ close(fd);
+ return err_nomem();
+ }
+ if (read(fd, buffer, fsize) != fsize) {
+ close(fd);
+ free(fname);
+ return err_errno(newstringobject(name));
+ }
+ close(fd);
+ free(fname);
+ memcpy(&sc_magic, buffer, sizeof(TscOperand));
+ if (sc_magic != SC_MAGIC) {
+ SwapOperand(sc_magic);
+ if (sc_magic != SC_MAGIC) {
+ free(buffer);
+ return NULL;
+ } else {
+ swapcode(buffer, fsize);
+ }
+ }
+ sc_stubcode = newsizedstringobject( &buffer[sizeof(TscOperand)],
+ fsize - sizeof(TscOperand));
+ free(buffer);
+ if (sc_stubcode == NULL) {
+ return NULL;
+ }
+ if (dictinsert(sc_dict, name, sc_stubcode) != 0) {
+ DECREF(sc_stubcode);
+ return NULL;
+ }
+ DECREF(sc_stubcode); /* XXXX */
+ sc_stubcode = sc_makeself(v, sc_stubcode, name);
+ if (sc_stubcode == NULL) {
+ return NULL;
+ }
+ return sc_stubcode;
+}
+
+object *
+capgetattr(v, name)
+ capobject *v;
+ char *name;
+{
+ object *sc_method, *sc_stubcodemethod;
+
+ if (sc_dict == NULL) {
+ /*
+ ** For some reason the dictionary has not been
+ ** initialized. Try to find one of the built in
+ ** methods.
+ */
+ return findmethod(cap_methods, (object *)v, name);
+ }
+ sc_stubcodemethod = dictlookup(sc_dict, name);
+ if (sc_stubcodemethod != NULL) {
+ /*
+ ** There is a stubcode method in the dictionary.
+ ** Execute the stubcode interpreter with the right
+ ** arguments.
+ */
+ object *self, *ret;
+
+ self = sc_makeself((object *)v, sc_stubcodemethod, name);
+ if (self == NULL) {
+ return NULL;
+ }
+ ret = findmethod(cap_methods, self, STUBCODE);
+ DECREF(self);
+ return ret;
+ }
+ err_clear();
+ sc_method = findmethod(cap_methods, (object *)v, name);
+ if (sc_method == NULL) {
+ /*
+ ** The method is not built in and not in the
+ ** dictionary. Try to find it as a stubcode file.
+ */
+ object *self, *ret;
+
+ err_clear();
+ self = sc_findstubcode((object *)v, name);
+ if (self == NULL) {
+ return NULL;
+ }
+ ret = findmethod(cap_methods, self, STUBCODE);
+ DECREF(self);
+ return ret;
+ }
+ return sc_method;
+}
+
+int
+capcompare(v, w)
+ capobject *v, *w;
+{
+ int cmp = bcmp((char *)&v->ob_cap.cap_port,
+ (char *)&w->ob_cap, PORTSIZE);
+ if (cmp != 0)
+ return cmp;
+ return prv_number(&v->ob_cap.cap_priv) -
+ prv_number(&w->ob_cap.cap_priv);
+}
+
+static typeobject Captype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "capability",
+ sizeof(capobject),
+ 0,
+ free, /*tp_dealloc*/
+ capprint, /*tp_print*/
+ capgetattr, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ capcompare, /*tp_comp
+are*/
+ caprepr, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
+
+
+/* Return a dictionary corresponding to capv */
+
+extern struct caplist *capv;
+
+static object *
+convertcapv()
+{
+ object *d;
+ struct caplist *c;
+ d = newdictobject();
+ if (d == NULL)
+ return NULL;
+ if (capv == NULL)
+ return d;
+ for (c = capv; c->cl_name != NULL; c++) {
+ object *v = newcapobject(c->cl_cap);
+ if (v == NULL || dictinsert(d, c->cl_name, v) != 0) {
+ DECREF(d);
+ return NULL;
+ }
+ DECREF(v);
+ }
+ return d;
+}
+
+
+/* Strongly Amoeba-specific argument handlers */
+
+static int
+getcaparg(v, a)
+ object *v;
+ capability *a;
+{
+ if (v == NULL || !is_capobject(v))
+ return err_badarg();
+ *a = ((capobject *)v) -> ob_cap;
+ return 1;
+}
+
+static int
+getstrcapargs(v, a, b)
+ object *v;
+ object **a;
+ capability *b;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2)
+ return err_badarg();
+ return getstrarg(gettupleitem(v, 0), a) &&
+ getcaparg(gettupleitem(v, 1), b);
+}
+
+
+/* Amoeba methods */
+
+static object *
+amoeba_name_lookup(self, args)
+ object *self;
+ object *args;
+{
+ object *name;
+ capability cap;
+ errstat err;
+ if (!getstrarg(args, &name))
+ return NULL;
+ err = name_lookup(getstringvalue(name), &cap);
+ if (err != STD_OK)
+ return amoeba_error(err);
+ return newcapobject(&cap);
+}
+
+static object *
+amoeba_name_append(self, args)
+ object *self;
+ object *args;
+{
+ object *name;
+ capability cap;
+ errstat err;
+ if (!getstrcapargs(args, &name, &cap))
+ return NULL;
+ err = name_append(getstringvalue(name), &cap);
+ if (err != STD_OK)
+ return amoeba_error(err);
+ INCREF(None);
+ return None;
+}
+
+static object *
+amoeba_name_replace(self, args)
+ object *self;
+ object *args;
+{
+ object *name;
+ capability cap;
+ errstat err;
+ if (!getstrcapargs(args, &name, &cap))
+ return NULL;
+ err = name_replace(getstringvalue(name), &cap);
+ if (err != STD_OK)
+ return amoeba_error(err);
+ INCREF(None);
+ return None;
+}
+
+static object *
+amoeba_name_delete(self, args)
+ object *self;
+ object *args;
+{
+ object *name;
+ errstat err;
+ if (!getstrarg(args, &name))
+ return NULL;
+ err = name_delete(getstringvalue(name));
+ if (err != STD_OK)
+ return amoeba_error(err);
+ INCREF(None);
+ return None;
+}
+
+static object *
+amoeba_timeout(self, args)
+ object *self;
+ object *args;
+{
+ int i;
+ object *v;
+ interval tout;
+ if (!getintarg(args, &i))
+ return NULL;
+ tout = timeout((interval)i);
+ v = newintobject((long)tout);
+ if (v == NULL)
+ timeout(tout);
+ return v;
+}
+
+static struct methodlist amoeba_methods[] = {
+ {"name_append", amoeba_name_append},
+ {"name_delete", amoeba_name_delete},
+ {"name_lookup", amoeba_name_lookup},
+ {"name_replace", amoeba_name_replace},
+ {"timeout", amoeba_timeout},
+ {NULL, NULL} /* Sentinel */
+};
+
+/* Capability methods */
+
+static object *
+cap_b_size(self, args)
+ capobject *self;
+ object *args;
+{
+ errstat err;
+ b_fsize size;
+ if (!getnoarg(args))
+ return NULL;
+ err = b_size(&self->ob_cap, &size);
+ if (err != STD_OK)
+ return amoeba_error(err);
+ return newintobject((long)size);
+}
+
+static object *
+cap_b_read(self, args)
+ capobject *self;
+ object *args;
+{
+ errstat err;
+ char *buf;
+ object *v;
+ long offset, size;
+ b_fsize nread;
+ if (!getlonglongargs(args, &offset, &size))
+ return NULL;
+ buf = malloc((unsigned int)size);
+ if (buf == NULL) {
+ return err_nomem();
+ }
+ err = b_read(&self->ob_cap, (b_fsize)offset, buf, (b_fsize)size,
+ &nread);
+ if (err != STD_OK) {
+ free(buf);
+ return amoeba_error(err);
+ }
+ v = newsizedstringobject(buf, (int)nread);
+ free(buf);
+ return v;
+}
+
+static object *
+cap_dir_lookup(self, args)
+ capobject *self;
+ object *args;
+{
+ object *name;
+ capability cap;
+ errstat err;
+ if (!getstrarg(args, &name))
+ return NULL;
+ err = dir_lookup(&self->ob_cap, getstringvalue(name), &cap);
+ if (err != STD_OK)
+ return amoeba_error(err);
+ return newcapobject(&cap);
+}
+
+static object *
+cap_dir_append(self, args)
+ capobject *self;
+ object *args;
+{
+ object *name;
+ capability cap;
+ errstat err;
+ if (!getstrcapargs(args, &name, &cap))
+ return NULL;
+ err = dir_append(&self->ob_cap, getstringvalue(name), &cap);
+ if (err != STD_OK)
+ return amoeba_error(err);
+ INCREF(None);
+ return None;
+}
+
+static object *
+cap_dir_delete(self, args)
+ capobject *self;
+ object *args;
+{
+ object *name;
+ errstat err;
+ if (!getstrarg(args, &name))
+ return NULL;
+ err = dir_delete(&self->ob_cap, getstringvalue(name));
+ if (err != STD_OK)
+ return amoeba_error(err);
+ INCREF(None);
+ return None;
+}
+
+static object *
+cap_dir_replace(self, args)
+ capobject *self;
+ object *args;
+{
+ object *name;
+ capability cap;
+ errstat err;
+ if (!getstrcapargs(args, &name, &cap))
+ return NULL;
+ err = dir_replace(&self->ob_cap, getstringvalue(name), &cap);
+ if (err != STD_OK)
+ return amoeba_error(err);
+ INCREF(None);
+ return None;
+}
+
+static object *
+cap_dir_list(self, args)
+ capobject *self;
+ object *args;
+{
+ errstat err;
+ struct dir_open *dd;
+ object *d;
+ char *name;
+ if (!getnoarg(args))
+ return NULL;
+ if ((dd = dir_open(&self->ob_cap)) == NULL)
+ return amoeba_error(STD_COMBAD);
+ if ((d = newlistobject(0)) == NULL) {
+ dir_close(dd);
+ return NULL;
+ }
+ while ((name = dir_next(dd)) != NULL) {
+ object *v;
+ v = newstringobject(name);
+ if (v == NULL) {
+ DECREF(d);
+ d = NULL;
+ break;
+ }
+ if (addlistitem(d, v) != 0) {
+ DECREF(v);
+ DECREF(d);
+ d = NULL;
+ break;
+ }
+ DECREF(v);
+ }
+ dir_close(dd);
+ return d;
+}
+
+object *
+cap_std_info(self, args)
+ capobject *self;
+ object *args;
+{
+ char buf[256];
+ errstat err;
+ int n;
+ if (!getnoarg(args))
+ return NULL;
+ err = std_info(&self->ob_cap, buf, sizeof buf, &n);
+ if (err != STD_OK)
+ return amoeba_error(err);
+ return newsizedstringobject(buf, n);
+}
+
+object *
+cap_tod_gettime(self, args)
+ capobject *self;
+ object *args;
+{
+ header h;
+ errstat err;
+ bufsize n;
+ long sec;
+ int msec, tz, dst;
+ if (!getnoarg(args))
+ return NULL;
+ h.h_port = self->ob_cap.cap_port;
+ h.h_priv = self->ob_cap.cap_priv;
+ h.h_command = TOD_GETTIME;
+ n = trans(&h, NILBUF, 0, &h, NILBUF, 0);
+ if (ERR_STATUS(n))
+ return amoeba_error(ERR_CONVERT(n));
+ tod_decode(&h, &sec, &msec, &tz, &dst);
+ return newintobject(sec);
+}
+
+object *
+cap_tod_settime(self, args)
+ capobject *self;
+ object *args;
+{
+ header h;
+ errstat err;
+ bufsize n;
+ long sec;
+ if (!getlongarg(args, &sec))
+ return NULL;
+ h.h_port = self->ob_cap.cap_port;
+ h.h_priv = self->ob_cap.cap_priv;
+ h.h_command = TOD_SETTIME;
+ tod_encode(&h, sec, 0, 0, 0);
+ n = trans(&h, NILBUF, 0, &h, NILBUF, 0);
+ if (ERR_STATUS(n))
+ return amoeba_error(ERR_CONVERT(n));
+ INCREF(None);
+ return None;
+}
+
+static struct methodlist cap_methods[] = {
+ { STUBCODE, sc_interpreter},
+ {"b_read", cap_b_read},
+ {"b_size", cap_b_size},
+ {"dir_append", cap_dir_append},
+ {"dir_delete", cap_dir_delete},
+ {"dir_list", cap_dir_list},
+ {"dir_lookup", cap_dir_lookup},
+ {"dir_replace", cap_dir_replace},
+ {"std_info", cap_std_info},
+ {"tod_gettime", cap_tod_gettime},
+ {"tod_settime", cap_tod_settime},
+ {NULL, NULL} /* Sentinel */
+};
diff --git a/src/asa.c b/src/asa.c
new file mode 100644
index 0000000..f7f7378
--- /dev/null
+++ b/src/asa.c
@@ -0,0 +1,494 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Asynchronous audio module for Silicon Graphics 4D/20 under IRIX 3.3
+ Copyright 1990 Stichting Mathematisch Centrum, Amsterdam
+ Author: Guido van Rossum, <[email protected]>
+ Last modified: [email protected], Oct 14, 1990
+
+ Callers should #include "asa.h".
+
+ This code is strongly IRIX 3.3 dependent. (Or are sproc() and
+ friends standard SYSV now?)
+
+ Caution: if you put printf's in the slave for debugging, use "-lmpc"
+ to get the semaphore version of stdio!
+
+
+ This file contains two library layers and a test program:
+
+
+ The lower layer implements a simple asynchronous execution facility,
+ built directly on the system calls sproc() and [un]blockproc().
+
+ A slave thread sits in an infinite loop waiting for work assigned to
+ it by the master thread. Work is represented by a function pointer
+ and an argument of type void*. The function returns a void* pointer
+ which is transferred back to the master when it submits the next bit
+ of work. Submitting a NULL function pointer can be used by the
+ master to wait for completion of the previous work. This lower
+ layer could be generally useful, but is currently implemented by
+ static functions, for exclusive by the asynchronous audio layer.
+
+
+ The higher layer implements an asynchronous interface to the
+ /dev/audio device on the Silicon Graphics 4D/20. It defines the
+ following functions:
+
+ int asa_init()
+ Required initialization function. The other functions will call
+ abort() when they are called before asa_init(). It creates the
+ slave process and returns a file descriptor for the audio
+ device which can be used to set the sampling rate and output
+ gain, etc. It prints a message to stderr and returns -1 if the
+ initialization failed. Calling this function more than onece is
+ harmless.
+
+ void asa_start_read(char *buf, int len)
+ Starts an asynchronous read call on the audio device. This
+ waits for completion of the previous request, if any.
+
+ void asa_start_write(char *buf, int len)
+ Starts an asynchronous write call on the audio device. This
+ waits for completion of the previous request, if any.
+
+ int asa_poll()
+ Polls whether the last asynchronous read or write request is
+ finished. Returns -1 if no request was queued, 0 if the request
+ is not yet finished, and 1 if it is finished.
+
+ int asa_wait()
+ Waits for completion if the last asynchronous read or write
+ request. It returns the result of the read or write request,
+ and sets the error code to the error code set by the request if
+ the result is -1. If no request was queued, this also returns
+ -1 but leaves the error code unchanged. Note: to get the error
+ code, don't inspect the global variable errno but call the
+ function oserror().
+
+ int asa_cancel()
+ Cancels the last asynchronous read or write request (by sending
+ the slave thread a signal for which it has a handler) then
+ returns its result and error code as asa_wait().
+
+ void asa_done()
+ Kills the slave process and closes the audio device. After
+ this, if further use of the module is required, asa_init()
+ should be called again. Calling this function when asa_init()
+ has not been called is harmless.
+
+
+ Finally, this file contains a simple test program that is compiled if
+ MAIN is defined (e.g., compile with cc -DMAIN). It makes a recording
+ and plays it back. The user must indicate begin and end of recording
+ and play-back by pressing the Return key.
+*/
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <signal.h>
+#include <sys/types.h>
+#include <sys/prctl.h>
+
+#include "asa.h"
+
+
+/* Asynchronous execution facility (lower layer) */
+
+
+/* Signal used to cancel requests in progress */
+#define MYSIG SIGUSR1
+
+/* Respective process IDs */
+static pid_t master_pid = -1;
+static pid_t slave_pid = -1;
+
+/* Work and result "queue" (1 element) */
+static void * (*work_func)();
+static void *work_arg;
+static void *work_result;
+
+/* Signal handler for MYSIG -- interrupts read or write system call */
+
+/*ARGSUSED*/
+static void
+handler(sig)
+ int sig;
+{
+ /* Reinstate the handler (non-BSD signal semantics) */
+ signal(sig, handler);
+}
+
+/* Subroutine to fiddle signals */
+
+static void
+dosig(sig)
+ int sig;
+{
+ if (signal(sig, SIG_IGN) != SIG_IGN)
+ signal(sig, SIG_DFL);
+}
+
+/* Slave control flow */
+
+/*ARGSUSED*/
+static void
+slave(arg)
+ void *arg;
+{
+ void * (*func)();
+ void *arg;
+ void *result;
+
+ /* Reset signal handlers that interactive programs often catch.
+ The assumption is that if the master has a handler for these
+ signals, it will be a cleanup function. The slave must die
+ from these. */
+ dosig(SIGHUP);
+ dosig(SIGQUIT);
+ dosig(SIGTERM);
+ dosig(SIGPIPE);
+
+ /* Ignore SIGINT if caught or ignored */
+ if (signal(SIGINT, SIG_IGN) == SIG_DFL)
+ signal(SIGINT, SIG_DFL);
+
+ /* Let the handler install itself */
+ handler(MYSIG);
+
+ /* Set slave_pid. This is also done in the master thread, but
+ there is a race condition whereby the slave begins execution
+ before the master has assigned the result of sproc() to
+ slave_pid. So we set it here as well -- since this sets the
+ same value it should be OK. */
+ slave_pid = getpid();
+
+ /* Set the dummy result returned by the first rendezvous */
+ result = NULL;
+
+ /* Loop forever, waiting for and executing work */
+ for (;;) {
+ /* First rendezvous: store previous result */
+ if (blockproc(slave_pid) < 0)
+ perror("slave: [result] blockproc(slave_pid)");
+ work_result = result;
+ if (unblockproc(master_pid) < 0)
+ perror("slave: [result] unblockproc(master_pid)");
+
+ /* Second rendezvous: fetch work */
+ if (blockproc(slave_pid) < 0)
+ perror("slave: [func,arg] blockproc(slave_pid)");
+ func = work_func;
+ arg = work_arg;
+ if (unblockproc(master_pid) < 0)
+ perror("slave: [func,arg] unblockproc(master_pid)");
+
+ /* Execute work, computing new result */
+ if (func == NULL) {
+ result = arg;
+ }
+ else {
+ result = (*func)(arg);
+ }
+ }
+}
+
+static int
+slave_init()
+{
+ if (slave_pid > 0)
+ return slave_pid;
+ master_pid = getpid();
+
+ /* Reset the queue, in case this is a re-init after asa_done() */
+ work_result = NULL;
+ work_func = NULL;
+ work_arg = NULL;
+
+ /* Create the slave process, sharing all segments and properties */
+ slave_pid = sproc(slave, PR_SALL, (char *)NULL);
+ if (slave_pid < 0)
+ perror("slave_init: sproc(slave, PR_SALL, NULL)");
+
+ /* Set up initial conditions---tricky!
+ Both the master and the slave start with one credit, since
+ both the result slot and the work/func slots are initially
+ free.
+ Note that we use setblockproccnt() for the master so a
+ possible indeterminate semaphore value caused by a previous
+ asa_done() at an unfortunate moment doesn't harm us.
+ */
+ setblockproccnt(master_pid, 1);
+ unblockproc(slave_pid);
+
+ return slave_pid;
+}
+
+static void
+slave_done()
+{
+ if (slave_pid > 0) {
+ if (kill(slave_pid, SIGKILL) < 0)
+ perror("slave_done: kill(slave_pid, SIGKILL)");
+ }
+ slave_pid = -1;
+}
+
+/* Queue new work and return result of previous work */
+
+static void *
+rendezvous(func, arg)
+ void * (*func)();
+ void *arg;
+{
+ void *result;
+
+ if (slave_pid <= 0)
+ abort(); /* Illegal call: not initialized properly */
+
+ /* First rendezvous: store new work */
+ if (blockproc(master_pid) < 0)
+ perror("rendezvous: [func,arg] blockproc(master_pid)");
+ work_func = func;
+ work_arg = arg;
+ if (unblockproc(slave_pid) < 0)
+ perror("rendezvous: [func,arg] unblockproc(slave_pid)");
+
+ /* Second rendezvous: fetch previous result */
+ if (blockproc(master_pid) < 0)
+ perror("rendezvous: [result] blockproc(master_pid)");
+ result = work_result;
+ if (unblockproc(slave_pid) < 0)
+ perror("rendezvous: [result] unblockproc(slave_pid)");
+
+ return result;
+}
+
+
+/* Asynchronous audio interface (higher layer) */
+
+
+int audio_fd = -1; /* File descriptor -- not initialized yet */
+
+static struct queue {
+ int func; /* 0 = read, 1 = write */
+ char *buf;
+ int len;
+ int result;
+ int error;
+} queue[2];
+
+static int qindex = 0;
+
+int
+asa_init()
+{
+ int fd;
+ char *p;
+
+ if (audio_fd >= 0)
+ return audio_fd;
+ fd = open("/dev/audio", 2);
+ if (fd < 0) {
+ perror("asa_init: Can't open /dev/audio");
+ return -1;
+ }
+ if (slave_init() < 0) {
+ perror("asa_init: Can't create slave process");
+ close(fd);
+ return -1;
+ }
+ audio_fd = fd;
+ return fd;
+}
+
+void
+asa_done()
+{
+ slave_done();
+ if (audio_fd >= 0) {
+ if (close(audio_fd) < 0)
+ perror("asa_done: close(audio_fd)");
+ }
+ audio_fd = -1;
+}
+
+static void *
+runjob(arg)
+ void *arg;
+{
+ extern int errno;
+ struct queue *q = (struct queue *)arg;
+ char *buf = q->buf;
+ int len = q->len;
+ int n = 0;
+
+ if (q->func == 0)
+ n = read(audio_fd, buf, len);
+ else
+ n = write(audio_fd, buf, len);
+ if (q->func == 0 && n >= 0) {
+ while (--len >= n && buf[len] == '\0')
+ ;
+ n = len+1;
+ }
+ q->result = n;
+ q->error = oserror();
+ return arg;
+}
+
+static void
+startjob(func, buf, len)
+ int func;
+ char *buf;
+ int len;
+{
+ struct queue *q;
+
+ q = &queue[qindex];
+ qindex = (qindex+1) & 1;
+ q->func = func;
+ q->buf = buf;
+ q->len = len;
+ (void) rendezvous(runjob, (void *)q);
+}
+
+void
+asa_start_read(buf, len)
+ char *buf;
+ int len;
+{
+ memset(buf, '\0', len);
+ startjob(0, buf, len);
+}
+
+void
+asa_start_write(buf, len)
+ char *buf;
+ int len;
+{
+ startjob(1, buf, len);
+}
+
+int
+asa_wait()
+{
+ struct queue *q;
+
+ q = (struct queue *) rendezvous((void*(*)())NULL, (void *)NULL);
+ if (q == NULL) {
+ setoserror(0);
+ return -1; /* No work was queued */
+ }
+ setoserror(q->error);
+ return q->result;
+}
+
+int
+asa_poll()
+{
+ int err;
+
+ err = prctl(PR_ISBLOCKED, slave_pid);
+ if (err < 0) {
+ perror("prctl(PR_ISBLOCKED, slave_pid)");
+ return -1;
+ }
+ else if (err == 0)
+ return 0;
+ else if (work_result == NULL) {
+ setoserror(0);
+ return -1;
+ }
+ else
+ return 1;
+}
+
+int
+asa_cancel()
+{
+ int result;
+
+ kill(slave_pid, MYSIG);
+ result = asa_wait();
+ return result;
+}
+
+
+#ifdef MAIN
+
+/* Test program */
+
+#include <sys/audio.h>
+
+main()
+{
+ static char buf[10*16*1024]; /* 10 seconds of sound at 16K/sec */
+ int n;
+ int afd;
+
+ if ((afd = asa_init()) < 0)
+ exit(1);
+ ioctl(afd, AUDIOCSETRATE, 3);
+ ioctl(afd, AUDIOCSETOUTGAIN, 0);
+ printf("Poll returns %d\n", asa_poll());
+ go("Hit enter to start recording:\n");
+ asa_start_read(buf, sizeof buf);
+ go("Hit enter to stop recording:\n");
+ /*printf("Poll returns %d\n", asa_poll());*/
+ n = asa_cancel();
+ if (n < 0)
+ perror("Read failed");
+ else {
+ printf("Got %d bytes\n", n);
+ printf("Poll returns %d\n", asa_poll());
+ go("Hit enter to start playing:\n");
+ ioctl(afd, AUDIOCSETOUTGAIN, 50);
+ asa_start_write(buf, n);
+ go("Hit enter to stop playing:\n");
+ printf("Poll returns %d\n", asa_poll());
+ n = asa_cancel();
+ if (n < 0)
+ perror("Write failed");
+ else
+ printf("Stopped at %d bytes\n", n);
+ }
+ ioctl(afd, AUDIOCSETOUTGAIN, 0);
+ asa_done();
+ exit(n < 0 ? 1 : 0);
+}
+
+go(str)
+ char *str;
+{
+ char line[100];
+
+ sleep(1);
+ fputs(str, stdout);
+ fflush(stdout);
+ fgets(line, sizeof line, stdin);
+}
+
+#endif /* MAIN */
diff --git a/src/asa.h b/src/asa.h
new file mode 100644
index 0000000..d9a7d10
--- /dev/null
+++ b/src/asa.h
@@ -0,0 +1,33 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Interface for asynchronous audio module */
+
+extern int asa_init(void);
+extern void asa_done(void);
+extern void asa_start_write(char *, int);
+extern void asa_start_read(char *, int);
+extern int asa_poll(void);
+extern int asa_wait(void);
+extern int asa_cancel(void);
diff --git a/src/assert.h b/src/assert.h
new file mode 100644
index 0000000..f21225e
--- /dev/null
+++ b/src/assert.h
@@ -0,0 +1,25 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+#define assert(e) { if (!(e)) { printf("Assertion failed\n"); abort(); } }
diff --git a/src/audiomodule.c b/src/audiomodule.c
new file mode 100644
index 0000000..cca0102
--- /dev/null
+++ b/src/audiomodule.c
@@ -0,0 +1,615 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Silicon Graphics audio module implementation */
+/* For SGI Personal IRIS 4D/20 under IRIX 3.3; <sys/audio.h> mentions "IP6" */
+/* Note: The set-in-gain ioctl exists but is non-functional */
+
+#include <errno.h>
+#include <sys/audio.h>
+#include "asa.h"
+
+#include "allobjects.h"
+#include "modsupport.h"
+
+static int audio_fd = -1;
+
+static int
+init()
+{
+ if (audio_fd >= 0)
+ return 1;
+ if ((audio_fd = asa_init()) >= 0)
+ return 1;
+ err_setstr(RuntimeError, "can't initialize async audio");
+ return 0;
+}
+
+
+/* POSIX methods */
+
+static object *
+audio_get_ioctl(self, args, code)
+ object *self;
+ object *args;
+ long code;
+{
+ long x;
+ if (!getnoarg(args))
+ return NULL;
+ if (!init())
+ return NULL;
+ if ((x = ioctl(audio_fd, code, (char *) NULL)) < 0) {
+ return NULL;
+ }
+ return newintobject(x);
+}
+
+static object *
+audio_set_ioctl(self, args, code)
+ object *self;
+ object *args;
+ long code;
+{
+ long x;
+ if (!getlongarg(args, &x))
+ return NULL;
+ if (!init())
+ return NULL;
+ if (ioctl(audio_fd, code, (char *) x) != 0)
+ return NULL;
+ INCREF(None);
+ return None;
+}
+
+static object *
+audio_getingain(self, args)
+ object *self;
+ object *args;
+{
+ return audio_get_ioctl(self, args, AUDIOCGETINGAIN);
+}
+
+static object *
+audio_getoutgain(self, args)
+ object *self;
+ object *args;
+{
+ return audio_get_ioctl(self, args, AUDIOCGETOUTGAIN);
+}
+
+static object *
+audio_setingain(self, args)
+ object *self;
+ object *args;
+{
+ return audio_set_ioctl(self, args, AUDIOCSETINGAIN);
+}
+
+static object *
+audio_setoutgain(self, args)
+ object *self;
+ object *args;
+{
+ return audio_set_ioctl(self, args, AUDIOCSETOUTGAIN);
+}
+
+static object *
+audio_setrate(self, args)
+ object *self;
+ object *args;
+{
+ return audio_set_ioctl(self, args, AUDIOCSETRATE);
+}
+
+static object *
+audio_setduration(self, args)
+ object *self;
+ object *args;
+{
+ return audio_set_ioctl(self, args, AUDIOCDURATION);
+}
+
+/* Compute average bias, and remove it */
+
+static void
+unbias(buf, len)
+ char *buf;
+ int len;
+{
+ register int i;
+ register int c;
+ register long bias;
+ if (len == 0)
+ return;
+ bias = 0;
+ for (i = 0; i < len; i++) {
+ c = buf[i];
+ if (c > 127)
+ c -= 256;
+ bias += c;
+ }
+ bias = (bias + len/2) / len; /* Rounded average */
+ if (bias != 0) {
+ for (i = 0; i < len; i++) {
+ buf[i] -= bias;
+ }
+ }
+}
+
+static object *
+audio_read(self, args)
+ object *self;
+ object *args;
+{
+ int c, i, n;
+ object *v;
+ char *s;
+ if (!getintarg(args, &n))
+ return NULL;
+ if (n <= 0) {
+ err_setstr(RuntimeError, "audio.read: arg <= 0");
+ return NULL;
+ }
+ if (!init())
+ return NULL;
+ v = newsizedstringobject((char *)NULL, n);
+ if (v == NULL)
+ return err_nomem();
+ s = getstringvalue(v);
+ n = read(audio_fd, s, n);
+ if (intrcheck()) {
+ DECREF(v);
+ err_set(KeyboardInterrupt);
+ return NULL;
+ }
+ /* Check for errors */
+ if (n < 0) {
+ DECREF(v);
+ return NULL;
+ }
+ /* But EOF is reported as an empty string */
+
+ unbias(s, n);
+ resizestring(&v, n);
+ return v;
+}
+
+static object *
+audio_write(self, args)
+ object *self;
+ object *args;
+{
+ int n, n2;
+ object *v;
+ if (!getstrarg(args, &v))
+ return NULL;
+ if (!init())
+ return NULL;
+ errno = 0;
+ n2 = write(audio_fd, getstringvalue(v), n = getstringsize(v));
+ if (intrcheck()) {
+ err_set(KeyboardInterrupt);
+ return NULL;
+ }
+ /* Check for other errors */
+ if (n2 != n) {
+ if (errno == 0)
+ errno = EIO;
+ return NULL;
+ }
+ INCREF(None);
+ return None;
+}
+
+/* audio.amplify(sample, f1, f2).
+ Amplify a sample by a factor changing from f1/256 to (almost) f2/256.
+ Negative factors are allowed. Sound values that are to large
+ to fit in a byte are clipped. */
+
+static object *
+audio_amplify(self, args)
+ object *self;
+ object *args;
+{
+ object *v;
+ char *s, *t;
+ int f1, f2;
+ int i, n;
+ int c;
+ if (!getstrintintarg(args, &v, &f1, &f2))
+ return NULL;
+ n = getstringsize(v);
+ s = getstringvalue(v);
+ v = newsizedstringobject((char *)NULL, n);
+ if (v == NULL)
+ return err_nomem();
+ t = getstringvalue(v);
+ for (i = 0; i < n; i++) {
+ c = s[i];
+ if (c > 127) c -= 256; /* If chars are unsigned */
+ c = c * ( f1*(n-i) + f2*i ) / ( n*256 );
+ if (c > 127) c = 127;
+ else if (c < -128) c = -128;
+ t[i] = c;
+ }
+ return v;
+}
+
+/* audio.reverse(s): return a sample backwards */
+
+static object *
+audio_reverse(self, args)
+ object *self;
+ object *args;
+{
+ object *v;
+ char *s, *t;
+ int i, n;
+ if (!getstrarg(args, &v))
+ return NULL;
+ n = getstringsize(v);
+ s = getstringvalue(v);
+ v = newsizedstringobject((char *)NULL, n);
+ if (v == NULL)
+ return err_nomem();
+ t = getstringvalue(v);
+ for (i = 0; i < n; i++) {
+ t[n-1-i] = s[i];
+ }
+ return v;
+}
+
+/* audio.add(a, b): add two samples.
+ Bytes that exceed the range are clipped.
+ If one is shorter, the rest of the longer sample is returned unchanged. */
+
+static object *
+audio_add(self, args)
+ object *self;
+ object *args;
+{
+ object *a, *b, *v;
+ char *sa, *sb, *t;
+ int i, n, na, nb, c, ca, cb;
+ if (!getstrstrarg(args, &a, &b))
+ return NULL;
+ na = getstringsize(a);
+ sa = getstringvalue(a);
+ nb = getstringsize(b);
+ sb = getstringvalue(b);
+ n = (na > nb) ? na : nb;
+ v = newsizedstringobject((char *)NULL, n);
+ if (v == NULL)
+ return err_nomem();
+ t = getstringvalue(v);
+ for (i = 0; i < n; i++) {
+ c = 0;
+ if (i < na) {
+ ca = sa[i];
+ if (ca > 127) ca = ca - 256;
+ c = c + ca;
+ }
+ if (i < nb) {
+ cb = sb[i];
+ if (cb > 127) cb = cb - 256;
+ c = c + cb;
+ }
+ if (c > 127) c = 127;
+ else if (c < -128) c = -128;
+ t[i] = c;
+ }
+ return v;
+}
+
+/* audio.chr2num(s) returns a list containing the numeric values
+ of the samples. */
+
+static object *
+audio_chr2num(self, args)
+ object *self;
+ object *args;
+{
+ object *v, *w;
+ char *s;
+ int c, i, n;
+ static object *ints[256];
+
+ /* To avoid filling memory with all those int objects, we create
+ integer objects for all the desired values and reference these. */
+ if (ints[255] == NULL) {
+ for (i = 0; i < 256; i++) {
+ if (ints[i] != NULL)
+ continue;
+ c = i;
+ if (c > 127) c -= 256;
+ ints[i] = newintobject((long)c);
+ if (ints[i] == NULL)
+ return NULL;
+ }
+ }
+
+ if (!getstrarg(args, &v))
+ return NULL;
+ n = getstringsize(v);
+ s = getstringvalue(v);
+ v = newlistobject(n);
+ if (v == NULL)
+ return err_nomem();
+ for (i = 0; i < n; i++) {
+ c = s[i] & 0xff;
+ w = ints[c];
+ INCREF(w);
+ if (setlistitem(v, i, w) != 0) {
+ DECREF(v);
+ return NULL;
+ }
+ }
+ return v;
+}
+
+/* audio.num2chr is the inverse of audio.chr2num.
+ Excess values are clipped. */
+
+static object *
+audio_num2chr(self, args)
+ object *self;
+ object *args;
+{
+ object *v, *w;
+ char *s;
+ int c, i, n;
+ if (!is_listobject(args)) {
+ err_badarg();
+ return NULL;
+ }
+ n = getlistsize(args);
+ v = newsizedstringobject((char *)NULL, n);
+ if (v == NULL)
+ return NULL;
+ s = getstringvalue(v);
+ for (i = 0; i < n; i++) {
+ w = getlistitem(args, i);
+ if (!is_intobject(w)) {
+ DECREF(v);
+ err_badarg();
+ return NULL;
+ }
+ s[i] = getintvalue(w);
+ }
+ return v;
+}
+
+static object *stdaudio_buffer = NULL;
+
+static object *
+audio_start_recording(self, args)
+ object *self;
+ object *args;
+{
+ int n;
+ object *v;
+ char *s;
+ if (!getintarg(args, &n))
+ return NULL;
+ if (stdaudio_buffer != NULL) {
+ err_setstr(RuntimeError, "audio.start_recording: device busy");
+ return NULL;
+ }
+ if (n <= 0) {
+ err_setstr(TypeError, "audio.start_recording: arg <= 0");
+ return NULL;
+ }
+ if (!init())
+ return NULL;
+ v = newsizedstringobject((char *)NULL, n);
+ if (v == NULL)
+ return err_nomem();
+ s = getstringvalue(v);
+ asa_start_read(s, n);
+ stdaudio_buffer = v;
+ INCREF(None);
+ return None;
+}
+
+static object *
+audio_poll(self, args)
+ object *self;
+ object *args;
+{
+ int n;
+ if (!getnoarg(args))
+ return NULL;
+ if (stdaudio_buffer == NULL) {
+ err_setstr(RuntimeError, "audio.poll: not busy");
+ return NULL;
+ }
+ if (!init())
+ return NULL;
+ if ((n = asa_poll()) < 0)
+ return NULL;
+ return newintobject(n);
+}
+
+static object *
+audio_wait_recording(self, args)
+ object *self;
+ object *args;
+{
+ object *v;
+ int n;
+ if (!getnoarg(args))
+ return NULL;
+ if (stdaudio_buffer == NULL) {
+ err_setstr(RuntimeError, "audio.wait_recording: not busy");
+ return NULL;
+ }
+ if (!init())
+ return NULL;
+ if ((n = asa_wait()) < 0)
+ return NULL;
+ v = stdaudio_buffer;
+ stdaudio_buffer = NULL;
+ unbias(getstringvalue(v), n);
+ resizestring(&v, n);
+ return v;
+}
+
+static object *
+audio_stop_recording(self, args)
+ object *self;
+ object *args;
+{
+ int n;
+ object *v;
+ char *s;
+ if (!getnoarg(args))
+ return NULL;
+ if (stdaudio_buffer == NULL) {
+ err_setstr(RuntimeError, "audio.stop_recording: not busy");
+ return NULL;
+ }
+ if ((n = asa_cancel()) < 0)
+ return NULL;
+ v = stdaudio_buffer;
+ stdaudio_buffer = NULL;
+ s = getstringvalue(v);
+ unbias(s, n);
+ resizestring(&v, n);
+ return v;
+}
+
+static object *
+audio_start_playing(self, args)
+ object *self;
+ object *args;
+{
+ object *v;
+ if (!getstrarg(args, &v))
+ return NULL;
+ if (stdaudio_buffer != NULL) {
+ err_setstr(RuntimeError, "audio.start_recording: device rbusy");
+ return NULL;
+ }
+ asa_start_write(getstringvalue(v), (int)getstringsize(v));
+ INCREF(v);
+ stdaudio_buffer = v;
+ INCREF(None);
+ return None;
+}
+
+static object *
+audio_wait_playing(self, args)
+ object *self;
+ object *args;
+{
+ int n;
+ if (!getnoarg(args))
+ return NULL;
+ if (stdaudio_buffer == NULL) {
+ err_setstr(RuntimeError, "audio.wait_playing: not busy");
+ return NULL;
+ }
+ if ((n = asa_wait()) < 0)
+ return NULL;
+ DECREF(stdaudio_buffer);
+ stdaudio_buffer = NULL;
+ /* XXX return newintobject((long)n); ??? */
+ INCREF(None);
+ return None;
+}
+
+static object *
+audio_stop_playing(self, args)
+ object *self;
+ object *args;
+{
+ int n;
+ if (!getnoarg(args))
+ return NULL;
+ if (stdaudio_buffer == NULL) {
+ err_setstr(RuntimeError, "audio.stop_playing: not busy");
+ return NULL;
+ }
+ if ((n = asa_cancel()) < 0)
+ return NULL;
+ DECREF(stdaudio_buffer);
+ stdaudio_buffer = NULL;
+ return newintobject((long)n);
+}
+
+static object *
+audio_audio_done(self, args)
+ object *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ asa_done();
+ if (stdaudio_buffer != NULL)
+ DECREF(stdaudio_buffer);
+ stdaudio_buffer = NULL;
+ audio_fd = -1;
+ INCREF(None);
+ return None;
+}
+
+
+static struct methodlist audio_methods[] = {
+ {"getingain", audio_getingain},
+ {"getoutgain", audio_getoutgain},
+ {"setingain", audio_setingain},
+ {"setoutgain", audio_setoutgain},
+ {"setrate", audio_setrate},
+ {"setduration", audio_setduration},
+ {"read", audio_read},
+ {"write", audio_write},
+ {"amplify", audio_amplify},
+ {"reverse", audio_reverse},
+ {"add", audio_add},
+ {"chr2num", audio_chr2num},
+ {"num2chr", audio_num2chr},
+
+ /* "asa" interface: */
+
+ {"start_recording", audio_start_recording},
+ {"poll_recording", audio_poll},
+ {"wait_recording", audio_wait_recording},
+ {"stop_recording", audio_stop_recording},
+
+ {"start_playing", audio_start_playing},
+ {"poll_playing", audio_poll},
+ {"wait_playing", audio_wait_playing},
+ {"stop_playing", audio_stop_playing},
+
+ {"done", audio_audio_done},
+
+ {NULL, NULL} /* Sentinel */
+};
+
+void
+initaudio()
+{
+ initmodule("audio", audio_methods);
+}
diff --git a/src/bitset.c b/src/bitset.c
new file mode 100644
index 0000000..c08dcc7
--- /dev/null
+++ b/src/bitset.c
@@ -0,0 +1,99 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Bitset primitives used by the parser generator */
+
+#include "pgenheaders.h"
+#include "bitset.h"
+
+bitset
+newbitset(nbits)
+ int nbits;
+{
+ int nbytes = NBYTES(nbits);
+ bitset ss = NEW(BYTE, nbytes);
+
+ if (ss == NULL)
+ fatal("no mem for bitset");
+
+ ss += nbytes;
+ while (--nbytes >= 0)
+ *--ss = 0;
+ return ss;
+}
+
+void
+delbitset(ss)
+ bitset ss;
+{
+ DEL(ss);
+}
+
+int
+addbit(ss, ibit)
+ bitset ss;
+ int ibit;
+{
+ int ibyte = BIT2BYTE(ibit);
+ BYTE mask = BIT2MASK(ibit);
+
+ if (ss[ibyte] & mask)
+ return 0; /* Bit already set */
+ ss[ibyte] |= mask;
+ return 1;
+}
+
+#if 0 /* Now a macro */
+int
+testbit(ss, ibit)
+ bitset ss;
+ int ibit;
+{
+ return (ss[BIT2BYTE(ibit)] & BIT2MASK(ibit)) != 0;
+}
+#endif
+
+int
+samebitset(ss1, ss2, nbits)
+ bitset ss1, ss2;
+ int nbits;
+{
+ int i;
+
+ for (i = NBYTES(nbits); --i >= 0; )
+ if (*ss1++ != *ss2++)
+ return 0;
+ return 1;
+}
+
+void
+mergebitset(ss1, ss2, nbits)
+ bitset ss1, ss2;
+ int nbits;
+{
+ int i;
+
+ for (i = NBYTES(nbits); --i >= 0; )
+ *ss1++ |= *ss2++;
+}
diff --git a/src/bitset.h b/src/bitset.h
new file mode 100644
index 0000000..5ec6882
--- /dev/null
+++ b/src/bitset.h
@@ -0,0 +1,46 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Bitset interface */
+
+#define BYTE char
+
+typedef BYTE *bitset;
+
+bitset newbitset PROTO((int nbits));
+void delbitset PROTO((bitset bs));
+/* int testbit PROTO((bitset bs, int ibit)); /* Now a macro, see below */
+int addbit PROTO((bitset bs, int ibit)); /* Returns 0 if already set */
+int samebitset PROTO((bitset bs1, bitset bs2, int nbits));
+void mergebitset PROTO((bitset bs1, bitset bs2, int nbits));
+
+#define BITSPERBYTE (8*sizeof(BYTE))
+#define NBYTES(nbits) (((nbits) + BITSPERBYTE - 1) / BITSPERBYTE)
+
+#define BIT2BYTE(ibit) ((ibit) / BITSPERBYTE)
+#define BIT2SHIFT(ibit) ((ibit) % BITSPERBYTE)
+#define BIT2MASK(ibit) (1 << BIT2SHIFT(ibit))
+#define BYTE2BIT(ibyte) ((ibyte) * BITSPERBYTE)
+
+#define testbit(ss, ibit) (((ss)[BIT2BYTE(ibit)] & BIT2MASK(ibit)) != 0)
diff --git a/src/bltinmodule.c b/src/bltinmodule.c
new file mode 100644
index 0000000..151ba86
--- /dev/null
+++ b/src/bltinmodule.c
@@ -0,0 +1,559 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Built-in functions */
+
+#include "allobjects.h"
+
+#include "node.h"
+#include "graminit.h"
+#include "errcode.h"
+#include "sysmodule.h"
+#include "bltinmodule.h"
+#include "import.h"
+#include "pythonrun.h"
+#include "compile.h" /* For ceval.h */
+#include "ceval.h"
+#include "modsupport.h"
+
+static object *
+builtin_abs(self, v)
+ object *self;
+ object *v;
+{
+ /* XXX This should be a method in the as_number struct in the type */
+ if (v == NULL) {
+ /* */
+ }
+ else if (is_intobject(v)) {
+ long x = getintvalue(v);
+ if (x < 0)
+ x = -x;
+ return newintobject(x);
+ }
+ else if (is_floatobject(v)) {
+ double x = getfloatvalue(v);
+ if (x < 0)
+ x = -x;
+ return newfloatobject(x);
+ }
+ err_setstr(TypeError, "abs() argument must be float or int");
+ return NULL;
+}
+
+static object *
+builtin_chr(self, v)
+ object *self;
+ object *v;
+{
+ long x;
+ char s[1];
+ if (v == NULL || !is_intobject(v)) {
+ err_setstr(TypeError, "chr() must have int argument");
+ return NULL;
+ }
+ x = getintvalue(v);
+ if (x < 0 || x >= 256) {
+ err_setstr(RuntimeError, "chr() arg not in range(256)");
+ return NULL;
+ }
+ s[0] = x;
+ return newsizedstringobject(s, 1);
+}
+
+static object *
+builtin_dir(self, v)
+ object *self;
+ object *v;
+{
+ object *d;
+ if (v == NULL) {
+ d = getlocals();
+ }
+ else {
+ if (!is_moduleobject(v)) {
+ err_setstr(TypeError,
+ "dir() argument, must be module or absent");
+ return NULL;
+ }
+ d = getmoduledict(v);
+ }
+ v = getdictkeys(d);
+ if (sortlist(v) != 0) {
+ DECREF(v);
+ v = NULL;
+ }
+ return v;
+}
+
+static object *
+builtin_divmod(self, v)
+ object *self;
+ object *v;
+{
+ object *x, *y;
+ long xi, yi, xdivy, xmody;
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ err_setstr(TypeError, "divmod() requires 2 int arguments");
+ return NULL;
+ }
+ x = gettupleitem(v, 0);
+ y = gettupleitem(v, 1);
+ if (!is_intobject(x) || !is_intobject(y)) {
+ err_setstr(TypeError, "divmod() requires 2 int arguments");
+ return NULL;
+ }
+ xi = getintvalue(x);
+ yi = getintvalue(y);
+ if (yi == 0) {
+ err_setstr(TypeError, "divmod() division by zero");
+ return NULL;
+ }
+ if (yi < 0) {
+ xdivy = -xi / -yi;
+ }
+ else {
+ xdivy = xi / yi;
+ }
+ xmody = xi - xdivy*yi;
+ if (xmody < 0 && yi > 0 || xmody > 0 && yi < 0) {
+ xmody += yi;
+ xdivy -= 1;
+ }
+ v = newtupleobject(2);
+ x = newintobject(xdivy);
+ y = newintobject(xmody);
+ if (v == NULL || x == NULL || y == NULL ||
+ settupleitem(v, 0, x) != 0 ||
+ settupleitem(v, 1, y) != 0) {
+ XDECREF(v);
+ XDECREF(x);
+ XDECREF(y);
+ return NULL;
+ }
+ return v;
+}
+
+static object *
+exec_eval(v, start)
+ object *v;
+ int start;
+{
+ object *str = NULL, *globals = NULL, *locals = NULL;
+ int n;
+ if (v != NULL) {
+ if (is_stringobject(v))
+ str = v;
+ else if (is_tupleobject(v) &&
+ ((n = gettuplesize(v)) == 2 || n == 3)) {
+ str = gettupleitem(v, 0);
+ globals = gettupleitem(v, 1);
+ if (n == 3)
+ locals = gettupleitem(v, 2);
+ }
+ }
+ if (str == NULL || !is_stringobject(str) ||
+ globals != NULL && !is_dictobject(globals) ||
+ locals != NULL && !is_dictobject(locals)) {
+ err_setstr(TypeError,
+ "exec/eval arguments must be string[,dict[,dict]]");
+ return NULL;
+ }
+ return run_string(getstringvalue(str), start, globals, locals);
+}
+
+static object *
+builtin_eval(self, v)
+ object *self;
+ object *v;
+{
+ return exec_eval(v, eval_input);
+}
+
+static object *
+builtin_exec(self, v)
+ object *self;
+ object *v;
+{
+ return exec_eval(v, file_input);
+}
+
+static object *
+builtin_float(self, v)
+ object *self;
+ object *v;
+{
+ if (v == NULL) {
+ /* */
+ }
+ else if (is_floatobject(v)) {
+ INCREF(v);
+ return v;
+ }
+ else if (is_intobject(v)) {
+ long x = getintvalue(v);
+ return newfloatobject((double)x);
+ }
+ err_setstr(TypeError, "float() argument must be float or int");
+ return NULL;
+}
+
+static object *
+builtin_input(self, v)
+ object *self;
+ object *v;
+{
+ FILE *in = sysgetfile("stdin", stdin);
+ FILE *out = sysgetfile("stdout", stdout);
+ node *n;
+ int err;
+ object *m, *d;
+ flushline();
+ if (v != NULL)
+ printobject(v, out, PRINT_RAW);
+ m = add_module("__main__");
+ d = getmoduledict(m);
+ return run_file(in, "<stdin>", expr_input, d, d);
+}
+
+static object *
+builtin_int(self, v)
+ object *self;
+ object *v;
+{
+ if (v == NULL) {
+ /* */
+ }
+ else if (is_intobject(v)) {
+ INCREF(v);
+ return v;
+ }
+ else if (is_floatobject(v)) {
+ double x = getfloatvalue(v);
+ return newintobject((long)x);
+ }
+ err_setstr(TypeError, "int() argument must be float or int");
+ return NULL;
+}
+
+static object *
+builtin_len(self, v)
+ object *self;
+ object *v;
+{
+ long len;
+ typeobject *tp;
+ if (v == NULL) {
+ err_setstr(TypeError, "len() without argument");
+ return NULL;
+ }
+ tp = v->ob_type;
+ if (tp->tp_as_sequence != NULL) {
+ len = (*tp->tp_as_sequence->sq_length)(v);
+ }
+ else if (tp->tp_as_mapping != NULL) {
+ len = (*tp->tp_as_mapping->mp_length)(v);
+ }
+ else {
+ err_setstr(TypeError, "len() of unsized object");
+ return NULL;
+ }
+ return newintobject(len);
+}
+
+static object *
+min_max(v, sign)
+ object *v;
+ int sign;
+{
+ int i, n, cmp;
+ object *w, *x;
+ sequence_methods *sq;
+ if (v == NULL) {
+ err_setstr(TypeError, "min() or max() without argument");
+ return NULL;
+ }
+ sq = v->ob_type->tp_as_sequence;
+ if (sq == NULL) {
+ err_setstr(TypeError, "min() or max() of non-sequence");
+ return NULL;
+ }
+ n = (*sq->sq_length)(v);
+ if (n == 0) {
+ err_setstr(RuntimeError, "min() or max() of empty sequence");
+ return NULL;
+ }
+ w = (*sq->sq_item)(v, 0); /* Implies INCREF */
+ for (i = 1; i < n; i++) {
+ x = (*sq->sq_item)(v, i); /* Implies INCREF */
+ cmp = cmpobject(x, w);
+ if (cmp * sign > 0) {
+ DECREF(w);
+ w = x;
+ }
+ else
+ DECREF(x);
+ }
+ return w;
+}
+
+static object *
+builtin_min(self, v)
+ object *self;
+ object *v;
+{
+ return min_max(v, -1);
+}
+
+static object *
+builtin_max(self, v)
+ object *self;
+ object *v;
+{
+ return min_max(v, 1);
+}
+
+static object *
+builtin_open(self, v)
+ object *self;
+ object *v;
+{
+ object *name, *mode;
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2 ||
+ !is_stringobject(name = gettupleitem(v, 0)) ||
+ !is_stringobject(mode = gettupleitem(v, 1))) {
+ err_setstr(TypeError, "open() requires 2 string arguments");
+ return NULL;
+ }
+ v = newfileobject(getstringvalue(name), getstringvalue(mode));
+ return v;
+}
+
+static object *
+builtin_ord(self, v)
+ object *self;
+ object *v;
+{
+ if (v == NULL || !is_stringobject(v)) {
+ err_setstr(TypeError, "ord() must have string argument");
+ return NULL;
+ }
+ if (getstringsize(v) != 1) {
+ err_setstr(RuntimeError, "ord() arg must have length 1");
+ return NULL;
+ }
+ return newintobject((long)(getstringvalue(v)[0] & 0xff));
+}
+
+static object *
+builtin_range(self, v)
+ object *self;
+ object *v;
+{
+ static char *errmsg = "range() requires 1-3 int arguments";
+ int i, n;
+ long ilow, ihigh, istep;
+ if (v != NULL && is_intobject(v)) {
+ ilow = 0; ihigh = getintvalue(v); istep = 1;
+ }
+ else if (v == NULL || !is_tupleobject(v)) {
+ err_setstr(TypeError, errmsg);
+ return NULL;
+ }
+ else {
+ n = gettuplesize(v);
+ if (n < 1 || n > 3) {
+ err_setstr(TypeError, errmsg);
+ return NULL;
+ }
+ for (i = 0; i < n; i++) {
+ if (!is_intobject(gettupleitem(v, i))) {
+ err_setstr(TypeError, errmsg);
+ return NULL;
+ }
+ }
+ if (n == 3) {
+ istep = getintvalue(gettupleitem(v, 2));
+ --n;
+ }
+ else
+ istep = 1;
+ ihigh = getintvalue(gettupleitem(v, --n));
+ if (n > 0)
+ ilow = getintvalue(gettupleitem(v, 0));
+ else
+ ilow = 0;
+ }
+ if (istep == 0) {
+ err_setstr(RuntimeError, "zero step for range()");
+ return NULL;
+ }
+ /* XXX ought to check overflow of subtraction */
+ if (istep > 0)
+ n = (ihigh - ilow + istep - 1) / istep;
+ else
+ n = (ihigh - ilow + istep + 1) / istep;
+ if (n < 0)
+ n = 0;
+ v = newlistobject(n);
+ if (v == NULL)
+ return NULL;
+ for (i = 0; i < n; i++) {
+ object *w = newintobject(ilow);
+ if (w == NULL) {
+ DECREF(v);
+ return NULL;
+ }
+ setlistitem(v, i, w);
+ ilow += istep;
+ }
+ return v;
+}
+
+static object *
+builtin_raw_input(self, v)
+ object *self;
+ object *v;
+{
+ FILE *in = sysgetfile("stdin", stdin);
+ FILE *out = sysgetfile("stdout", stdout);
+ char *p;
+ int err;
+ int n = 1000;
+ flushline();
+ if (v != NULL)
+ printobject(v, out, PRINT_RAW);
+ v = newsizedstringobject((char *)NULL, n);
+ if (v != NULL) {
+ if ((err = fgets_intr(getstringvalue(v), n+1, in)) != E_OK) {
+ err_input(err);
+ DECREF(v);
+ return NULL;
+ }
+ else {
+ n = strlen(getstringvalue(v));
+ if (n > 0 && getstringvalue(v)[n-1] == '\n')
+ n--;
+ resizestring(&v, n);
+ }
+ }
+ return v;
+}
+
+static object *
+builtin_reload(self, v)
+ object *self;
+ object *v;
+{
+ return reload_module(v);
+}
+
+static object *
+builtin_type(self, v)
+ object *self;
+ object *v;
+{
+ if (v == NULL) {
+ err_setstr(TypeError, "type() requres an argument");
+ return NULL;
+ }
+ v = (object *)v->ob_type;
+ INCREF(v);
+ return v;
+}
+
+static struct methodlist builtin_methods[] = {
+ {"abs", builtin_abs},
+ {"chr", builtin_chr},
+ {"dir", builtin_dir},
+ {"divmod", builtin_divmod},
+ {"eval", builtin_eval},
+ {"exec", builtin_exec},
+ {"float", builtin_float},
+ {"input", builtin_input},
+ {"int", builtin_int},
+ {"len", builtin_len},
+ {"max", builtin_max},
+ {"min", builtin_min},
+ {"open", builtin_open}, /* XXX move to OS module */
+ {"ord", builtin_ord},
+ {"range", builtin_range},
+ {"raw_input", builtin_raw_input},
+ {"reload", builtin_reload},
+ {"type", builtin_type},
+ {NULL, NULL},
+};
+
+static object *builtin_dict;
+
+object *
+getbuiltin(name)
+ char *name;
+{
+ return dictlookup(builtin_dict, name);
+}
+
+/* Predefined exceptions */
+
+object *RuntimeError;
+object *EOFError;
+object *TypeError;
+object *MemoryError;
+object *NameError;
+object *SystemError;
+object *KeyboardInterrupt;
+
+static object *
+newstdexception(name, message)
+ char *name, *message;
+{
+ object *v = newstringobject(message);
+ if (v == NULL || dictinsert(builtin_dict, name, v) != 0)
+ fatal("no mem for new standard exception");
+ return v;
+}
+
+static void
+initerrors()
+{
+ RuntimeError = newstdexception("RuntimeError", "run-time error");
+ EOFError = newstdexception("EOFError", "end-of-file read");
+ TypeError = newstdexception("TypeError", "type error");
+ MemoryError = newstdexception("MemoryError", "out of memory");
+ NameError = newstdexception("NameError", "undefined name");
+ SystemError = newstdexception("SystemError", "system error");
+ KeyboardInterrupt =
+ newstdexception("KeyboardInterrupt", "keyboard interrupt");
+}
+
+void
+initbuiltin()
+{
+ object *m;
+ m = initmodule("builtin", builtin_methods);
+ builtin_dict = getmoduledict(m);
+ INCREF(builtin_dict);
+ initerrors();
+ (void) dictinsert(builtin_dict, "None", None);
+}
diff --git a/src/bltinmodule.h b/src/bltinmodule.h
new file mode 100644
index 0000000..fe16907
--- /dev/null
+++ b/src/bltinmodule.h
@@ -0,0 +1,27 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Built-in module interface */
+
+extern object *getbuiltin PROTO((char *));
diff --git a/src/ceval.c b/src/ceval.c
new file mode 100644
index 0000000..6876208
--- /dev/null
+++ b/src/ceval.c
@@ -0,0 +1,1436 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Execute compiled code */
+
+#include "allobjects.h"
+
+#include "import.h"
+#include "sysmodule.h"
+#include "compile.h"
+#include "frameobject.h"
+#include "ceval.h"
+#include "opcode.h"
+#include "bltinmodule.h"
+#include "traceback.h"
+
+#ifndef NDEBUG
+#define TRACE
+#endif
+
+#ifdef TRACE
+static int
+prtrace(v, str)
+ object *v;
+ char *str;
+{
+ printf("%s ", str);
+ printobject(v, stdout, 0);
+ printf("\n");
+}
+#endif
+
+static frameobject *current_frame;
+
+object *
+getlocals()
+{
+ if (current_frame == NULL)
+ return NULL;
+ else
+ return current_frame->f_locals;
+}
+
+object *
+getglobals()
+{
+ if (current_frame == NULL)
+ return NULL;
+ else
+ return current_frame->f_globals;
+}
+
+void
+printtraceback(fp)
+ FILE *fp;
+{
+ object *v = tb_fetch();
+ if (v != NULL) {
+ fprintf(fp, "Stack backtrace (innermost last):\n");
+ tb_print(v, fp);
+ DECREF(v);
+ }
+}
+
+
+/* XXX Mixing "print ...," and direct file I/O on stdin/stdout
+ XXX has some bad consequences. The needspace flag should
+ XXX really be part of the file object. */
+
+static int needspace;
+
+void
+flushline()
+{
+ FILE *fp = sysgetfile("stdout", stdout);
+ if (needspace) {
+ fprintf(fp, "\n");
+ needspace = 0;
+ }
+}
+
+
+/* Test a value used as condition, e.g., in a for or if statement */
+
+static int
+testbool(v)
+ object *v;
+{
+ if (is_intobject(v))
+ return getintvalue(v) != 0;
+ if (is_floatobject(v))
+ return getfloatvalue(v) != 0.0;
+ if (v->ob_type->tp_as_sequence != NULL)
+ return (*v->ob_type->tp_as_sequence->sq_length)(v) != 0;
+ if (v->ob_type->tp_as_mapping != NULL)
+ return (*v->ob_type->tp_as_mapping->mp_length)(v) != 0;
+ if (v == None)
+ return 0;
+ /* All other objects are 'true' */
+ return 1;
+}
+
+static object *
+add(v, w)
+ object *v, *w;
+{
+ if (v->ob_type->tp_as_number != NULL)
+ v = (*v->ob_type->tp_as_number->nb_add)(v, w);
+ else if (v->ob_type->tp_as_sequence != NULL)
+ v = (*v->ob_type->tp_as_sequence->sq_concat)(v, w);
+ else {
+ err_setstr(TypeError, "+ not supported by operands");
+ return NULL;
+ }
+ return v;
+}
+
+static object *
+sub(v, w)
+ object *v, *w;
+{
+ if (v->ob_type->tp_as_number != NULL)
+ return (*v->ob_type->tp_as_number->nb_subtract)(v, w);
+ err_setstr(TypeError, "bad operand type(s) for -");
+ return NULL;
+}
+
+static object *
+mul(v, w)
+ object *v, *w;
+{
+ typeobject *tp;
+ if (is_intobject(v) && w->ob_type->tp_as_sequence != NULL) {
+ /* int*sequence -- swap v and w */
+ object *tmp = v;
+ v = w;
+ w = tmp;
+ }
+ tp = v->ob_type;
+ if (tp->tp_as_number != NULL)
+ return (*tp->tp_as_number->nb_multiply)(v, w);
+ if (tp->tp_as_sequence != NULL) {
+ if (!is_intobject(w)) {
+ err_setstr(TypeError,
+ "can't multiply sequence with non-int");
+ return NULL;
+ }
+ if (tp->tp_as_sequence->sq_repeat == NULL) {
+ err_setstr(TypeError, "sequence does not support *");
+ return NULL;
+ }
+ return (*tp->tp_as_sequence->sq_repeat)
+ (v, (int)getintvalue(w));
+ }
+ err_setstr(TypeError, "bad operand type(s) for *");
+ return NULL;
+}
+
+static object *
+divide(v, w)
+ object *v, *w;
+{
+ if (v->ob_type->tp_as_number != NULL)
+ return (*v->ob_type->tp_as_number->nb_divide)(v, w);
+ err_setstr(TypeError, "bad operand type(s) for /");
+ return NULL;
+}
+
+static object *
+rem(v, w)
+ object *v, *w;
+{
+ if (v->ob_type->tp_as_number != NULL)
+ return (*v->ob_type->tp_as_number->nb_remainder)(v, w);
+ err_setstr(TypeError, "bad operand type(s) for %");
+ return NULL;
+}
+
+static object *
+neg(v)
+ object *v;
+{
+ if (v->ob_type->tp_as_number != NULL)
+ return (*v->ob_type->tp_as_number->nb_negative)(v);
+ err_setstr(TypeError, "bad operand type(s) for unary -");
+ return NULL;
+}
+
+static object *
+pos(v)
+ object *v;
+{
+ if (v->ob_type->tp_as_number != NULL)
+ return (*v->ob_type->tp_as_number->nb_positive)(v);
+ err_setstr(TypeError, "bad operand type(s) for unary +");
+ return NULL;
+}
+
+static object *
+not(v)
+ object *v;
+{
+ int outcome = testbool(v);
+ object *w = outcome == 0 ? True : False;
+ INCREF(w);
+ return w;
+}
+
+static object *
+call_builtin(func, arg)
+ object *func;
+ object *arg;
+{
+ if (is_methodobject(func)) {
+ method meth = getmethod(func);
+ object *self = getself(func);
+ return (*meth)(self, arg);
+ }
+ if (is_classobject(func)) {
+ if (arg != NULL) {
+ err_setstr(TypeError,
+ "classobject() allows no arguments");
+ return NULL;
+ }
+ return newclassmemberobject(func);
+ }
+ err_setstr(TypeError, "call of non-function");
+ return NULL;
+}
+
+static object *
+call_function(func, arg)
+ object *func;
+ object *arg;
+{
+ object *newarg = NULL;
+ object *newlocals, *newglobals;
+ object *co, *v;
+
+ if (is_classmethodobject(func)) {
+ object *self = classmethodgetself(func);
+ func = classmethodgetfunc(func);
+ if (arg == NULL) {
+ arg = self;
+ }
+ else {
+ newarg = newtupleobject(2);
+ if (newarg == NULL)
+ return NULL;
+ INCREF(self);
+ INCREF(arg);
+ settupleitem(newarg, 0, self);
+ settupleitem(newarg, 1, arg);
+ arg = newarg;
+ }
+ }
+ else {
+ if (!is_funcobject(func)) {
+ err_setstr(TypeError, "call of non-function");
+ return NULL;
+ }
+ }
+
+ co = getfunccode(func);
+ if (co == NULL) {
+ XDECREF(newarg);
+ return NULL;
+ }
+ if (!is_codeobject(co)) {
+ fprintf(stderr, "XXX Bad code\n");
+ abort();
+ }
+ newlocals = newdictobject();
+ if (newlocals == NULL) {
+ XDECREF(newarg);
+ return NULL;
+ }
+
+ newglobals = getfuncglobals(func);
+ INCREF(newglobals);
+
+ v = eval_code((codeobject *)co, newglobals, newlocals, arg);
+
+ DECREF(newlocals);
+ DECREF(newglobals);
+
+ XDECREF(newarg);
+
+ return v;
+}
+
+static object *
+apply_subscript(v, w)
+ object *v, *w;
+{
+ typeobject *tp = v->ob_type;
+ if (tp->tp_as_sequence == NULL && tp->tp_as_mapping == NULL) {
+ err_setstr(TypeError, "unsubscriptable object");
+ return NULL;
+ }
+ if (tp->tp_as_sequence != NULL) {
+ int i;
+ if (!is_intobject(w)) {
+ err_setstr(TypeError, "sequence subscript not int");
+ return NULL;
+ }
+ i = getintvalue(w);
+ return (*tp->tp_as_sequence->sq_item)(v, i);
+ }
+ return (*tp->tp_as_mapping->mp_subscript)(v, w);
+}
+
+static object *
+loop_subscript(v, w)
+ object *v, *w;
+{
+ sequence_methods *sq = v->ob_type->tp_as_sequence;
+ int i, n;
+ if (sq == NULL) {
+ err_setstr(TypeError, "loop over non-sequence");
+ return NULL;
+ }
+ i = getintvalue(w);
+ n = (*sq->sq_length)(v);
+ if (i >= n)
+ return NULL; /* End of loop */
+ return (*sq->sq_item)(v, i);
+}
+
+static int
+slice_index(v, isize, pi)
+ object *v;
+ int isize;
+ int *pi;
+{
+ if (v != NULL) {
+ if (!is_intobject(v)) {
+ err_setstr(TypeError, "slice index must be int");
+ return -1;
+ }
+ *pi = getintvalue(v);
+ if (*pi < 0)
+ *pi += isize;
+ }
+ return 0;
+}
+
+static object *
+apply_slice(u, v, w) /* return u[v:w] */
+ object *u, *v, *w;
+{
+ typeobject *tp = u->ob_type;
+ int ilow, ihigh, isize;
+ if (tp->tp_as_sequence == NULL) {
+ err_setstr(TypeError, "only sequences can be sliced");
+ return NULL;
+ }
+ ilow = 0;
+ isize = ihigh = (*tp->tp_as_sequence->sq_length)(u);
+ if (slice_index(v, isize, &ilow) != 0)
+ return NULL;
+ if (slice_index(w, isize, &ihigh) != 0)
+ return NULL;
+ return (*tp->tp_as_sequence->sq_slice)(u, ilow, ihigh);
+}
+
+static int
+assign_subscript(w, key, v) /* w[key] = v */
+ object *w;
+ object *key;
+ object *v;
+{
+ typeobject *tp = w->ob_type;
+ sequence_methods *sq;
+ mapping_methods *mp;
+ int (*func)();
+ if ((sq = tp->tp_as_sequence) != NULL &&
+ (func = sq->sq_ass_item) != NULL) {
+ if (!is_intobject(key)) {
+ err_setstr(TypeError,
+ "sequence subscript must be integer");
+ return -1;
+ }
+ else
+ return (*func)(w, (int)getintvalue(key), v);
+ }
+ else if ((mp = tp->tp_as_mapping) != NULL &&
+ (func = mp->mp_ass_subscript) != NULL) {
+ return (*func)(w, key, v);
+ }
+ else {
+ err_setstr(TypeError,
+ "can't assign to this subscripted object");
+ return -1;
+ }
+}
+
+static int
+assign_slice(u, v, w, x) /* u[v:w] = x */
+ object *u, *v, *w, *x;
+{
+ sequence_methods *sq = u->ob_type->tp_as_sequence;
+ int ilow, ihigh, isize;
+ if (sq == NULL) {
+ err_setstr(TypeError, "assign to slice of non-sequence");
+ return -1;
+ }
+ if (sq == NULL || sq->sq_ass_slice == NULL) {
+ err_setstr(TypeError, "unassignable slice");
+ return -1;
+ }
+ ilow = 0;
+ isize = ihigh = (*sq->sq_length)(u);
+ if (slice_index(v, isize, &ilow) != 0)
+ return -1;
+ if (slice_index(w, isize, &ihigh) != 0)
+ return -1;
+ return (*sq->sq_ass_slice)(u, ilow, ihigh, x);
+}
+
+static int
+cmp_exception(err, v)
+ object *err, *v;
+{
+ if (is_tupleobject(v)) {
+ int i, n;
+ n = gettuplesize(v);
+ for (i = 0; i < n; i++) {
+ if (err == gettupleitem(v, i))
+ return 1;
+ }
+ return 0;
+ }
+ return err == v;
+}
+
+static int
+cmp_member(v, w)
+ object *v, *w;
+{
+ int i, n, cmp;
+ object *x;
+ sequence_methods *sq;
+ /* Special case for char in string */
+ if (is_stringobject(w)) {
+ register char *s, *end;
+ register char c;
+ if (!is_stringobject(v) || getstringsize(v) != 1) {
+ err_setstr(TypeError,
+ "string member test needs char left operand");
+ return -1;
+ }
+ c = getstringvalue(v)[0];
+ s = getstringvalue(w);
+ end = s + getstringsize(w);
+ while (s < end) {
+ if (c == *s++)
+ return 1;
+ }
+ return 0;
+ }
+ sq = w->ob_type->tp_as_sequence;
+ if (sq == NULL) {
+ err_setstr(TypeError,
+ "'in' or 'not in' needs sequence right argument");
+ return -1;
+ }
+ n = (*sq->sq_length)(w);
+ for (i = 0; i < n; i++) {
+ x = (*sq->sq_item)(w, i);
+ cmp = cmpobject(v, x);
+ XDECREF(x);
+ if (cmp == 0)
+ return 1;
+ }
+ return 0;
+}
+
+static object *
+cmp_outcome(op, v, w)
+ enum cmp_op op;
+ register object *v;
+ register object *w;
+{
+ register int cmp;
+ register int res = 0;
+ switch (op) {
+ case IS:
+ case IS_NOT:
+ res = (v == w);
+ if (op == IS_NOT)
+ res = !res;
+ break;
+ case IN:
+ case NOT_IN:
+ res = cmp_member(v, w);
+ if (res < 0)
+ return NULL;
+ if (op == NOT_IN)
+ res = !res;
+ break;
+ case EXC_MATCH:
+ res = cmp_exception(v, w);
+ break;
+ default:
+ cmp = cmpobject(v, w);
+ switch (op) {
+ case LT: res = cmp < 0; break;
+ case LE: res = cmp <= 0; break;
+ case EQ: res = cmp == 0; break;
+ case NE: res = cmp != 0; break;
+ case GT: res = cmp > 0; break;
+ case GE: res = cmp >= 0; break;
+ /* XXX no default? (res is initialized to 0 though) */
+ }
+ }
+ v = res ? True : False;
+ INCREF(v);
+ return v;
+}
+
+static int
+import_from(locals, v, name)
+ object *locals;
+ object *v;
+ char *name;
+{
+ object *w, *x;
+ w = getmoduledict(v);
+ if (name[0] == '*') {
+ int i;
+ int n = getdictsize(w);
+ for (i = 0; i < n; i++) {
+ name = getdictkey(w, i);
+ if (name == NULL || name[0] == '_')
+ continue;
+ x = dictlookup(w, name);
+ if (x == NULL) {
+ /* XXX can't happen? */
+ err_setstr(NameError, name);
+ return -1;
+ }
+ if (dictinsert(locals, name, x) != 0)
+ return -1;
+ }
+ return 0;
+ }
+ else {
+ x = dictlookup(w, name);
+ if (x == NULL) {
+ err_setstr(NameError, name);
+ return -1;
+ }
+ else
+ return dictinsert(locals, name, x);
+ }
+}
+
+static object *
+build_class(v, w)
+ object *v; /* None or tuple containing base classes */
+ object *w; /* dictionary */
+{
+ if (is_tupleobject(v)) {
+ int i;
+ for (i = gettuplesize(v); --i >= 0; ) {
+ object *x = gettupleitem(v, i);
+ if (!is_classobject(x)) {
+ err_setstr(TypeError,
+ "base is not a class object");
+ return NULL;
+ }
+ }
+ }
+ else {
+ v = NULL;
+ }
+ if (!is_dictobject(w)) {
+ err_setstr(SystemError, "build_class with non-dictionary");
+ return NULL;
+ }
+ return newclassobject(v, w);
+}
+
+
+/* Status code for main loop (reason for stack unwind) */
+
+enum why_code {
+ WHY_NOT, /* No error */
+ WHY_EXCEPTION, /* Exception occurred */
+ WHY_RERAISE, /* Exception re-raised by 'finally' */
+ WHY_RETURN, /* 'return' statement */
+ WHY_BREAK /* 'break' statement */
+};
+
+/* Interpreter main loop */
+
+object *
+eval_code(co, globals, locals, arg)
+ codeobject *co;
+ object *globals;
+ object *locals;
+ object *arg;
+{
+ register unsigned char *next_instr;
+ register int opcode; /* Current opcode */
+ register int oparg; /* Current opcode argument, if any */
+ register object **stack_pointer;
+ register enum why_code why; /* Reason for block stack unwind */
+ register int err; /* Error status -- nonzero if error */
+ register object *x; /* Result object -- NULL if error */
+ register object *v; /* Temporary objects popped off stack */
+ register object *w;
+ register object *u;
+ register object *t;
+ register frameobject *f; /* Current frame */
+ int lineno; /* Current line number */
+ object *retval; /* Return value iff why == WHY_RETURN */
+ char *name; /* Name used by some instructions */
+ FILE *fp; /* Used by print operations */
+#ifdef TRACE
+ int trace = dictlookup(globals, "__trace__") != NULL;
+#endif
+
+/* Code access macros */
+
+#define GETCONST(i) Getconst(f, i)
+#define GETNAME(i) Getname(f, i)
+#define FIRST_INSTR() (GETUSTRINGVALUE(f->f_code->co_code))
+#define INSTR_OFFSET() (next_instr - FIRST_INSTR())
+#define NEXTOP() (*next_instr++)
+#define NEXTARG() (next_instr += 2, (next_instr[-1]<<8) + next_instr[-2])
+#define JUMPTO(x) (next_instr = FIRST_INSTR() + (x))
+#define JUMPBY(x) (next_instr += (x))
+
+/* Stack manipulation macros */
+
+#define STACK_LEVEL() (stack_pointer - f->f_valuestack)
+#define EMPTY() (STACK_LEVEL() == 0)
+#define TOP() (stack_pointer[-1])
+#define BASIC_PUSH(v) (*stack_pointer++ = (v))
+#define BASIC_POP() (*--stack_pointer)
+
+#ifdef TRACE
+#define PUSH(v) (BASIC_PUSH(v), trace && prtrace(TOP(), "push"))
+#define POP() (trace && prtrace(TOP(), "pop"), BASIC_POP())
+#else
+#define PUSH(v) BASIC_PUSH(v)
+#define POP() BASIC_POP()
+#endif
+
+ f = newframeobject(
+ current_frame, /*back*/
+ co, /*code*/
+ globals, /*globals*/
+ locals, /*locals*/
+ 50, /*nvalues*/
+ 20); /*nblocks*/
+ if (f == NULL)
+ return NULL;
+
+ current_frame = f;
+
+ next_instr = GETUSTRINGVALUE(f->f_code->co_code);
+
+ stack_pointer = f->f_valuestack;
+
+ if (arg != NULL) {
+ INCREF(arg);
+ PUSH(arg);
+ }
+
+ why = WHY_NOT;
+ err = 0;
+ x = None; /* Not a reference, just anything non-NULL */
+ lineno = -1;
+
+ for (;;) {
+ static ticker;
+
+ /* Do periodic things */
+
+ if (--ticker < 0) {
+ ticker = 100;
+ if (intrcheck()) {
+ err_set(KeyboardInterrupt);
+ why = WHY_EXCEPTION;
+ tb_here(f, INSTR_OFFSET(), lineno);
+ break;
+ }
+ }
+
+ /* Extract opcode and argument */
+
+ opcode = NEXTOP();
+ if (HAS_ARG(opcode))
+ oparg = NEXTARG();
+
+#ifdef TRACE
+ /* Instruction tracing */
+
+ if (trace) {
+ if (HAS_ARG(opcode)) {
+ printf("%d: %d, %d\n",
+ (int) (INSTR_OFFSET() - 3),
+ opcode, oparg);
+ }
+ else {
+ printf("%d: %d\n",
+ (int) (INSTR_OFFSET() - 1), opcode);
+ }
+ }
+#endif
+
+ /* Main switch on opcode */
+
+ switch (opcode) {
+
+ /* BEWARE!
+ It is essential that any operation that fails sets either
+ x to NULL, err to nonzero, or why to anything but WHY_NOT,
+ and that no operation that succeeds does this! */
+
+ /* case STOP_CODE: this is an error! */
+
+ case POP_TOP:
+ v = POP();
+ DECREF(v);
+ break;
+
+ case ROT_TWO:
+ v = POP();
+ w = POP();
+ PUSH(v);
+ PUSH(w);
+ break;
+
+ case ROT_THREE:
+ v = POP();
+ w = POP();
+ x = POP();
+ PUSH(v);
+ PUSH(x);
+ PUSH(w);
+ break;
+
+ case DUP_TOP:
+ v = TOP();
+ INCREF(v);
+ PUSH(v);
+ break;
+
+ case UNARY_POSITIVE:
+ v = POP();
+ x = pos(v);
+ DECREF(v);
+ PUSH(x);
+ break;
+
+ case UNARY_NEGATIVE:
+ v = POP();
+ x = neg(v);
+ DECREF(v);
+ PUSH(x);
+ break;
+
+ case UNARY_NOT:
+ v = POP();
+ x = not(v);
+ DECREF(v);
+ PUSH(x);
+ break;
+
+ case UNARY_CONVERT:
+ v = POP();
+ x = reprobject(v);
+ DECREF(v);
+ PUSH(x);
+ break;
+
+ case UNARY_CALL:
+ v = POP();
+ if (is_classmethodobject(v) || is_funcobject(v))
+ x = call_function(v, (object *)NULL);
+ else
+ x = call_builtin(v, (object *)NULL);
+ DECREF(v);
+ PUSH(x);
+ break;
+
+ case BINARY_MULTIPLY:
+ w = POP();
+ v = POP();
+ x = mul(v, w);
+ DECREF(v);
+ DECREF(w);
+ PUSH(x);
+ break;
+
+ case BINARY_DIVIDE:
+ w = POP();
+ v = POP();
+ x = divide(v, w);
+ DECREF(v);
+ DECREF(w);
+ PUSH(x);
+ break;
+
+ case BINARY_MODULO:
+ w = POP();
+ v = POP();
+ x = rem(v, w);
+ DECREF(v);
+ DECREF(w);
+ PUSH(x);
+ break;
+
+ case BINARY_ADD:
+ w = POP();
+ v = POP();
+ x = add(v, w);
+ DECREF(v);
+ DECREF(w);
+ PUSH(x);
+ break;
+
+ case BINARY_SUBTRACT:
+ w = POP();
+ v = POP();
+ x = sub(v, w);
+ DECREF(v);
+ DECREF(w);
+ PUSH(x);
+ break;
+
+ case BINARY_SUBSCR:
+ w = POP();
+ v = POP();
+ x = apply_subscript(v, w);
+ DECREF(v);
+ DECREF(w);
+ PUSH(x);
+ break;
+
+ case BINARY_CALL:
+ w = POP();
+ v = POP();
+ if (is_classmethodobject(v) || is_funcobject(v))
+ x = call_function(v, w);
+ else
+ x = call_builtin(v, w);
+ DECREF(v);
+ DECREF(w);
+ PUSH(x);
+ break;
+
+ case SLICE+0:
+ case SLICE+1:
+ case SLICE+2:
+ case SLICE+3:
+ if ((opcode-SLICE) & 2)
+ w = POP();
+ else
+ w = NULL;
+ if ((opcode-SLICE) & 1)
+ v = POP();
+ else
+ v = NULL;
+ u = POP();
+ x = apply_slice(u, v, w);
+ DECREF(u);
+ XDECREF(v);
+ XDECREF(w);
+ PUSH(x);
+ break;
+
+ case STORE_SLICE+0:
+ case STORE_SLICE+1:
+ case STORE_SLICE+2:
+ case STORE_SLICE+3:
+ if ((opcode-STORE_SLICE) & 2)
+ w = POP();
+ else
+ w = NULL;
+ if ((opcode-STORE_SLICE) & 1)
+ v = POP();
+ else
+ v = NULL;
+ u = POP();
+ t = POP();
+ err = assign_slice(u, v, w, t); /* u[v:w] = t */
+ DECREF(t);
+ DECREF(u);
+ XDECREF(v);
+ XDECREF(w);
+ break;
+
+ case DELETE_SLICE+0:
+ case DELETE_SLICE+1:
+ case DELETE_SLICE+2:
+ case DELETE_SLICE+3:
+ if ((opcode-DELETE_SLICE) & 2)
+ w = POP();
+ else
+ w = NULL;
+ if ((opcode-DELETE_SLICE) & 1)
+ v = POP();
+ else
+ v = NULL;
+ u = POP();
+ err = assign_slice(u, v, w, (object *)NULL);
+ /* del u[v:w] */
+ DECREF(u);
+ XDECREF(v);
+ XDECREF(w);
+ break;
+
+ case STORE_SUBSCR:
+ w = POP();
+ v = POP();
+ u = POP();
+ /* v[w] = u */
+ err = assign_subscript(v, w, u);
+ DECREF(u);
+ DECREF(v);
+ DECREF(w);
+ break;
+
+ case DELETE_SUBSCR:
+ w = POP();
+ v = POP();
+ /* del v[w] */
+ err = assign_subscript(v, w, (object *)NULL);
+ DECREF(v);
+ DECREF(w);
+ break;
+
+ case PRINT_EXPR:
+ v = POP();
+ fp = sysgetfile("stdout", stdout);
+ /* Print value except if procedure result */
+ if (v != None) {
+ flushline();
+ printobject(v, fp, 0);
+ fprintf(fp, "\n");
+ }
+ DECREF(v);
+ break;
+
+ case PRINT_ITEM:
+ v = POP();
+ fp = sysgetfile("stdout", stdout);
+ if (needspace)
+ fprintf(fp, " ");
+ if (is_stringobject(v)) {
+ char *s = getstringvalue(v);
+ int len = getstringsize(v);
+ fwrite(s, 1, len, fp);
+ if (len > 0 && s[len-1] == '\n')
+ needspace = 0;
+ else
+ needspace = 1;
+ }
+ else {
+ printobject(v, fp, 0);
+ needspace = 1;
+ }
+ DECREF(v);
+ break;
+
+ case PRINT_NEWLINE:
+ fp = sysgetfile("stdout", stdout);
+ fprintf(fp, "\n");
+ needspace = 0;
+ break;
+
+ case BREAK_LOOP:
+ why = WHY_BREAK;
+ break;
+
+ case RAISE_EXCEPTION:
+ v = POP();
+ w = POP();
+ if (!is_stringobject(w))
+ err_setstr(TypeError,
+ "exceptions must be strings");
+ else
+ err_setval(w, v);
+ DECREF(v);
+ DECREF(w);
+ why = WHY_EXCEPTION;
+ break;
+
+ case LOAD_LOCALS:
+ v = f->f_locals;
+ INCREF(v);
+ PUSH(v);
+ break;
+
+ case RETURN_VALUE:
+ retval = POP();
+ why = WHY_RETURN;
+ break;
+
+ case REQUIRE_ARGS:
+ if (EMPTY()) {
+ err_setstr(TypeError,
+ "function expects argument(s)");
+ why = WHY_EXCEPTION;
+ }
+ break;
+
+ case REFUSE_ARGS:
+ if (!EMPTY()) {
+ err_setstr(TypeError,
+ "function expects no argument(s)");
+ why = WHY_EXCEPTION;
+ }
+ break;
+
+ case BUILD_FUNCTION:
+ v = POP();
+ x = newfuncobject(v, f->f_globals);
+ DECREF(v);
+ PUSH(x);
+ break;
+
+ case POP_BLOCK:
+ {
+ block *b = pop_block(f);
+ while (STACK_LEVEL() > b->b_level) {
+ v = POP();
+ DECREF(v);
+ }
+ }
+ break;
+
+ case END_FINALLY:
+ v = POP();
+ if (is_intobject(v)) {
+ why = (enum why_code) getintvalue(v);
+ if (why == WHY_RETURN)
+ retval = POP();
+ }
+ else if (is_stringobject(v)) {
+ w = POP();
+ err_setval(v, w);
+ DECREF(w);
+ w = POP();
+ tb_store(w);
+ DECREF(w);
+ why = WHY_RERAISE;
+ }
+ else if (v != None) {
+ err_setstr(SystemError,
+ "'finally' pops bad exception");
+ why = WHY_EXCEPTION;
+ }
+ DECREF(v);
+ break;
+
+ case BUILD_CLASS:
+ w = POP();
+ v = POP();
+ x = build_class(v, w);
+ PUSH(x);
+ DECREF(v);
+ DECREF(w);
+ break;
+
+ case STORE_NAME:
+ name = GETNAME(oparg);
+ v = POP();
+ err = dictinsert(f->f_locals, name, v);
+ DECREF(v);
+ break;
+
+ case DELETE_NAME:
+ name = GETNAME(oparg);
+ if ((err = dictremove(f->f_locals, name)) != 0)
+ err_setstr(NameError, name);
+ break;
+
+ case UNPACK_TUPLE:
+ v = POP();
+ if (!is_tupleobject(v)) {
+ err_setstr(TypeError, "unpack non-tuple");
+ why = WHY_EXCEPTION;
+ }
+ else if (gettuplesize(v) != oparg) {
+ err_setstr(RuntimeError,
+ "unpack tuple of wrong size");
+ why = WHY_EXCEPTION;
+ }
+ else {
+ for (; --oparg >= 0; ) {
+ w = gettupleitem(v, oparg);
+ INCREF(w);
+ PUSH(w);
+ }
+ }
+ DECREF(v);
+ break;
+
+ case UNPACK_LIST:
+ v = POP();
+ if (!is_listobject(v)) {
+ err_setstr(TypeError, "unpack non-list");
+ why = WHY_EXCEPTION;
+ }
+ else if (getlistsize(v) != oparg) {
+ err_setstr(RuntimeError,
+ "unpack list of wrong size");
+ why = WHY_EXCEPTION;
+ }
+ else {
+ for (; --oparg >= 0; ) {
+ w = getlistitem(v, oparg);
+ INCREF(w);
+ PUSH(w);
+ }
+ }
+ DECREF(v);
+ break;
+
+ case STORE_ATTR:
+ name = GETNAME(oparg);
+ v = POP();
+ u = POP();
+ err = setattr(v, name, u); /* v.name = u */
+ DECREF(v);
+ DECREF(u);
+ break;
+
+ case DELETE_ATTR:
+ name = GETNAME(oparg);
+ v = POP();
+ err = setattr(v, name, (object *)NULL);
+ /* del v.name */
+ DECREF(v);
+ break;
+
+ case LOAD_CONST:
+ x = GETCONST(oparg);
+ INCREF(x);
+ PUSH(x);
+ break;
+
+ case LOAD_NAME:
+ name = GETNAME(oparg);
+ x = dictlookup(f->f_locals, name);
+ if (x == NULL) {
+ x = dictlookup(f->f_globals, name);
+ if (x == NULL)
+ x = getbuiltin(name);
+ }
+ if (x == NULL)
+ err_setstr(NameError, name);
+ else
+ INCREF(x);
+ PUSH(x);
+ break;
+
+ case BUILD_TUPLE:
+ x = newtupleobject(oparg);
+ if (x != NULL) {
+ for (; --oparg >= 0;) {
+ w = POP();
+ err = settupleitem(x, oparg, w);
+ if (err != 0)
+ break;
+ }
+ PUSH(x);
+ }
+ break;
+
+ case BUILD_LIST:
+ x = newlistobject(oparg);
+ if (x != NULL) {
+ for (; --oparg >= 0;) {
+ w = POP();
+ err = setlistitem(x, oparg, w);
+ if (err != 0)
+ break;
+ }
+ PUSH(x);
+ }
+ break;
+
+ case BUILD_MAP:
+ x = newdictobject();
+ PUSH(x);
+ break;
+
+ case LOAD_ATTR:
+ name = GETNAME(oparg);
+ v = POP();
+ x = getattr(v, name);
+ DECREF(v);
+ PUSH(x);
+ break;
+
+ case COMPARE_OP:
+ w = POP();
+ v = POP();
+ x = cmp_outcome((enum cmp_op)oparg, v, w);
+ DECREF(v);
+ DECREF(w);
+ PUSH(x);
+ break;
+
+ case IMPORT_NAME:
+ name = GETNAME(oparg);
+ x = import_module(name);
+ XINCREF(x);
+ PUSH(x);
+ break;
+
+ case IMPORT_FROM:
+ name = GETNAME(oparg);
+ v = TOP();
+ err = import_from(f->f_locals, v, name);
+ break;
+
+ case JUMP_FORWARD:
+ JUMPBY(oparg);
+ break;
+
+ case JUMP_IF_FALSE:
+ if (!testbool(TOP()))
+ JUMPBY(oparg);
+ break;
+
+ case JUMP_IF_TRUE:
+ if (testbool(TOP()))
+ JUMPBY(oparg);
+ break;
+
+ case JUMP_ABSOLUTE:
+ JUMPTO(oparg);
+ break;
+
+ case FOR_LOOP:
+ /* for v in s: ...
+ On entry: stack contains s, i.
+ On exit: stack contains s, i+1, s[i];
+ but if loop exhausted:
+ s, i are popped, and we jump */
+ w = POP(); /* Loop index */
+ v = POP(); /* Sequence object */
+ u = loop_subscript(v, w);
+ if (u != NULL) {
+ PUSH(v);
+ x = newintobject(getintvalue(w)+1);
+ PUSH(x);
+ DECREF(w);
+ PUSH(u);
+ }
+ else {
+ DECREF(v);
+ DECREF(w);
+ /* A NULL can mean "s exhausted"
+ but also an error: */
+ if (err_occurred())
+ why = WHY_EXCEPTION;
+ else
+ JUMPBY(oparg);
+ }
+ break;
+
+ case SETUP_LOOP:
+ case SETUP_EXCEPT:
+ case SETUP_FINALLY:
+ setup_block(f, opcode, INSTR_OFFSET() + oparg,
+ STACK_LEVEL());
+ break;
+
+ case SET_LINENO:
+#ifdef TRACE
+ if (trace)
+ printf("--- Line %d ---\n", oparg);
+#endif
+ lineno = oparg;
+ break;
+
+ default:
+ fprintf(stderr,
+ "XXX lineno: %d, opcode: %d\n",
+ lineno, opcode);
+ err_setstr(SystemError, "eval_code: unknown opcode");
+ why = WHY_EXCEPTION;
+ break;
+
+ } /* switch */
+
+
+ /* Quickly continue if no error occurred */
+
+ if (why == WHY_NOT) {
+ if (err == 0 && x != NULL)
+ continue; /* Normal, fast path */
+ why = WHY_EXCEPTION;
+ x = None;
+ err = 0;
+ }
+
+#ifndef NDEBUG
+ /* Double-check exception status */
+
+ if (why == WHY_EXCEPTION || why == WHY_RERAISE) {
+ if (!err_occurred()) {
+ fprintf(stderr, "XXX ghost error\n");
+ err_setstr(SystemError, "ghost error");
+ why = WHY_EXCEPTION;
+ }
+ }
+ else {
+ if (err_occurred()) {
+ fprintf(stderr, "XXX undetected error\n");
+ why = WHY_EXCEPTION;
+ }
+ }
+#endif
+
+ /* Log traceback info if this is a real exception */
+
+ if (why == WHY_EXCEPTION) {
+ int lasti = INSTR_OFFSET() - 1;
+ if (HAS_ARG(opcode))
+ lasti -= 2;
+ tb_here(f, lasti, lineno);
+ }
+
+ /* For the rest, treat WHY_RERAISE as WHY_EXCEPTION */
+
+ if (why == WHY_RERAISE)
+ why = WHY_EXCEPTION;
+
+ /* Unwind stacks if a (pseudo) exception occurred */
+
+ while (why != WHY_NOT && f->f_iblock > 0) {
+ block *b = pop_block(f);
+ while (STACK_LEVEL() > b->b_level) {
+ v = POP();
+ XDECREF(v);
+ }
+ if (b->b_type == SETUP_LOOP && why == WHY_BREAK) {
+ why = WHY_NOT;
+ JUMPTO(b->b_handler);
+ break;
+ }
+ if (b->b_type == SETUP_FINALLY ||
+ b->b_type == SETUP_EXCEPT &&
+ why == WHY_EXCEPTION) {
+ if (why == WHY_EXCEPTION) {
+ object *exc, *val;
+ err_get(&exc, &val);
+ if (val == NULL) {
+ val = None;
+ INCREF(val);
+ }
+ v = tb_fetch();
+ /* Make the raw exception data
+ available to the handler,
+ so a program can emulate the
+ Python main loop. Don't do
+ this for 'finally'. */
+ if (b->b_type == SETUP_EXCEPT) {
+#if 0 /* Oops, this breaks too many things */
+ sysset("exc_traceback", v);
+#endif
+ sysset("exc_value", val);
+ sysset("exc_type", exc);
+ err_clear();
+ }
+ PUSH(v);
+ PUSH(val);
+ PUSH(exc);
+ }
+ else {
+ if (why == WHY_RETURN)
+ PUSH(retval);
+ v = newintobject((long)why);
+ PUSH(v);
+ }
+ why = WHY_NOT;
+ JUMPTO(b->b_handler);
+ break;
+ }
+ } /* unwind stack */
+
+ /* End the loop if we still have an error (or return) */
+
+ if (why != WHY_NOT)
+ break;
+
+ } /* main loop */
+
+ /* Pop remaining stack entries */
+
+ while (!EMPTY()) {
+ v = POP();
+ XDECREF(v);
+ }
+
+ /* Restore previous frame and release the current one */
+
+ current_frame = f->f_back;
+ DECREF(f);
+
+ if (why == WHY_RETURN)
+ return retval;
+ else
+ return NULL;
+}
diff --git a/src/ceval.h b/src/ceval.h
new file mode 100644
index 0000000..7f57738
--- /dev/null
+++ b/src/ceval.h
@@ -0,0 +1,33 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Interface to execute compiled code */
+/* This header depends on "compile.h" */
+
+object *eval_code PROTO((codeobject *, object *, object *, object *));
+
+object *getglobals PROTO((void));
+object *getlocals PROTO((void));
+
+void printtraceback PROTO((FILE *));
diff --git a/src/cgen b/src/cgen
new file mode 100644
index 0000000..c2f0d0c
--- /dev/null
+++ b/src/cgen
@@ -0,0 +1,458 @@
+# Python script to parse cstubs file for gl and generate C stubs.
+# usage: python cgen <cstubs >glmodule.c
+#
+# XXX BUG return arrays generate wrong code
+# XXX need to change error returns into gotos to free mallocked arrays
+
+
+import string
+import sys
+
+
+# Function to print to stderr
+#
+def err(args):
+ savestdout = sys.stdout
+ try:
+ sys.stdout = sys.stderr
+ for i in args:
+ print i,
+ print
+ finally:
+ sys.stdout = savestdout
+
+
+# The set of digits that form a number
+#
+digits = '0123456789'
+
+
+# Function to extract a string of digits from the front of the string.
+# Returns the leading string of digits and the remaining string.
+# If no number is found, returns '' and the original string.
+#
+def getnum(s):
+ n = ''
+ while s and s[0] in digits:
+ n = n + s[0]
+ s = s[1:]
+ return n, s
+
+
+# Function to check if a string is a number
+#
+def isnum(s):
+ if not s: return 0
+ for c in s:
+ if not c in digits: return 0
+ return 1
+
+
+# Allowed function return types
+#
+return_types = ['void', 'short', 'long']
+
+
+# Allowed function argument types
+#
+arg_types = ['char', 'string', 'short', 'float', 'long', 'double']
+
+
+# Need to classify arguments as follows
+# simple input variable
+# simple output variable
+# input array
+# output array
+# input giving size of some array
+#
+# Array dimensions can be specified as follows
+# constant
+# argN
+# constant * argN
+# retval
+# constant * retval
+#
+# The dimensions given as constants * something are really
+# arrays of points where points are 2- 3- or 4-tuples
+#
+# We have to consider three lists:
+# python input arguments
+# C stub arguments (in & out)
+# python output arguments (really return values)
+#
+# There is a mapping from python input arguments to the input arguments
+# of the C stub, and a further mapping from C stub arguments to the
+# python return values
+
+
+# Exception raised by checkarg() and generate()
+#
+arg_error = 'bad arg'
+
+
+# Function to check one argument.
+# Arguments: the type and the arg "name" (really mode plus subscript).
+# Raises arg_error if something's wrong.
+# Return type, mode, factor, rest of subscript; factor and rest may be empty.
+#
+def checkarg(type, arg):
+ #
+ # Turn "char *x" into "string x".
+ #
+ if type = 'char' and arg[0] = '*':
+ type = 'string'
+ arg = arg[1:]
+ #
+ # Check that the type is supported.
+ #
+ if type not in arg_types:
+ raise arg_error, ('bad type', type)
+ #
+ # Split it in the mode (first character) and the rest.
+ #
+ mode, rest = arg[:1], arg[1:]
+ #
+ # The mode must be 's' for send (= input) or 'r' for return argument.
+ #
+ if mode not in ('r', 's'):
+ raise arg_error, ('bad arg mode', mode)
+ #
+ # Is it a simple argument: if so, we are done.
+ #
+ if not rest:
+ return type, mode, '', ''
+ #
+ # Not a simple argument; must be an array.
+ # The 'rest' must be a subscript enclosed in [ and ].
+ # The subscript must be one of the following forms,
+ # otherwise we don't handle it (where N is a number):
+ # N
+ # argN
+ # retval
+ # N*argN
+ # N*retval
+ #
+ if rest[:1] <> '[' or rest[-1:] <> ']':
+ raise arg_error, ('subscript expected', rest)
+ sub = rest[1:-1]
+ #
+ # Is there a leading number?
+ #
+ num, sub = getnum(sub)
+ if num:
+ # There is a leading number
+ if not sub:
+ # The subscript is just a number
+ return type, mode, num, ''
+ if sub[:1] = '*':
+ # There is a factor prefix
+ sub = sub[1:]
+ else:
+ raise arg_error, ('\'*\' expected', sub)
+ if sub = 'retval':
+ # size is retval -- must be a reply argument
+ if mode <> 'r':
+ raise arg_error, ('non-r mode with [retval]', mode)
+ elif sub[:3] <> 'arg' or not isnum(sub[3:]):
+ raise arg_error, ('bad subscript', sub)
+ #
+ return type, mode, num, sub
+
+
+# List of functions for which we have generated stubs
+#
+functions = []
+
+
+# Generate the stub for the given function, using the database of argument
+# information build by successive calls to checkarg()
+#
+def generate(type, func, database):
+ #
+ # Check that we can handle this case:
+ # no variable size reply arrays yet
+ #
+ n_in_args = 0
+ n_out_args = 0
+ #
+ for a_type, a_mode, a_factor, a_sub in database:
+ if a_mode = 's':
+ n_in_args = n_in_args + 1
+ elif a_mode = 'r':
+ n_out_args = n_out_args + 1
+ else:
+ # Can't happen
+ raise arg_error, ('bad a_mode', a_mode)
+ if (a_mode = 'r' and a_sub) or a_sub = 'retval':
+ e = 'Function', func, 'too complicated:'
+ err(e + (a_type, a_mode, a_factor, a_sub))
+ print '/* XXX Too complicated to generate code for */'
+ return
+ #
+ functions.append(func)
+ #
+ # Stub header
+ #
+ print
+ print 'static object *'
+ print 'gl_' + func + '(self, args)'
+ print '\tobject *self;'
+ print '\tobject *args;'
+ print '{'
+ #
+ # Declare return value if any
+ #
+ if type <> 'void':
+ print '\t' + type, 'retval;'
+ #
+ # Declare arguments
+ #
+ for i in range(len(database)):
+ a_type, a_mode, a_factor, a_sub = database[i]
+ print '\t' + a_type,
+ if a_sub:
+ print '*',
+ print 'arg' + `i+1`,
+ if a_factor and not a_sub:
+ print '[', a_factor, ']',
+ print ';'
+ #
+ # Find input arguments derived from array sizes
+ #
+ for i in range(len(database)):
+ a_type, a_mode, a_factor, a_sub = database[i]
+ if a_mode = 's' and a_sub[:3] = 'arg' and isnum(a_sub[3:]):
+ # Sending a variable-length array
+ n = eval(a_sub[3:])
+ if 1 <= n <= len(database):
+ b_type, b_mode, b_factor, b_sub = database[n-1]
+ if b_mode = 's':
+ database[n-1] = b_type, 'i', a_factor, `i`
+ n_in_args = n_in_args - 1
+ #
+ # Assign argument positions in the Python argument list
+ #
+ in_pos = []
+ i_in = 0
+ for i in range(len(database)):
+ a_type, a_mode, a_factor, a_sub = database[i]
+ if a_mode = 's':
+ in_pos.append(i_in)
+ i_in = i_in + 1
+ else:
+ in_pos.append(-1)
+ #
+ # Get input arguments
+ #
+ for i in range(len(database)):
+ a_type, a_mode, a_factor, a_sub = database[i]
+ if a_mode = 'i':
+ #
+ # Implicit argument;
+ # a_factor is divisor if present,
+ # a_sub indicates which arg (`database index`)
+ #
+ j = eval(a_sub)
+ print '\tif',
+ print '(!geti' + a_type + 'arraysize(args,',
+ print `n_in_args` + ',',
+ print `in_pos[j]` + ',',
+ print '&arg' + `i+1` + '))'
+ print '\t\treturn NULL;'
+ if a_factor:
+ print '\targ' + `i+1`,
+ print '= arg' + `i+1`,
+ print '/', a_factor + ';'
+ elif a_mode = 's':
+ if a_sub: # Allocate memory for varsize array
+ print '\tif ((arg' + `i+1`, '=',
+ print 'NEW(' + a_type + ',',
+ if a_factor: print a_factor, '*',
+ print a_sub, ')) == NULL)'
+ print '\t\treturn err_nomem();'
+ print '\tif',
+ if a_factor or a_sub: # Get a fixed-size array array
+ print '(!geti' + a_type + 'array(args,',
+ print `n_in_args` + ',',
+ print `in_pos[i]` + ',',
+ if a_factor: print a_factor,
+ if a_factor and a_sub: print '*',
+ if a_sub: print a_sub,
+ print ', arg' + `i+1` + '))'
+ else: # Get a simple variable
+ print '(!geti' + a_type + 'arg(args,',
+ print `n_in_args` + ',',
+ print `in_pos[i]` + ',',
+ print '&arg' + `i+1` + '))'
+ print '\t\treturn NULL;'
+ #
+ # Begin of function call
+ #
+ if type <> 'void':
+ print '\tretval =', func + '(',
+ else:
+ print '\t' + func + '(',
+ #
+ # Argument list
+ #
+ for i in range(len(database)):
+ if i > 0: print ',',
+ a_type, a_mode, a_factor, a_sub = database[i]
+ if a_mode = 'r' and not a_factor:
+ print '&',
+ print 'arg' + `i+1`,
+ #
+ # End of function call
+ #
+ print ');'
+ #
+ # Free varsize arrays
+ #
+ for i in range(len(database)):
+ a_type, a_mode, a_factor, a_sub = database[i]
+ if a_mode = 's' and a_sub:
+ print '\tDEL(arg' + `i+1` + ');'
+ #
+ # Return
+ #
+ if n_out_args:
+ #
+ # Multiple return values -- construct a tuple
+ #
+ if type <> 'void':
+ n_out_args = n_out_args + 1
+ if n_out_args = 1:
+ for i in range(len(database)):
+ a_type, a_mode, a_factor, a_sub = database[i]
+ if a_mode = 'r':
+ break
+ else:
+ raise arg_error, 'expected r arg not found'
+ print '\treturn',
+ print mkobject(a_type, 'arg' + `i+1`) + ';'
+ else:
+ print '\t{ object *v = newtupleobject(',
+ print n_out_args, ');'
+ print '\t if (v == NULL) return NULL;'
+ i_out = 0
+ if type <> 'void':
+ print '\t settupleitem(v,',
+ print `i_out` + ',',
+ print mkobject(type, 'retval') + ');'
+ i_out = i_out + 1
+ for i in range(len(database)):
+ a_type, a_mode, a_factor, a_sub = database[i]
+ if a_mode = 'r':
+ print '\t settupleitem(v,',
+ print `i_out` + ',',
+ s = mkobject(a_type, 'arg' + `i+1`)
+ print s + ');'
+ i_out = i_out + 1
+ print '\t return v;'
+ print '\t}'
+ else:
+ #
+ # Simple function return
+ # Return None or return value
+ #
+ if type = 'void':
+ print '\tINCREF(None);'
+ print '\treturn None;'
+ else:
+ print '\treturn', mkobject(type, 'retval') + ';'
+ #
+ # Stub body closing brace
+ #
+ print '}'
+
+
+# Subroutine to return a function call to mknew<type>object(<arg>)
+#
+def mkobject(type, arg):
+ return 'mknew' + type + 'object(' + arg + ')'
+
+
+# Input line number
+lno = 0
+
+
+# Input is divided in two parts, separated by a line containing '%%'.
+# <part1> -- literally copied to stdout
+# <part2> -- stub definitions
+
+# Variable indicating the current input part.
+#
+part = 1
+
+# Main loop over the input
+#
+while 1:
+ try:
+ line = raw_input()
+ except EOFError:
+ break
+ #
+ lno = lno+1
+ words = string.split(line)
+ #
+ if part = 1:
+ #
+ # In part 1, copy everything literally
+ # except look for a line of just '%%'
+ #
+ if words = ['%%']:
+ part = part + 1
+ else:
+ #
+ # Look for names of manually written
+ # stubs: a single percent followed by the name
+ # of the function in Python.
+ # The stub name is derived by prefixing 'gl_'.
+ #
+ if words and words[0][0] = '%':
+ func = words[0][1:]
+ if (not func) and words[1:]:
+ func = words[1]
+ if func:
+ functions.append(func)
+ else:
+ print line
+ elif not words:
+ pass # skip empty line
+ elif words[0] = '#include':
+ print line
+ elif words[0][:1] = '#':
+ pass # ignore comment
+ elif words[0] not in return_types:
+ err('Line', lno, ': bad return type :', words[0])
+ elif len(words) < 2:
+ err('Line', lno, ': no funcname :', line)
+ else:
+ if len(words) % 2 <> 0:
+ err('Line', lno, ': odd argument list :', words[2:])
+ else:
+ database = []
+ try:
+ for i in range(2, len(words), 2):
+ x = checkarg(words[i], words[i+1])
+ database.append(x)
+ print
+ print '/*',
+ for w in words: print w,
+ print '*/'
+ generate(words[0], words[1], database)
+ except arg_error, msg:
+ err('Line', lno, ':', msg)
+
+
+print
+print 'static struct methodlist gl_methods[] = {'
+for func in functions:
+ print '\t{"' + func + '", gl_' + func + '},'
+print '\t{NULL, NULL} /* Sentinel */'
+print '};'
+print
+print 'initgl()'
+print '{'
+print '\tinitmodule("gl", gl_methods);'
+print '}'
diff --git a/src/cgensupport.c b/src/cgensupport.c
new file mode 100644
index 0000000..91adb2a
--- /dev/null
+++ b/src/cgensupport.c
@@ -0,0 +1,393 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Functions used by cgen output */
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "intobject.h"
+#include "floatobject.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+#include "listobject.h"
+#include "methodobject.h"
+#include "moduleobject.h"
+#include "modsupport.h"
+#include "import.h"
+#include "cgensupport.h"
+#include "errors.h"
+
+
+/* Functions to construct return values */
+
+object *
+mknewcharobject(c)
+ int c;
+{
+ char ch[1];
+ ch[0] = c;
+ return newsizedstringobject(ch, 1);
+}
+
+/* Functions to extract arguments.
+ These needs to know the total number of arguments supplied,
+ since the argument list is a tuple only of there is more than
+ one argument. */
+
+int
+getiobjectarg(args, nargs, i, p_arg)
+ register object *args;
+ int nargs, i;
+ object **p_arg;
+{
+ if (nargs != 1) {
+ if (args == NULL || !is_tupleobject(args) ||
+ nargs != gettuplesize(args) ||
+ i < 0 || i >= nargs) {
+ return err_badarg();
+ }
+ else {
+ args = gettupleitem(args, i);
+ }
+ }
+ if (args == NULL) {
+ return err_badarg();
+ }
+ *p_arg = args;
+ return 1;
+}
+
+int
+getilongarg(args, nargs, i, p_arg)
+ register object *args;
+ int nargs, i;
+ long *p_arg;
+{
+ if (nargs != 1) {
+ if (args == NULL || !is_tupleobject(args) ||
+ nargs != gettuplesize(args) ||
+ i < 0 || i >= nargs) {
+ return err_badarg();
+ }
+ args = gettupleitem(args, i);
+ }
+ if (args == NULL || !is_intobject(args)) {
+ return err_badarg();
+ }
+ *p_arg = getintvalue(args);
+ return 1;
+}
+
+int
+getishortarg(args, nargs, i, p_arg)
+ register object *args;
+ int nargs, i;
+ short *p_arg;
+{
+ long x;
+ if (!getilongarg(args, nargs, i, &x))
+ return 0;
+ *p_arg = x;
+ return 1;
+}
+
+static int
+extractdouble(v, p_arg)
+ register object *v;
+ double *p_arg;
+{
+ if (v == NULL) {
+ /* Fall through to error return at end of function */
+ }
+ else if (is_floatobject(v)) {
+ *p_arg = GETFLOATVALUE((floatobject *)v);
+ return 1;
+ }
+ else if (is_intobject(v)) {
+ *p_arg = GETINTVALUE((intobject *)v);
+ return 1;
+ }
+ return err_badarg();
+}
+
+static int
+extractfloat(v, p_arg)
+ register object *v;
+ float *p_arg;
+{
+ if (v == NULL) {
+ /* Fall through to error return at end of function */
+ }
+ else if (is_floatobject(v)) {
+ *p_arg = GETFLOATVALUE((floatobject *)v);
+ return 1;
+ }
+ else if (is_intobject(v)) {
+ *p_arg = GETINTVALUE((intobject *)v);
+ return 1;
+ }
+ return err_badarg();
+}
+
+int
+getifloatarg(args, nargs, i, p_arg)
+ register object *args;
+ int nargs, i;
+ float *p_arg;
+{
+ object *v;
+ float x;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (!extractfloat(v, &x))
+ return 0;
+ *p_arg = x;
+ return 1;
+}
+
+int
+getistringarg(args, nargs, i, p_arg)
+ object *args;
+ int nargs, i;
+ string *p_arg;
+{
+ object *v;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return NULL;
+ if (!is_stringobject(v)) {
+ return err_badarg();
+ }
+ *p_arg = getstringvalue(v);
+ return 1;
+}
+
+int
+getichararg(args, nargs, i, p_arg)
+ object *args;
+ int nargs, i;
+ char *p_arg;
+{
+ string x;
+ if (!getistringarg(args, nargs, i, &x))
+ return 0;
+ if (x[0] == '\0' || x[1] != '\0') {
+ /* Not exactly one char */
+ return err_badarg();
+ }
+ *p_arg = x[0];
+ return 1;
+}
+
+int
+getilongarraysize(args, nargs, i, p_arg)
+ object *args;
+ int nargs, i;
+ long *p_arg;
+{
+ object *v;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (is_tupleobject(v)) {
+ *p_arg = gettuplesize(v);
+ return 1;
+ }
+ if (is_listobject(v)) {
+ *p_arg = getlistsize(v);
+ return 1;
+ }
+ return err_badarg();
+}
+
+int
+getishortarraysize(args, nargs, i, p_arg)
+ object *args;
+ int nargs, i;
+ short *p_arg;
+{
+ long x;
+ if (!getilongarraysize(args, nargs, i, &x))
+ return 0;
+ *p_arg = x;
+ return 1;
+}
+
+/* XXX The following four are too similar. Should share more code. */
+
+int
+getilongarray(args, nargs, i, n, p_arg)
+ object *args;
+ int nargs, i;
+ int n;
+ long *p_arg; /* [n] */
+{
+ object *v, *w;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (is_tupleobject(v)) {
+ if (gettuplesize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = gettupleitem(v, i);
+ if (!is_intobject(w)) {
+ return err_badarg();
+ }
+ p_arg[i] = getintvalue(w);
+ }
+ return 1;
+ }
+ else if (is_listobject(v)) {
+ if (getlistsize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = getlistitem(v, i);
+ if (!is_intobject(w)) {
+ return err_badarg();
+ }
+ p_arg[i] = getintvalue(w);
+ }
+ return 1;
+ }
+ else {
+ return err_badarg();
+ }
+}
+
+int
+getishortarray(args, nargs, i, n, p_arg)
+ object *args;
+ int nargs, i;
+ int n;
+ short *p_arg; /* [n] */
+{
+ object *v, *w;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (is_tupleobject(v)) {
+ if (gettuplesize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = gettupleitem(v, i);
+ if (!is_intobject(w)) {
+ return err_badarg();
+ }
+ p_arg[i] = getintvalue(w);
+ }
+ return 1;
+ }
+ else if (is_listobject(v)) {
+ if (getlistsize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = getlistitem(v, i);
+ if (!is_intobject(w)) {
+ return err_badarg();
+ }
+ p_arg[i] = getintvalue(w);
+ }
+ return 1;
+ }
+ else {
+ return err_badarg();
+ }
+}
+
+int
+getidoublearray(args, nargs, i, n, p_arg)
+ object *args;
+ int nargs, i;
+ int n;
+ double *p_arg; /* [n] */
+{
+ object *v, *w;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (is_tupleobject(v)) {
+ if (gettuplesize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = gettupleitem(v, i);
+ if (!extractdouble(w, &p_arg[i]))
+ return 0;
+ }
+ return 1;
+ }
+ else if (is_listobject(v)) {
+ if (getlistsize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = getlistitem(v, i);
+ if (!extractdouble(w, &p_arg[i]))
+ return 0;
+ }
+ return 1;
+ }
+ else {
+ return err_badarg();
+ }
+}
+
+int
+getifloatarray(args, nargs, i, n, p_arg)
+ object *args;
+ int nargs, i;
+ int n;
+ float *p_arg; /* [n] */
+{
+ object *v, *w;
+ if (!getiobjectarg(args, nargs, i, &v))
+ return 0;
+ if (is_tupleobject(v)) {
+ if (gettuplesize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = gettupleitem(v, i);
+ if (!extractfloat(w, &p_arg[i]))
+ return 0;
+ }
+ return 1;
+ }
+ else if (is_listobject(v)) {
+ if (getlistsize(v) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ w = getlistitem(v, i);
+ if (!extractfloat(w, &p_arg[i]))
+ return 0;
+ }
+ return 1;
+ }
+ else {
+ return err_badarg();
+ }
+}
diff --git a/src/cgensupport.h b/src/cgensupport.h
new file mode 100644
index 0000000..a056f5d
--- /dev/null
+++ b/src/cgensupport.h
@@ -0,0 +1,39 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Definitions used by cgen output */
+
+typedef char *string;
+
+#define mknewlongobject(x) newintobject(x)
+#define mknewshortobject(x) newintobject((long)x)
+#define mknewfloatobject(x) newfloatobject(x)
+
+extern object *mknewcharobject PROTO((int c));
+
+extern int getiobjectarg PROTO((object *args, int nargs, int i, object **p_a));
+extern int getilongarg PROTO((object *args, int nargs, int i, long *p_a));
+extern int getishortarg PROTO((object *args, int nargs, int i, short *p_a));
+extern int getifloatarg PROTO((object *args, int nargs, int i, float *p_a));
+extern int getistringarg PROTO((object *args, int nargs, int i, string *p_a));
diff --git a/src/classobject.c b/src/classobject.c
new file mode 100644
index 0000000..fc32889
--- /dev/null
+++ b/src/classobject.c
@@ -0,0 +1,298 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Class object implementation */
+
+#include "allobjects.h"
+
+#include "structmember.h"
+
+typedef struct {
+ OB_HEAD
+ object *cl_bases; /* A tuple */
+ object *cl_methods; /* A dictionary */
+} classobject;
+
+object *
+newclassobject(bases, methods)
+ object *bases; /* NULL or tuple of classobjects! */
+ object *methods;
+{
+ classobject *op;
+ op = NEWOBJ(classobject, &Classtype);
+ if (op == NULL)
+ return NULL;
+ if (bases != NULL)
+ INCREF(bases);
+ op->cl_bases = bases;
+ INCREF(methods);
+ op->cl_methods = methods;
+ return (object *) op;
+}
+
+/* Class methods */
+
+static void
+class_dealloc(op)
+ classobject *op;
+{
+ int i;
+ if (op->cl_bases != NULL)
+ DECREF(op->cl_bases);
+ DECREF(op->cl_methods);
+ free((ANY *)op);
+}
+
+static object *
+class_getattr(op, name)
+ register classobject *op;
+ register char *name;
+{
+ register object *v;
+ v = dictlookup(op->cl_methods, name);
+ if (v != NULL) {
+ INCREF(v);
+ return v;
+ }
+ if (op->cl_bases != NULL) {
+ int n = gettuplesize(op->cl_bases);
+ int i;
+ for (i = 0; i < n; i++) {
+ v = class_getattr(gettupleitem(op->cl_bases, i), name);
+ if (v != NULL)
+ return v;
+ err_clear();
+ }
+ }
+ err_setstr(NameError, name);
+ return NULL;
+}
+
+typeobject Classtype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "class",
+ sizeof(classobject),
+ 0,
+ class_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ class_getattr, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
+
+
+/* We're not done yet: next, we define class member objects... */
+
+typedef struct {
+ OB_HEAD
+ classobject *cm_class; /* The class object */
+ object *cm_attr; /* A dictionary */
+} classmemberobject;
+
+object *
+newclassmemberobject(class)
+ register object *class;
+{
+ register classmemberobject *cm;
+ if (!is_classobject(class)) {
+ err_badcall();
+ return NULL;
+ }
+ cm = NEWOBJ(classmemberobject, &Classmembertype);
+ if (cm == NULL)
+ return NULL;
+ INCREF(class);
+ cm->cm_class = (classobject *)class;
+ cm->cm_attr = newdictobject();
+ if (cm->cm_attr == NULL) {
+ DECREF(cm);
+ return NULL;
+ }
+ return (object *)cm;
+}
+
+/* Class member methods */
+
+static void
+classmember_dealloc(cm)
+ register classmemberobject *cm;
+{
+ DECREF(cm->cm_class);
+ if (cm->cm_attr != NULL)
+ DECREF(cm->cm_attr);
+ free((ANY *)cm);
+}
+
+static object *
+classmember_getattr(cm, name)
+ register classmemberobject *cm;
+ register char *name;
+{
+ register object *v = dictlookup(cm->cm_attr, name);
+ if (v != NULL) {
+ INCREF(v);
+ return v;
+ }
+ v = class_getattr(cm->cm_class, name);
+ if (v == NULL)
+ return v; /* class_getattr() has set the error */
+ if (is_funcobject(v)) {
+ object *w = newclassmethodobject(v, (object *)cm);
+ DECREF(v);
+ return w;
+ }
+ DECREF(v);
+ err_setstr(NameError, name);
+ return NULL;
+}
+
+static int
+classmember_setattr(cm, name, v)
+ classmemberobject *cm;
+ char *name;
+ object *v;
+{
+ if (v == NULL)
+ return dictremove(cm->cm_attr, name);
+ else
+ return dictinsert(cm->cm_attr, name, v);
+}
+
+typeobject Classmembertype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "class member",
+ sizeof(classmemberobject),
+ 0,
+ classmember_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ classmember_getattr, /*tp_getattr*/
+ classmember_setattr, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
+
+
+/* And finally, here are class method objects */
+/* (Really methods of class members) */
+
+typedef struct {
+ OB_HEAD
+ object *cm_func; /* The method function */
+ object *cm_self; /* The object to which this applies */
+} classmethodobject;
+
+object *
+newclassmethodobject(func, self)
+ object *func;
+ object *self;
+{
+ register classmethodobject *cm;
+ if (!is_funcobject(func)) {
+ err_badcall();
+ return NULL;
+ }
+ cm = NEWOBJ(classmethodobject, &Classmethodtype);
+ if (cm == NULL)
+ return NULL;
+ INCREF(func);
+ cm->cm_func = func;
+ INCREF(self);
+ cm->cm_self = self;
+ return (object *)cm;
+}
+
+object *
+classmethodgetfunc(cm)
+ register object *cm;
+{
+ if (!is_classmethodobject(cm)) {
+ err_badcall();
+ return NULL;
+ }
+ return ((classmethodobject *)cm)->cm_func;
+}
+
+object *
+classmethodgetself(cm)
+ register object *cm;
+{
+ if (!is_classmethodobject(cm)) {
+ err_badcall();
+ return NULL;
+ }
+ return ((classmethodobject *)cm)->cm_self;
+}
+
+/* Class method methods */
+
+#define OFF(x) offsetof(classmethodobject, x)
+
+static struct memberlist classmethod_memberlist[] = {
+ {"cm_func", T_OBJECT, OFF(cm_func)},
+ {"cm_self", T_OBJECT, OFF(cm_self)},
+ {NULL} /* Sentinel */
+};
+
+static object *
+classmethod_getattr(cm, name)
+ register classmethodobject *cm;
+ char *name;
+{
+ return getmember((char *)cm, classmethod_memberlist, name);
+}
+
+static void
+classmethod_dealloc(cm)
+ register classmethodobject *cm;
+{
+ DECREF(cm->cm_func);
+ DECREF(cm->cm_self);
+ free((ANY *)cm);
+}
+
+typeobject Classmethodtype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "class method",
+ sizeof(classmethodobject),
+ 0,
+ classmethod_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ classmethod_getattr, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
diff --git a/src/classobject.h b/src/classobject.h
new file mode 100644
index 0000000..49db837
--- /dev/null
+++ b/src/classobject.h
@@ -0,0 +1,44 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Class object interface */
+
+/*
+Classes are really hacked in at the last moment.
+It should be possible to use other object types as base classes,
+but currently it isn't. We'll see if we can fix that later, sigh...
+*/
+
+extern typeobject Classtype, Classmembertype, Classmethodtype;
+
+#define is_classobject(op) ((op)->ob_type == &Classtype)
+#define is_classmemberobject(op) ((op)->ob_type == &Classmembertype)
+#define is_classmethodobject(op) ((op)->ob_type == &Classmethodtype)
+
+extern object *newclassobject PROTO((object *, object *));
+extern object *newclassmemberobject PROTO((object *));
+extern object *newclassmethodobject PROTO((object *, object *));
+
+extern object *classmethodgetfunc PROTO((object *));
+extern object *classmethodgetself PROTO((object *));
diff --git a/src/compile.c b/src/compile.c
new file mode 100644
index 0000000..7904dba
--- /dev/null
+++ b/src/compile.c
@@ -0,0 +1,1772 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Compile an expression node to intermediate code */
+
+/* XXX TO DO:
+ XXX Compute maximum needed stack sizes while compiling
+ XXX Generate simple jump for break/return outside 'try...finally'
+ XXX Include function name in code (and module names?)
+*/
+
+#include "allobjects.h"
+
+#include "node.h"
+#include "token.h"
+#include "graminit.h"
+#include "compile.h"
+#include "opcode.h"
+#include "structmember.h"
+
+#include <ctype.h>
+
+#define OFF(x) offsetof(codeobject, x)
+
+static struct memberlist code_memberlist[] = {
+ {"co_code", T_OBJECT, OFF(co_code)},
+ {"co_consts", T_OBJECT, OFF(co_consts)},
+ {"co_names", T_OBJECT, OFF(co_names)},
+ {"co_filename", T_OBJECT, OFF(co_filename)},
+ {NULL} /* Sentinel */
+};
+
+static object *
+code_getattr(co, name)
+ codeobject *co;
+ char *name;
+{
+ return getmember((char *)co, code_memberlist, name);
+}
+
+static void
+code_dealloc(co)
+ codeobject *co;
+{
+ XDECREF(co->co_code);
+ XDECREF(co->co_consts);
+ XDECREF(co->co_names);
+ XDECREF(co->co_filename);
+ DEL(co);
+}
+
+typeobject Codetype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "code",
+ sizeof(codeobject),
+ 0,
+ code_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ code_getattr, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
+
+static codeobject *newcodeobject PROTO((object *, object *, object *, char *));
+
+static codeobject *
+newcodeobject(code, consts, names, filename)
+ object *code;
+ object *consts;
+ object *names;
+ char *filename;
+{
+ codeobject *co;
+ int i;
+ /* Check argument types */
+ if (code == NULL || !is_stringobject(code) ||
+ consts == NULL || !is_listobject(consts) ||
+ names == NULL || !is_listobject(names)) {
+ err_badcall();
+ return NULL;
+ }
+ /* Make sure the list of names contains only strings */
+ for (i = getlistsize(names); --i >= 0; ) {
+ object *v = getlistitem(names, i);
+ if (v == NULL || !is_stringobject(v)) {
+ err_badcall();
+ return NULL;
+ }
+ }
+ co = NEWOBJ(codeobject, &Codetype);
+ if (co != NULL) {
+ INCREF(code);
+ co->co_code = (stringobject *)code;
+ INCREF(consts);
+ co->co_consts = consts;
+ INCREF(names);
+ co->co_names = names;
+ if ((co->co_filename = newstringobject(filename)) == NULL) {
+ DECREF(co);
+ co = NULL;
+ }
+ }
+ return co;
+}
+
+
+/* Data structure used internally */
+struct compiling {
+ object *c_code; /* string */
+ object *c_consts; /* list of objects */
+ object *c_names; /* list of strings (names) */
+ int c_nexti; /* index into c_code */
+ int c_errors; /* counts errors occurred */
+ int c_infunction; /* set when compiling a function */
+ int c_loops; /* counts nested loops */
+ char *c_filename; /* filename of current node */
+};
+
+/* Prototypes */
+static int com_init PROTO((struct compiling *, char *));
+static void com_free PROTO((struct compiling *));
+static void com_done PROTO((struct compiling *));
+static void com_node PROTO((struct compiling *, struct _node *));
+static void com_addbyte PROTO((struct compiling *, int));
+static void com_addint PROTO((struct compiling *, int));
+static void com_addoparg PROTO((struct compiling *, int, int));
+static void com_addfwref PROTO((struct compiling *, int, int *));
+static void com_backpatch PROTO((struct compiling *, int));
+static int com_add PROTO((struct compiling *, object *, object *));
+static int com_addconst PROTO((struct compiling *, object *));
+static int com_addname PROTO((struct compiling *, object *));
+static void com_addopname PROTO((struct compiling *, int, node *));
+
+static int
+com_init(c, filename)
+ struct compiling *c;
+ char *filename;
+{
+ if ((c->c_code = newsizedstringobject((char *)NULL, 0)) == NULL)
+ goto fail_3;
+ if ((c->c_consts = newlistobject(0)) == NULL)
+ goto fail_2;
+ if ((c->c_names = newlistobject(0)) == NULL)
+ goto fail_1;
+ c->c_nexti = 0;
+ c->c_errors = 0;
+ c->c_infunction = 0;
+ c->c_loops = 0;
+ c->c_filename = filename;
+ return 1;
+
+ fail_1:
+ DECREF(c->c_consts);
+ fail_2:
+ DECREF(c->c_code);
+ fail_3:
+ return 0;
+}
+
+static void
+com_free(c)
+ struct compiling *c;
+{
+ XDECREF(c->c_code);
+ XDECREF(c->c_consts);
+ XDECREF(c->c_names);
+}
+
+static void
+com_done(c)
+ struct compiling *c;
+{
+ if (c->c_code != NULL)
+ resizestring(&c->c_code, c->c_nexti);
+}
+
+static void
+com_addbyte(c, byte)
+ struct compiling *c;
+ int byte;
+{
+ int len;
+ if (byte < 0 || byte > 255) {
+ fprintf(stderr, "XXX compiling bad byte: %d\n", byte);
+ abort();
+ err_setstr(SystemError, "com_addbyte: byte out of range");
+ c->c_errors++;
+ }
+ if (c->c_code == NULL)
+ return;
+ len = getstringsize(c->c_code);
+ if (c->c_nexti >= len) {
+ if (resizestring(&c->c_code, len+1000) != 0) {
+ c->c_errors++;
+ return;
+ }
+ }
+ getstringvalue(c->c_code)[c->c_nexti++] = byte;
+}
+
+static void
+com_addint(c, x)
+ struct compiling *c;
+ int x;
+{
+ com_addbyte(c, x & 0xff);
+ com_addbyte(c, x >> 8); /* XXX x should be positive */
+}
+
+static void
+com_addoparg(c, op, arg)
+ struct compiling *c;
+ int op;
+ int arg;
+{
+ com_addbyte(c, op);
+ com_addint(c, arg);
+}
+
+static void
+com_addfwref(c, op, p_anchor)
+ struct compiling *c;
+ int op;
+ int *p_anchor;
+{
+ /* Compile a forward reference for backpatching */
+ int here;
+ int anchor;
+ com_addbyte(c, op);
+ here = c->c_nexti;
+ anchor = *p_anchor;
+ *p_anchor = here;
+ com_addint(c, anchor == 0 ? 0 : here - anchor);
+}
+
+static void
+com_backpatch(c, anchor)
+ struct compiling *c;
+ int anchor; /* Must be nonzero */
+{
+ unsigned char *code = (unsigned char *) getstringvalue(c->c_code);
+ int target = c->c_nexti;
+ int lastanchor = 0;
+ int dist;
+ int prev;
+ for (;;) {
+ /* Make the JUMP instruction at anchor point to target */
+ prev = code[anchor] + (code[anchor+1] << 8);
+ dist = target - (anchor+2);
+ code[anchor] = dist & 0xff;
+ code[anchor+1] = dist >> 8;
+ if (!prev)
+ break;
+ lastanchor = anchor;
+ anchor -= prev;
+ }
+}
+
+/* Handle constants and names uniformly */
+
+static int
+com_add(c, list, v)
+ struct compiling *c;
+ object *list;
+ object *v;
+{
+ int n = getlistsize(list);
+ int i;
+ for (i = n; --i >= 0; ) {
+ object *w = getlistitem(list, i);
+ if (cmpobject(v, w) == 0)
+ return i;
+ }
+ if (addlistitem(list, v) != 0)
+ c->c_errors++;
+ return n;
+}
+
+static int
+com_addconst(c, v)
+ struct compiling *c;
+ object *v;
+{
+ return com_add(c, c->c_consts, v);
+}
+
+static int
+com_addname(c, v)
+ struct compiling *c;
+ object *v;
+{
+ return com_add(c, c->c_names, v);
+}
+
+static void
+com_addopname(c, op, n)
+ struct compiling *c;
+ int op;
+ node *n;
+{
+ object *v;
+ int i;
+ char *name;
+ if (TYPE(n) == STAR)
+ name = "*";
+ else {
+ REQ(n, NAME);
+ name = STR(n);
+ }
+ if ((v = newstringobject(name)) == NULL) {
+ c->c_errors++;
+ i = 255;
+ }
+ else {
+ i = com_addname(c, v);
+ DECREF(v);
+ }
+ com_addoparg(c, op, i);
+}
+
+static object *
+parsenumber(s)
+ char *s;
+{
+ extern long strtol();
+ extern double atof();
+ char *end = s;
+ long x;
+ x = strtol(s, &end, 0);
+ if (*end == '\0')
+ return newintobject(x);
+ if (*end == '.' || *end == 'e' || *end == 'E')
+ return newfloatobject(atof(s));
+ err_setstr(RuntimeError, "bad number syntax");
+ return NULL;
+}
+
+static object *
+parsestr(s)
+ char *s;
+{
+ object *v;
+ int len;
+ char *buf;
+ char *p;
+ int c;
+ if (*s != '\'') {
+ err_badcall();
+ return NULL;
+ }
+ s++;
+ len = strlen(s);
+ if (s[--len] != '\'') {
+ err_badcall();
+ return NULL;
+ }
+ if (strchr(s, '\\') == NULL)
+ return newsizedstringobject(s, len);
+ v = newsizedstringobject((char *)NULL, len);
+ p = buf = getstringvalue(v);
+ while (*s != '\0' && *s != '\'') {
+ if (*s != '\\') {
+ *p++ = *s++;
+ continue;
+ }
+ s++;
+ switch (*s++) {
+ /* XXX This assumes ASCII! */
+ case '\\': *p++ = '\\'; break;
+ case '\'': *p++ = '\''; break;
+ case 'b': *p++ = '\b'; break;
+ case 'f': *p++ = '\014'; break; /* FF */
+ case 't': *p++ = '\t'; break;
+ case 'n': *p++ = '\n'; break;
+ case 'r': *p++ = '\r'; break;
+ case 'v': *p++ = '\013'; break; /* VT */
+ case 'E': *p++ = '\033'; break; /* ESC, not C */
+ case 'a': *p++ = '\007'; break; /* BEL, not classic C */
+ case '0': case '1': case '2': case '3':
+ case '4': case '5': case '6': case '7':
+ c = s[-1] - '0';
+ if ('0' <= *s && *s <= '7') {
+ c = (c<<3) + *s++ - '0';
+ if ('0' <= *s && *s <= '7')
+ c = (c<<3) + *s++ - '0';
+ }
+ *p++ = c;
+ break;
+ case 'x':
+ if (isxdigit(*s)) {
+ sscanf(s, "%x", &c);
+ *p++ = c;
+ do {
+ s++;
+ } while (isxdigit(*s));
+ break;
+ }
+ /* FALLTHROUGH */
+ default: *p++ = '\\'; *p++ = s[-1]; break;
+ }
+ }
+ resizestring(&v, (int)(p - buf));
+ return v;
+}
+
+static void
+com_list_constructor(c, n)
+ struct compiling *c;
+ node *n;
+{
+ int len;
+ int i;
+ object *v, *w;
+ if (TYPE(n) != testlist)
+ REQ(n, exprlist);
+ /* exprlist: expr (',' expr)* [',']; likewise for testlist */
+ len = (NCH(n) + 1) / 2;
+ for (i = 0; i < NCH(n); i += 2)
+ com_node(c, CHILD(n, i));
+ com_addoparg(c, BUILD_LIST, len);
+}
+
+static void
+com_atom(c, n)
+ struct compiling *c;
+ node *n;
+{
+ node *ch;
+ object *v;
+ int i;
+ REQ(n, atom);
+ ch = CHILD(n, 0);
+ switch (TYPE(ch)) {
+ case LPAR:
+ if (TYPE(CHILD(n, 1)) == RPAR)
+ com_addoparg(c, BUILD_TUPLE, 0);
+ else
+ com_node(c, CHILD(n, 1));
+ break;
+ case LSQB:
+ if (TYPE(CHILD(n, 1)) == RSQB)
+ com_addoparg(c, BUILD_LIST, 0);
+ else
+ com_list_constructor(c, CHILD(n, 1));
+ break;
+ case LBRACE:
+ com_addoparg(c, BUILD_MAP, 0);
+ break;
+ case BACKQUOTE:
+ com_node(c, CHILD(n, 1));
+ com_addbyte(c, UNARY_CONVERT);
+ break;
+ case NUMBER:
+ if ((v = parsenumber(STR(ch))) == NULL) {
+ c->c_errors++;
+ i = 255;
+ }
+ else {
+ i = com_addconst(c, v);
+ DECREF(v);
+ }
+ com_addoparg(c, LOAD_CONST, i);
+ break;
+ case STRING:
+ if ((v = parsestr(STR(ch))) == NULL) {
+ c->c_errors++;
+ i = 255;
+ }
+ else {
+ i = com_addconst(c, v);
+ DECREF(v);
+ }
+ com_addoparg(c, LOAD_CONST, i);
+ break;
+ case NAME:
+ com_addopname(c, LOAD_NAME, ch);
+ break;
+ default:
+ fprintf(stderr, "node type %d\n", TYPE(ch));
+ err_setstr(SystemError, "com_atom: unexpected node type");
+ c->c_errors++;
+ }
+}
+
+static void
+com_slice(c, n, op)
+ struct compiling *c;
+ node *n;
+ int op;
+{
+ if (NCH(n) == 1) {
+ com_addbyte(c, op);
+ }
+ else if (NCH(n) == 2) {
+ if (TYPE(CHILD(n, 0)) != COLON) {
+ com_node(c, CHILD(n, 0));
+ com_addbyte(c, op+1);
+ }
+ else {
+ com_node(c, CHILD(n, 1));
+ com_addbyte(c, op+2);
+ }
+ }
+ else {
+ com_node(c, CHILD(n, 0));
+ com_node(c, CHILD(n, 2));
+ com_addbyte(c, op+3);
+ }
+}
+
+static void
+com_apply_subscript(c, n)
+ struct compiling *c;
+ node *n;
+{
+ REQ(n, subscript);
+ if (NCH(n) == 1 && TYPE(CHILD(n, 0)) != COLON) {
+ /* It's a single subscript */
+ com_node(c, CHILD(n, 0));
+ com_addbyte(c, BINARY_SUBSCR);
+ }
+ else {
+ /* It's a slice: [expr] ':' [expr] */
+ com_slice(c, n, SLICE);
+ }
+}
+
+static void
+com_call_function(c, n)
+ struct compiling *c;
+ node *n; /* EITHER testlist OR ')' */
+{
+ if (TYPE(n) == RPAR) {
+ com_addbyte(c, UNARY_CALL);
+ }
+ else {
+ com_node(c, n);
+ com_addbyte(c, BINARY_CALL);
+ }
+}
+
+static void
+com_select_member(c, n)
+ struct compiling *c;
+ node *n;
+{
+ com_addopname(c, LOAD_ATTR, n);
+}
+
+static void
+com_apply_trailer(c, n)
+ struct compiling *c;
+ node *n;
+{
+ REQ(n, trailer);
+ switch (TYPE(CHILD(n, 0))) {
+ case LPAR:
+ com_call_function(c, CHILD(n, 1));
+ break;
+ case DOT:
+ com_select_member(c, CHILD(n, 1));
+ break;
+ case LSQB:
+ com_apply_subscript(c, CHILD(n, 1));
+ break;
+ default:
+ err_setstr(SystemError,
+ "com_apply_trailer: unknown trailer type");
+ c->c_errors++;
+ }
+}
+
+static void
+com_factor(c, n)
+ struct compiling *c;
+ node *n;
+{
+ int i;
+ REQ(n, factor);
+ if (TYPE(CHILD(n, 0)) == PLUS) {
+ com_factor(c, CHILD(n, 1));
+ com_addbyte(c, UNARY_POSITIVE);
+ }
+ else if (TYPE(CHILD(n, 0)) == MINUS) {
+ com_factor(c, CHILD(n, 1));
+ com_addbyte(c, UNARY_NEGATIVE);
+ }
+ else {
+ com_atom(c, CHILD(n, 0));
+ for (i = 1; i < NCH(n); i++)
+ com_apply_trailer(c, CHILD(n, i));
+ }
+}
+
+static void
+com_term(c, n)
+ struct compiling *c;
+ node *n;
+{
+ int i;
+ int op;
+ REQ(n, term);
+ com_factor(c, CHILD(n, 0));
+ for (i = 2; i < NCH(n); i += 2) {
+ com_factor(c, CHILD(n, i));
+ switch (TYPE(CHILD(n, i-1))) {
+ case STAR:
+ op = BINARY_MULTIPLY;
+ break;
+ case SLASH:
+ op = BINARY_DIVIDE;
+ break;
+ case PERCENT:
+ op = BINARY_MODULO;
+ break;
+ default:
+ err_setstr(SystemError,
+ "com_term: term operator not *, / or %");
+ c->c_errors++;
+ op = 255;
+ }
+ com_addbyte(c, op);
+ }
+}
+
+static void
+com_expr(c, n)
+ struct compiling *c;
+ node *n;
+{
+ int i;
+ int op;
+ REQ(n, expr);
+ com_term(c, CHILD(n, 0));
+ for (i = 2; i < NCH(n); i += 2) {
+ com_term(c, CHILD(n, i));
+ switch (TYPE(CHILD(n, i-1))) {
+ case PLUS:
+ op = BINARY_ADD;
+ break;
+ case MINUS:
+ op = BINARY_SUBTRACT;
+ break;
+ default:
+ err_setstr(SystemError,
+ "com_expr: expr operator not + or -");
+ c->c_errors++;
+ op = 255;
+ }
+ com_addbyte(c, op);
+ }
+}
+
+static enum cmp_op
+cmp_type(n)
+ node *n;
+{
+ REQ(n, comp_op);
+ /* comp_op: '<' | '>' | '=' | '>' '=' | '<' '=' | '<' '>'
+ | 'in' | 'not' 'in' | 'is' | 'is' not' */
+ if (NCH(n) == 1) {
+ n = CHILD(n, 0);
+ switch (TYPE(n)) {
+ case LESS: return LT;
+ case GREATER: return GT;
+ case EQUAL: return EQ;
+ case NAME: if (strcmp(STR(n), "in") == 0) return IN;
+ if (strcmp(STR(n), "is") == 0) return IS;
+ }
+ }
+ else if (NCH(n) == 2) {
+ int t2 = TYPE(CHILD(n, 1));
+ switch (TYPE(CHILD(n, 0))) {
+ case LESS: if (t2 == EQUAL) return LE;
+ if (t2 == GREATER) return NE;
+ break;
+ case GREATER: if (t2 == EQUAL) return GE;
+ break;
+ case NAME: if (strcmp(STR(CHILD(n, 1)), "in") == 0)
+ return NOT_IN;
+ if (strcmp(STR(CHILD(n, 0)), "is") == 0)
+ return IS_NOT;
+ }
+ }
+ return BAD;
+}
+
+static void
+com_comparison(c, n)
+ struct compiling *c;
+ node *n;
+{
+ int i;
+ enum cmp_op op;
+ int anchor;
+ REQ(n, comparison); /* comparison: expr (comp_op expr)* */
+ com_expr(c, CHILD(n, 0));
+ if (NCH(n) == 1)
+ return;
+
+ /****************************************************************
+ The following code is generated for all but the last
+ comparison in a chain:
+
+ label: on stack: opcode: jump to:
+
+ a <code to load b>
+ a, b DUP_TOP
+ a, b, b ROT_THREE
+ b, a, b COMPARE_OP
+ b, 0-or-1 JUMP_IF_FALSE L1
+ b, 1 POP_TOP
+ b
+
+ We are now ready to repeat this sequence for the next
+ comparison in the chain.
+
+ For the last we generate:
+
+ b <code to load c>
+ b, c COMPARE_OP
+ 0-or-1
+
+ If there were any jumps to L1 (i.e., there was more than one
+ comparison), we generate:
+
+ 0-or-1 JUMP_FORWARD L2
+ L1: b, 0 ROT_TWO
+ 0, b POP_TOP
+ 0
+ L2:
+ ****************************************************************/
+
+ anchor = 0;
+
+ for (i = 2; i < NCH(n); i += 2) {
+ com_expr(c, CHILD(n, i));
+ if (i+2 < NCH(n)) {
+ com_addbyte(c, DUP_TOP);
+ com_addbyte(c, ROT_THREE);
+ }
+ op = cmp_type(CHILD(n, i-1));
+ if (op == BAD) {
+ err_setstr(SystemError,
+ "com_comparison: unknown comparison op");
+ c->c_errors++;
+ }
+ com_addoparg(c, COMPARE_OP, op);
+ if (i+2 < NCH(n)) {
+ com_addfwref(c, JUMP_IF_FALSE, &anchor);
+ com_addbyte(c, POP_TOP);
+ }
+ }
+
+ if (anchor) {
+ int anchor2 = 0;
+ com_addfwref(c, JUMP_FORWARD, &anchor2);
+ com_backpatch(c, anchor);
+ com_addbyte(c, ROT_TWO);
+ com_addbyte(c, POP_TOP);
+ com_backpatch(c, anchor2);
+ }
+}
+
+static void
+com_not_test(c, n)
+ struct compiling *c;
+ node *n;
+{
+ REQ(n, not_test); /* 'not' not_test | comparison */
+ if (NCH(n) == 1) {
+ com_comparison(c, CHILD(n, 0));
+ }
+ else {
+ com_not_test(c, CHILD(n, 1));
+ com_addbyte(c, UNARY_NOT);
+ }
+}
+
+static void
+com_and_test(c, n)
+ struct compiling *c;
+ node *n;
+{
+ int i;
+ int anchor;
+ REQ(n, and_test); /* not_test ('and' not_test)* */
+ anchor = 0;
+ i = 0;
+ for (;;) {
+ com_not_test(c, CHILD(n, i));
+ if ((i += 2) >= NCH(n))
+ break;
+ com_addfwref(c, JUMP_IF_FALSE, &anchor);
+ com_addbyte(c, POP_TOP);
+ }
+ if (anchor)
+ com_backpatch(c, anchor);
+}
+
+static void
+com_test(c, n)
+ struct compiling *c;
+ node *n;
+{
+ int i;
+ int anchor;
+ REQ(n, test); /* and_test ('and' and_test)* */
+ anchor = 0;
+ i = 0;
+ for (;;) {
+ com_and_test(c, CHILD(n, i));
+ if ((i += 2) >= NCH(n))
+ break;
+ com_addfwref(c, JUMP_IF_TRUE, &anchor);
+ com_addbyte(c, POP_TOP);
+ }
+ if (anchor)
+ com_backpatch(c, anchor);
+}
+
+static void
+com_list(c, n)
+ struct compiling *c;
+ node *n;
+{
+ /* exprlist: expr (',' expr)* [',']; likewise for testlist */
+ if (NCH(n) == 1) {
+ com_node(c, CHILD(n, 0));
+ }
+ else {
+ int i;
+ int len;
+ len = (NCH(n) + 1) / 2;
+ for (i = 0; i < NCH(n); i += 2)
+ com_node(c, CHILD(n, i));
+ com_addoparg(c, BUILD_TUPLE, len);
+ }
+}
+
+
+/* Begin of assignment compilation */
+
+static void com_assign_name PROTO((struct compiling *, node *, int));
+static void com_assign PROTO((struct compiling *, node *, int));
+
+static void
+com_assign_attr(c, n, assigning)
+ struct compiling *c;
+ node *n;
+ int assigning;
+{
+ com_addopname(c, assigning ? STORE_ATTR : DELETE_ATTR, n);
+}
+
+static void
+com_assign_slice(c, n, assigning)
+ struct compiling *c;
+ node *n;
+ int assigning;
+{
+ com_slice(c, n, assigning ? STORE_SLICE : DELETE_SLICE);
+}
+
+static void
+com_assign_subscript(c, n, assigning)
+ struct compiling *c;
+ node *n;
+ int assigning;
+{
+ com_node(c, n);
+ com_addbyte(c, assigning ? STORE_SUBSCR : DELETE_SUBSCR);
+}
+
+static void
+com_assign_trailer(c, n, assigning)
+ struct compiling *c;
+ node *n;
+ int assigning;
+{
+ char *name;
+ REQ(n, trailer);
+ switch (TYPE(CHILD(n, 0))) {
+ case LPAR: /* '(' [exprlist] ')' */
+ err_setstr(TypeError, "can't assign to function call");
+ c->c_errors++;
+ break;
+ case DOT: /* '.' NAME */
+ com_assign_attr(c, CHILD(n, 1), assigning);
+ break;
+ case LSQB: /* '[' subscript ']' */
+ n = CHILD(n, 1);
+ REQ(n, subscript); /* subscript: expr | [expr] ':' [expr] */
+ if (NCH(n) > 1 || TYPE(CHILD(n, 0)) == COLON)
+ com_assign_slice(c, n, assigning);
+ else
+ com_assign_subscript(c, CHILD(n, 0), assigning);
+ break;
+ default:
+ err_setstr(TypeError, "unknown trailer type");
+ c->c_errors++;
+ }
+}
+
+static void
+com_assign_tuple(c, n, assigning)
+ struct compiling *c;
+ node *n;
+ int assigning;
+{
+ int i;
+ if (TYPE(n) != testlist)
+ REQ(n, exprlist);
+ if (assigning)
+ com_addoparg(c, UNPACK_TUPLE, (NCH(n)+1)/2);
+ for (i = 0; i < NCH(n); i += 2)
+ com_assign(c, CHILD(n, i), assigning);
+}
+
+static void
+com_assign_list(c, n, assigning)
+ struct compiling *c;
+ node *n;
+ int assigning;
+{
+ int i;
+ if (assigning)
+ com_addoparg(c, UNPACK_LIST, (NCH(n)+1)/2);
+ for (i = 0; i < NCH(n); i += 2)
+ com_assign(c, CHILD(n, i), assigning);
+}
+
+static void
+com_assign_name(c, n, assigning)
+ struct compiling *c;
+ node *n;
+ int assigning;
+{
+ REQ(n, NAME);
+ com_addopname(c, assigning ? STORE_NAME : DELETE_NAME, n);
+}
+
+static void
+com_assign(c, n, assigning)
+ struct compiling *c;
+ node *n;
+ int assigning;
+{
+ /* Loop to avoid trivial recursion */
+ for (;;) {
+ switch (TYPE(n)) {
+
+ case exprlist:
+ case testlist:
+ if (NCH(n) > 1) {
+ com_assign_tuple(c, n, assigning);
+ return;
+ }
+ n = CHILD(n, 0);
+ break;
+
+ case test:
+ case and_test:
+ case not_test:
+ if (NCH(n) > 1) {
+ err_setstr(TypeError,
+ "can't assign to operator");
+ c->c_errors++;
+ return;
+ }
+ n = CHILD(n, 0);
+ break;
+
+ case comparison:
+ if (NCH(n) > 1) {
+ err_setstr(TypeError,
+ "can't assign to operator");
+ c->c_errors++;
+ return;
+ }
+ n = CHILD(n, 0);
+ break;
+
+ case expr:
+ if (NCH(n) > 1) {
+ err_setstr(TypeError,
+ "can't assign to operator");
+ c->c_errors++;
+ return;
+ }
+ n = CHILD(n, 0);
+ break;
+
+ case term:
+ if (NCH(n) > 1) {
+ err_setstr(TypeError,
+ "can't assign to operator");
+ c->c_errors++;
+ return;
+ }
+ n = CHILD(n, 0);
+ break;
+
+ case factor: /* ('+'|'-') factor | atom trailer* */
+ if (TYPE(CHILD(n, 0)) != atom) { /* '+' | '-' */
+ err_setstr(TypeError,
+ "can't assign to operator");
+ c->c_errors++;
+ return;
+ }
+ if (NCH(n) > 1) { /* trailer present */
+ int i;
+ com_node(c, CHILD(n, 0));
+ for (i = 1; i+1 < NCH(n); i++) {
+ com_apply_trailer(c, CHILD(n, i));
+ } /* NB i is still alive */
+ com_assign_trailer(c,
+ CHILD(n, i), assigning);
+ return;
+ }
+ n = CHILD(n, 0);
+ break;
+
+ case atom:
+ switch (TYPE(CHILD(n, 0))) {
+ case LPAR:
+ n = CHILD(n, 1);
+ if (TYPE(n) == RPAR) {
+ /* XXX Should allow () = () ??? */
+ err_setstr(TypeError,
+ "can't assign to ()");
+ c->c_errors++;
+ return;
+ }
+ break;
+ case LSQB:
+ n = CHILD(n, 1);
+ if (TYPE(n) == RSQB) {
+ err_setstr(TypeError,
+ "can't assign to []");
+ c->c_errors++;
+ return;
+ }
+ com_assign_list(c, n, assigning);
+ return;
+ case NAME:
+ com_assign_name(c, CHILD(n, 0), assigning);
+ return;
+ default:
+ err_setstr(TypeError,
+ "can't assign to constant");
+ c->c_errors++;
+ return;
+ }
+ break;
+
+ default:
+ fprintf(stderr, "node type %d\n", TYPE(n));
+ err_setstr(SystemError, "com_assign: bad node");
+ c->c_errors++;
+ return;
+
+ }
+ }
+}
+
+static void
+com_expr_stmt(c, n)
+ struct compiling *c;
+ node *n;
+{
+ REQ(n, expr_stmt); /* exprlist ('=' exprlist)* NEWLINE */
+ com_node(c, CHILD(n, NCH(n)-2));
+ if (NCH(n) == 2) {
+ com_addbyte(c, PRINT_EXPR);
+ }
+ else {
+ int i;
+ for (i = 0; i < NCH(n)-3; i+=2) {
+ if (i+2 < NCH(n)-3)
+ com_addbyte(c, DUP_TOP);
+ com_assign(c, CHILD(n, i), 1/*assign*/);
+ }
+ }
+}
+
+static void
+com_print_stmt(c, n)
+ struct compiling *c;
+ node *n;
+{
+ int i;
+ REQ(n, print_stmt); /* 'print' (test ',')* [test] NEWLINE */
+ for (i = 1; i+1 < NCH(n); i += 2) {
+ com_node(c, CHILD(n, i));
+ com_addbyte(c, PRINT_ITEM);
+ }
+ if (TYPE(CHILD(n, NCH(n)-2)) != COMMA)
+ com_addbyte(c, PRINT_NEWLINE);
+ /* XXX Alternatively, LOAD_CONST '\n' and then PRINT_ITEM */
+}
+
+static void
+com_return_stmt(c, n)
+ struct compiling *c;
+ node *n;
+{
+ REQ(n, return_stmt); /* 'return' [testlist] NEWLINE */
+ if (!c->c_infunction) {
+ err_setstr(TypeError, "'return' outside function");
+ c->c_errors++;
+ }
+ if (NCH(n) == 2)
+ com_addoparg(c, LOAD_CONST, com_addconst(c, None));
+ else
+ com_node(c, CHILD(n, 1));
+ com_addbyte(c, RETURN_VALUE);
+}
+
+static void
+com_raise_stmt(c, n)
+ struct compiling *c;
+ node *n;
+{
+ REQ(n, raise_stmt); /* 'raise' expr [',' expr] NEWLINE */
+ com_node(c, CHILD(n, 1));
+ if (NCH(n) > 3)
+ com_node(c, CHILD(n, 3));
+ else
+ com_addoparg(c, LOAD_CONST, com_addconst(c, None));
+ com_addbyte(c, RAISE_EXCEPTION);
+}
+
+static void
+com_import_stmt(c, n)
+ struct compiling *c;
+ node *n;
+{
+ int i;
+ REQ(n, import_stmt);
+ /* 'import' NAME (',' NAME)* NEWLINE |
+ 'from' NAME 'import' ('*' | NAME (',' NAME)*) NEWLINE */
+ if (STR(CHILD(n, 0))[0] == 'f') {
+ /* 'from' NAME 'import' ... */
+ REQ(CHILD(n, 1), NAME);
+ com_addopname(c, IMPORT_NAME, CHILD(n, 1));
+ for (i = 3; i < NCH(n); i += 2)
+ com_addopname(c, IMPORT_FROM, CHILD(n, i));
+ com_addbyte(c, POP_TOP);
+ }
+ else {
+ /* 'import' ... */
+ for (i = 1; i < NCH(n); i += 2) {
+ com_addopname(c, IMPORT_NAME, CHILD(n, i));
+ com_addopname(c, STORE_NAME, CHILD(n, i));
+ }
+ }
+}
+
+static void
+com_if_stmt(c, n)
+ struct compiling *c;
+ node *n;
+{
+ int i;
+ int anchor = 0;
+ REQ(n, if_stmt);
+ /*'if' test ':' suite ('elif' test ':' suite)* ['else' ':' suite] */
+ for (i = 0; i+3 < NCH(n); i+=4) {
+ int a = 0;
+ node *ch = CHILD(n, i+1);
+ if (i > 0)
+ com_addoparg(c, SET_LINENO, ch->n_lineno);
+ com_node(c, CHILD(n, i+1));
+ com_addfwref(c, JUMP_IF_FALSE, &a);
+ com_addbyte(c, POP_TOP);
+ com_node(c, CHILD(n, i+3));
+ com_addfwref(c, JUMP_FORWARD, &anchor);
+ com_backpatch(c, a);
+ com_addbyte(c, POP_TOP);
+ }
+ if (i+2 < NCH(n))
+ com_node(c, CHILD(n, i+2));
+ com_backpatch(c, anchor);
+}
+
+static void
+com_while_stmt(c, n)
+ struct compiling *c;
+ node *n;
+{
+ int break_anchor = 0;
+ int anchor = 0;
+ int begin;
+ REQ(n, while_stmt); /* 'while' test ':' suite ['else' ':' suite] */
+ com_addfwref(c, SETUP_LOOP, &break_anchor);
+ begin = c->c_nexti;
+ com_addoparg(c, SET_LINENO, n->n_lineno);
+ com_node(c, CHILD(n, 1));
+ com_addfwref(c, JUMP_IF_FALSE, &anchor);
+ com_addbyte(c, POP_TOP);
+ c->c_loops++;
+ com_node(c, CHILD(n, 3));
+ c->c_loops--;
+ com_addoparg(c, JUMP_ABSOLUTE, begin);
+ com_backpatch(c, anchor);
+ com_addbyte(c, POP_TOP);
+ com_addbyte(c, POP_BLOCK);
+ if (NCH(n) > 4)
+ com_node(c, CHILD(n, 6));
+ com_backpatch(c, break_anchor);
+}
+
+static void
+com_for_stmt(c, n)
+ struct compiling *c;
+ node *n;
+{
+ object *v;
+ int break_anchor = 0;
+ int anchor = 0;
+ int begin;
+ REQ(n, for_stmt);
+ /* 'for' exprlist 'in' exprlist ':' suite ['else' ':' suite] */
+ com_addfwref(c, SETUP_LOOP, &break_anchor);
+ com_node(c, CHILD(n, 3));
+ v = newintobject(0L);
+ if (v == NULL)
+ c->c_errors++;
+ com_addoparg(c, LOAD_CONST, com_addconst(c, v));
+ XDECREF(v);
+ begin = c->c_nexti;
+ com_addoparg(c, SET_LINENO, n->n_lineno);
+ com_addfwref(c, FOR_LOOP, &anchor);
+ com_assign(c, CHILD(n, 1), 1/*assigning*/);
+ c->c_loops++;
+ com_node(c, CHILD(n, 5));
+ c->c_loops--;
+ com_addoparg(c, JUMP_ABSOLUTE, begin);
+ com_backpatch(c, anchor);
+ com_addbyte(c, POP_BLOCK);
+ if (NCH(n) > 8)
+ com_node(c, CHILD(n, 8));
+ com_backpatch(c, break_anchor);
+}
+
+/* Although 'execpt' and 'finally' clauses can be combined
+ syntactically, they are compiled separately. In fact,
+ try: S
+ except E1: S1
+ except E2: S2
+ ...
+ finally: Sf
+ is equivalent to
+ try:
+ try: S
+ except E1: S1
+ except E2: S2
+ ...
+ finally: Sf
+ meaning that the 'finally' clause is entered even if things
+ go wrong again in an exception handler. Note that this is
+ not the case for exception handlers: at most one is entered.
+
+ Code generated for "try: S finally: Sf" is as follows:
+
+ SETUP_FINALLY L
+ <code for S>
+ POP_BLOCK
+ LOAD_CONST <nil>
+ L: <code for Sf>
+ END_FINALLY
+
+ The special instructions use the block stack. Each block
+ stack entry contains the instruction that created it (here
+ SETUP_FINALLY), the level of the value stack at the time the
+ block stack entry was created, and a label (here L).
+
+ SETUP_FINALLY:
+ Pushes the current value stack level and the label
+ onto the block stack.
+ POP_BLOCK:
+ Pops en entry from the block stack, and pops the value
+ stack until its level is the same as indicated on the
+ block stack. (The label is ignored.)
+ END_FINALLY:
+ Pops a variable number of entries from the *value* stack
+ and re-raises the exception they specify. The number of
+ entries popped depends on the (pseudo) exception type.
+
+ The block stack is unwound when an exception is raised:
+ when a SETUP_FINALLY entry is found, the exception is pushed
+ onto the value stack (and the exception condition is cleared),
+ and the interpreter jumps to the label gotten from the block
+ stack.
+
+ Code generated for "try: S except E1, V1: S1 except E2, V2: S2 ...":
+ (The contents of the value stack is shown in [], with the top
+ at the right; 'tb' is trace-back info, 'val' the exception's
+ associated value, and 'exc' the exception.)
+
+ Value stack Label Instruction Argument
+ [] SETUP_EXCEPT L1
+ [] <code for S>
+ [] POP_BLOCK
+ [] JUMP_FORWARD L0
+
+ [tb, val, exc] L1: DUP )
+ [tb, val, exc, exc] <evaluate E1> )
+ [tb, val, exc, exc, E1] COMPARE_OP EXC_MATCH ) only if E1
+ [tb, val, exc, 1-or-0] JUMP_IF_FALSE L2 )
+ [tb, val, exc, 1] POP )
+ [tb, val, exc] POP
+ [tb, val] <assign to V1> (or POP if no V1)
+ [tb] POP
+ [] <code for S1>
+ JUMP_FORWARD L0
+
+ [tb, val, exc, 0] L2: POP
+ [tb, val, exc] DUP
+ .............................etc.......................
+
+ [tb, val, exc, 0] Ln+1: POP
+ [tb, val, exc] END_FINALLY # re-raise exception
+
+ [] L0: <next statement>
+
+ Of course, parts are not generated if Vi or Ei is not present.
+*/
+
+static void
+com_try_stmt(c, n)
+ struct compiling *c;
+ node *n;
+{
+ int finally_anchor = 0;
+ int except_anchor = 0;
+ REQ(n, try_stmt);
+ /* 'try' ':' suite (except_clause ':' suite)* ['finally' ':' suite] */
+
+ if (NCH(n) > 3 && TYPE(CHILD(n, NCH(n)-3)) != except_clause) {
+ /* Have a 'finally' clause */
+ com_addfwref(c, SETUP_FINALLY, &finally_anchor);
+ }
+ if (NCH(n) > 3 && TYPE(CHILD(n, 3)) == except_clause) {
+ /* Have an 'except' clause */
+ com_addfwref(c, SETUP_EXCEPT, &except_anchor);
+ }
+ com_node(c, CHILD(n, 2));
+ if (except_anchor) {
+ int end_anchor = 0;
+ int i;
+ node *ch;
+ com_addbyte(c, POP_BLOCK);
+ com_addfwref(c, JUMP_FORWARD, &end_anchor);
+ com_backpatch(c, except_anchor);
+ for (i = 3;
+ i < NCH(n) && TYPE(ch = CHILD(n, i)) == except_clause;
+ i += 3) {
+ /* except_clause: 'except' [expr [',' expr]] */
+ if (except_anchor == 0) {
+ err_setstr(TypeError,
+ "default 'except:' must be last");
+ c->c_errors++;
+ break;
+ }
+ except_anchor = 0;
+ com_addoparg(c, SET_LINENO, ch->n_lineno);
+ if (NCH(ch) > 1) {
+ com_addbyte(c, DUP_TOP);
+ com_node(c, CHILD(ch, 1));
+ com_addoparg(c, COMPARE_OP, EXC_MATCH);
+ com_addfwref(c, JUMP_IF_FALSE, &except_anchor);
+ com_addbyte(c, POP_TOP);
+ }
+ com_addbyte(c, POP_TOP);
+ if (NCH(ch) > 3)
+ com_assign(c, CHILD(ch, 3), 1/*assigning*/);
+ else
+ com_addbyte(c, POP_TOP);
+ com_addbyte(c, POP_TOP);
+ com_node(c, CHILD(n, i+2));
+ com_addfwref(c, JUMP_FORWARD, &end_anchor);
+ if (except_anchor) {
+ com_backpatch(c, except_anchor);
+ com_addbyte(c, POP_TOP);
+ }
+ }
+ com_addbyte(c, END_FINALLY);
+ com_backpatch(c, end_anchor);
+ }
+ if (finally_anchor) {
+ node *ch;
+ com_addbyte(c, POP_BLOCK);
+ com_addoparg(c, LOAD_CONST, com_addconst(c, None));
+ com_backpatch(c, finally_anchor);
+ ch = CHILD(n, NCH(n)-1);
+ com_addoparg(c, SET_LINENO, ch->n_lineno);
+ com_node(c, ch);
+ com_addbyte(c, END_FINALLY);
+ }
+}
+
+static void
+com_suite(c, n)
+ struct compiling *c;
+ node *n;
+{
+ REQ(n, suite);
+ /* simple_stmt | NEWLINE INDENT NEWLINE* (stmt NEWLINE*)+ DEDENT */
+ if (NCH(n) == 1) {
+ com_node(c, CHILD(n, 0));
+ }
+ else {
+ int i;
+ for (i = 0; i < NCH(n); i++) {
+ node *ch = CHILD(n, i);
+ if (TYPE(ch) == stmt)
+ com_node(c, ch);
+ }
+ }
+}
+
+static void
+com_funcdef(c, n)
+ struct compiling *c;
+ node *n;
+{
+ object *v;
+ REQ(n, funcdef); /* funcdef: 'def' NAME parameters ':' suite */
+ v = (object *)compile(n, c->c_filename);
+ if (v == NULL)
+ c->c_errors++;
+ else {
+ int i = com_addconst(c, v);
+ com_addoparg(c, LOAD_CONST, i);
+ com_addbyte(c, BUILD_FUNCTION);
+ com_addopname(c, STORE_NAME, CHILD(n, 1));
+ DECREF(v);
+ }
+}
+
+static void
+com_bases(c, n)
+ struct compiling *c;
+ node *n;
+{
+ int i, nbases;
+ REQ(n, baselist);
+ /*
+ baselist: atom arguments (',' atom arguments)*
+ arguments: '(' [testlist] ')'
+ */
+ for (i = 0; i < NCH(n); i += 3)
+ com_node(c, CHILD(n, i));
+ com_addoparg(c, BUILD_TUPLE, (NCH(n)+1) / 3);
+}
+
+static void
+com_classdef(c, n)
+ struct compiling *c;
+ node *n;
+{
+ object *v;
+ REQ(n, classdef);
+ /*
+ classdef: 'class' NAME parameters ['=' baselist] ':' suite
+ baselist: atom arguments (',' atom arguments)*
+ arguments: '(' [testlist] ')'
+ */
+ if (NCH(n) == 7)
+ com_bases(c, CHILD(n, 4));
+ else
+ com_addoparg(c, LOAD_CONST, com_addconst(c, None));
+ v = (object *)compile(n, c->c_filename);
+ if (v == NULL)
+ c->c_errors++;
+ else {
+ int i = com_addconst(c, v);
+ com_addoparg(c, LOAD_CONST, i);
+ com_addbyte(c, BUILD_FUNCTION);
+ com_addbyte(c, UNARY_CALL);
+ com_addbyte(c, BUILD_CLASS);
+ com_addopname(c, STORE_NAME, CHILD(n, 1));
+ DECREF(v);
+ }
+}
+
+static void
+com_node(c, n)
+ struct compiling *c;
+ node *n;
+{
+ switch (TYPE(n)) {
+
+ /* Definition nodes */
+
+ case funcdef:
+ com_funcdef(c, n);
+ break;
+ case classdef:
+ com_classdef(c, n);
+ break;
+
+ /* Trivial parse tree nodes */
+
+ case stmt:
+ case flow_stmt:
+ com_node(c, CHILD(n, 0));
+ break;
+
+ case simple_stmt:
+ case compound_stmt:
+ com_addoparg(c, SET_LINENO, n->n_lineno);
+ com_node(c, CHILD(n, 0));
+ break;
+
+ /* Statement nodes */
+
+ case expr_stmt:
+ com_expr_stmt(c, n);
+ break;
+ case print_stmt:
+ com_print_stmt(c, n);
+ break;
+ case del_stmt: /* 'del' exprlist NEWLINE */
+ com_assign(c, CHILD(n, 1), 0/*delete*/);
+ break;
+ case pass_stmt:
+ break;
+ case break_stmt:
+ if (c->c_loops == 0) {
+ err_setstr(TypeError, "'break' outside loop");
+ c->c_errors++;
+ }
+ com_addbyte(c, BREAK_LOOP);
+ break;
+ case return_stmt:
+ com_return_stmt(c, n);
+ break;
+ case raise_stmt:
+ com_raise_stmt(c, n);
+ break;
+ case import_stmt:
+ com_import_stmt(c, n);
+ break;
+ case if_stmt:
+ com_if_stmt(c, n);
+ break;
+ case while_stmt:
+ com_while_stmt(c, n);
+ break;
+ case for_stmt:
+ com_for_stmt(c, n);
+ break;
+ case try_stmt:
+ com_try_stmt(c, n);
+ break;
+ case suite:
+ com_suite(c, n);
+ break;
+
+ /* Expression nodes */
+
+ case testlist:
+ com_list(c, n);
+ break;
+ case test:
+ com_test(c, n);
+ break;
+ case and_test:
+ com_and_test(c, n);
+ break;
+ case not_test:
+ com_not_test(c, n);
+ break;
+ case comparison:
+ com_comparison(c, n);
+ break;
+ case exprlist:
+ com_list(c, n);
+ break;
+ case expr:
+ com_expr(c, n);
+ break;
+ case term:
+ com_term(c, n);
+ break;
+ case factor:
+ com_factor(c, n);
+ break;
+ case atom:
+ com_atom(c, n);
+ break;
+
+ default:
+ fprintf(stderr, "node type %d\n", TYPE(n));
+ err_setstr(SystemError, "com_node: unexpected node type");
+ c->c_errors++;
+ }
+}
+
+static void com_fplist PROTO((struct compiling *, node *));
+
+static void
+com_fpdef(c, n)
+ struct compiling *c;
+ node *n;
+{
+ REQ(n, fpdef); /* fpdef: NAME | '(' fplist ')' */
+ if (TYPE(CHILD(n, 0)) == LPAR)
+ com_fplist(c, CHILD(n, 1));
+ else
+ com_addopname(c, STORE_NAME, CHILD(n, 0));
+}
+
+static void
+com_fplist(c, n)
+ struct compiling *c;
+ node *n;
+{
+ REQ(n, fplist); /* fplist: fpdef (',' fpdef)* */
+ if (NCH(n) == 1) {
+ com_fpdef(c, CHILD(n, 0));
+ }
+ else {
+ int i;
+ com_addoparg(c, UNPACK_TUPLE, (NCH(n)+1)/2);
+ for (i = 0; i < NCH(n); i += 2)
+ com_fpdef(c, CHILD(n, i));
+ }
+}
+
+static void
+com_file_input(c, n)
+ struct compiling *c;
+ node *n;
+{
+ int i;
+ REQ(n, file_input); /* (NEWLINE | stmt)* ENDMARKER */
+ for (i = 0; i < NCH(n); i++) {
+ node *ch = CHILD(n, i);
+ if (TYPE(ch) != ENDMARKER && TYPE(ch) != NEWLINE)
+ com_node(c, ch);
+ }
+}
+
+/* Top-level compile-node interface */
+
+static void
+compile_funcdef(c, n)
+ struct compiling *c;
+ node *n;
+{
+ node *ch;
+ REQ(n, funcdef); /* funcdef: 'def' NAME parameters ':' suite */
+ ch = CHILD(n, 2); /* parameters: '(' [fplist] ')' */
+ ch = CHILD(ch, 1); /* ')' | fplist */
+ if (TYPE(ch) == RPAR)
+ com_addbyte(c, REFUSE_ARGS);
+ else {
+ com_addbyte(c, REQUIRE_ARGS);
+ com_fplist(c, ch);
+ }
+ c->c_infunction = 1;
+ com_node(c, CHILD(n, 4));
+ c->c_infunction = 0;
+ com_addoparg(c, LOAD_CONST, com_addconst(c, None));
+ com_addbyte(c, RETURN_VALUE);
+}
+
+static void
+compile_node(c, n)
+ struct compiling *c;
+ node *n;
+{
+ com_addoparg(c, SET_LINENO, n->n_lineno);
+
+ switch (TYPE(n)) {
+
+ case single_input: /* One interactive command */
+ /* NEWLINE | simple_stmt | compound_stmt NEWLINE */
+ com_addbyte(c, REFUSE_ARGS);
+ n = CHILD(n, 0);
+ if (TYPE(n) != NEWLINE)
+ com_node(c, n);
+ com_addoparg(c, LOAD_CONST, com_addconst(c, None));
+ com_addbyte(c, RETURN_VALUE);
+ break;
+
+ case file_input: /* A whole file, or built-in function exec() */
+ com_addbyte(c, REFUSE_ARGS);
+ com_file_input(c, n);
+ com_addoparg(c, LOAD_CONST, com_addconst(c, None));
+ com_addbyte(c, RETURN_VALUE);
+ break;
+
+ case expr_input: /* Built-in function eval() */
+ com_addbyte(c, REFUSE_ARGS);
+ com_node(c, CHILD(n, 0));
+ com_addbyte(c, RETURN_VALUE);
+ break;
+
+ case eval_input: /* Built-in function input() */
+ com_addbyte(c, REFUSE_ARGS);
+ com_node(c, CHILD(n, 0));
+ com_addbyte(c, RETURN_VALUE);
+ break;
+
+ case funcdef: /* A function definition */
+ compile_funcdef(c, n);
+ break;
+
+ case classdef: /* A class definition */
+ /* 'class' NAME parameters ['=' baselist] ':' suite */
+ com_addbyte(c, REFUSE_ARGS);
+ com_node(c, CHILD(n, NCH(n)-1));
+ com_addbyte(c, LOAD_LOCALS);
+ com_addbyte(c, RETURN_VALUE);
+ break;
+
+ default:
+ fprintf(stderr, "node type %d\n", TYPE(n));
+ err_setstr(SystemError, "compile_node: unexpected node type");
+ c->c_errors++;
+ }
+}
+
+codeobject *
+compile(n, filename)
+ node *n;
+ char *filename;
+{
+ struct compiling sc;
+ codeobject *co;
+ if (!com_init(&sc, filename))
+ return NULL;
+ compile_node(&sc, n);
+ com_done(&sc);
+ if (sc.c_errors == 0)
+ co = newcodeobject(sc.c_code, sc.c_consts, sc.c_names, filename);
+ else
+ co = NULL;
+ com_free(&sc);
+ return co;
+}
diff --git a/src/compile.h b/src/compile.h
new file mode 100644
index 0000000..fb66ea7
--- /dev/null
+++ b/src/compile.h
@@ -0,0 +1,47 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Definitions for compiled intermediate code */
+
+
+/* An intermediate code fragment contains:
+ - a string that encodes the instructions,
+ - a list of the constants,
+ - and a list of the names used. */
+
+typedef struct {
+ OB_HEAD
+ stringobject *co_code; /* instruction opcodes */
+ object *co_consts; /* list of immutable constant objects */
+ object *co_names; /* list of stringobjects */
+ object *co_filename; /* string */
+} codeobject;
+
+extern typeobject Codetype;
+
+#define is_codeobject(op) ((op)->ob_type == &Codetype)
+
+
+/* Public interface */
+codeobject *compile PROTO((struct _node *, char *));
diff --git a/src/config.c b/src/config.c
new file mode 100644
index 0000000..9d153c1
--- /dev/null
+++ b/src/config.c
@@ -0,0 +1,180 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Configurable Python configuration file */
+
+#include <stdio.h>
+
+#ifdef USE_STDWIN
+#include <stdwin.h>
+
+static int use_stdwin;
+#endif
+
+/*ARGSUSED*/
+void
+initargs(p_argc, p_argv)
+ int *p_argc;
+ char ***p_argv;
+{
+#ifdef USE_STDWIN
+ extern char *getenv();
+ char *display;
+
+ /* Ignore an initial argument of '-s', for backward compatibility */
+ if (*p_argc > 1 && strcmp((*p_argv)[1], "-s") == 0) {
+ (*p_argv)[1] = (*p_argv)[0];
+ (*p_argc)--, (*p_argv)++;
+ }
+
+ /* Assume we have to initialize stdwin if either of the following
+ conditions holds:
+ - the environment variable $DISPLAY is set
+ - there is an argument "-display" somewhere
+ */
+
+ display = getenv("DISPLAY");
+ if (display != 0)
+ use_stdwin = 1;
+ else {
+ int i;
+ /* Scan through the arguments looking for "-display" */
+ for (i = 1; i < *p_argc; i++) {
+ if (strcmp((*p_argv)[i], "-display") == 0) {
+ use_stdwin = 1;
+ break;
+ }
+ }
+ }
+
+ if (use_stdwin)
+ wargs(p_argc, p_argv);
+#endif
+}
+
+void
+initcalls()
+{
+}
+
+void
+donecalls()
+{
+#ifdef USE_STDWIN
+ if (use_stdwin)
+ wdone();
+#endif
+#ifdef USE_AUDIO
+ asa_done();
+#endif
+}
+
+#ifdef USE_STDWIN
+static void
+maybeinitstdwin()
+{
+ if (use_stdwin)
+ initstdwin();
+ else
+ fprintf(stderr,
+ "No $DISPLAY nor -display arg -- stdwin not available\n");
+}
+#endif
+
+#ifndef PYTHONPATH
+#define PYTHONPATH ".:/usr/local/lib/python"
+#endif
+
+extern char *getenv();
+
+char *
+getpythonpath()
+{
+ char *path = getenv("PYTHONPATH");
+ if (path == 0)
+ path = PYTHONPATH;
+ return path;
+}
+
+
+/* Table of built-in modules.
+ These are initialized when first imported. */
+
+/* Standard modules */
+extern void inittime();
+extern void initmath();
+extern void initregexp();
+extern void initposix();
+#ifdef USE_AUDIO
+extern void initaudio();
+#endif
+#ifdef USE_AMOEBA
+extern void initamoeba();
+#endif
+#ifdef USE_GL
+extern void initgl();
+#ifdef USE_PANEL
+extern void initpanel();
+#endif
+#endif
+#ifdef USE_STDWIN
+extern void maybeinitstdwin();
+#endif
+
+struct {
+ char *name;
+ void (*initfunc)();
+} inittab[] = {
+
+ /* Standard modules */
+
+ {"time", inittime},
+ {"math", initmath},
+ {"regexp", initregexp},
+ {"posix", initposix},
+
+
+ /* Optional modules */
+
+#ifdef USE_AUDIO
+ {"audio", initaudio},
+#endif
+
+#ifdef USE_AMOEBA
+ {"amoeba", initamoeba},
+#endif
+
+#ifdef USE_GL
+ {"gl", initgl},
+#ifdef USE_PANEL
+ {"pnl", initpanel},
+#endif
+#endif
+
+#ifdef USE_STDWIN
+ {"stdwin", maybeinitstdwin},
+#endif
+
+ {0, 0} /* Sentinel */
+};
diff --git a/src/configmac.c b/src/configmac.c
new file mode 100644
index 0000000..c73130a
--- /dev/null
+++ b/src/configmac.c
@@ -0,0 +1,109 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Configuration using STDWIN on the Mac (THINK_C or MPW) */
+
+#ifdef THINK_C
+#define USE_STDWIN
+#endif
+
+#ifdef USE_STDWIN
+#include "stdwin.h"
+#endif
+
+void
+initargs(p_argc, p_argv)
+ int *p_argc;
+ char ***p_argv;
+{
+#ifdef USE_STDWIN
+
+#ifdef THINK_C_3_0
+ wsetstdio(1);
+#else
+ /* This printf() statement is really needed only
+ to initialize THINK C 4.0's stdio: */
+ printf(
+"Python 4.0, Copyright 1990 Stichting Mathematisch Centrum, Amsterdam\n");
+#endif
+
+ wargs(p_argc, p_argv);
+#endif
+}
+
+void
+initcalls()
+{
+}
+
+void
+donecalls()
+{
+#ifdef USE_STDWIN
+ wdone();
+#endif
+}
+
+#ifndef PYTHONPATH
+/* On the Mac, the search path is a space-separated list of directories */
+#define PYTHONPATH ": :lib :lib:stdwin :lib:mac :lib:demo"
+#endif
+
+char *
+getpythonpath()
+{
+ return PYTHONPATH;
+}
+
+
+/* Table of built-in modules.
+ These are initialized when first imported. */
+
+/* Standard modules */
+extern void inittime();
+extern void initmath();
+extern void initregexp();
+
+/* Mac-specific modules */
+extern void initmac();
+#ifdef USE_STDWIN
+extern void initstdwin();
+#endif
+
+struct {
+ char *name;
+ void (*initfunc)();
+} inittab[] = {
+ /* Standard modules */
+ {"time", inittime},
+ {"math", initmath},
+ {"regexp", initregexp},
+
+ /* Mac-specific modules */
+ {"mac", initmac},
+#ifdef USE_STDWIN
+ {"stdwin", initstdwin},
+#endif
+ {0, 0} /* Sentinel */
+};
diff --git a/src/cstubs b/src/cstubs
new file mode 100644
index 0000000..3996572
--- /dev/null
+++ b/src/cstubs
@@ -0,0 +1,999 @@
+/*
+Input used to generate the Python module "glmodule.c".
+The stub generator is a Python script called "cgen".
+
+Each definition must be contained on one line:
+
+<returntype> <name> <type> <arg> <type> <arg>
+
+<returntype> can be: void, short, long (XXX maybe others?)
+
+<type> can be: char, string, short, float, long, or double
+ string indicates a null terminated string;
+ if <type> is char and <arg> begins with a *, the * is stripped
+ and <type> is changed into string
+
+<arg> has the form <mode> or <mode>[<subscript>]
+ where <mode> can be
+ s: arg is sent
+ r: arg is received (arg is a pointer)
+ and <subscript> can be (N and I are numbers):
+ N
+ argI
+ retval
+ N*argI
+ N*retval
+*/
+
+#include <gl.h>
+#include <device.h>
+
+#include "allobjects.h"
+#include "import.h"
+#include "modsupport.h"
+#include "cgensupport.h"
+
+/*
+Some stubs are too complicated for the stub generator.
+We can include manually written versions of them here.
+A line starting with '%' gives the name of the function so the stub
+generator can include it in the table of functions.
+*/
+
+/*
+varray -- an array of v.. calls.
+The argument is an array (maybe list or tuple) of points.
+Each point must be a tuple or list of coordinates (x, y, z).
+The points may be 2- or 3-dimensional but must all have the
+same dimension. Float and int values may be mixed however.
+The points are always converted to 3D double precision points
+by assuming z=0.0 if necessary (as indicated in the man page),
+and for each point v3d() is called.
+*/
+
+% varray
+
+static object *
+gl_varray(self, args)
+ object *self;
+ object *args;
+{
+ object *v, *w;
+ int i, n, width;
+ double vec[3];
+ object * (*getitem) FPROTO((object *, int));
+
+ if (!getiobjectarg(args, 1, 0, &v))
+ return NULL;
+
+ if (is_listobject(v)) {
+ n = getlistsize(v);
+ getitem = getlistitem;
+ }
+ else if (is_tupleobject(v)) {
+ n = gettuplesize(v);
+ getitem = gettupleitem;
+ }
+ else {
+ err_badarg();
+ return NULL;
+ }
+
+ if (n == 0) {
+ INCREF(None);
+ return None;
+ }
+ if (n > 0)
+ w = (*getitem)(v, 0);
+
+ width = 0;
+ if (w == NULL) {
+ }
+ else if (is_listobject(w)) {
+ width = getlistsize(w);
+ }
+ else if (is_tupleobject(w)) {
+ width = gettuplesize(w);
+ }
+
+ switch (width) {
+ case 2:
+ vec[2] = 0.0;
+ /* Fall through */
+ case 3:
+ break;
+ default:
+ err_badarg();
+ return NULL;
+ }
+
+ for (i = 0; i < n; i++) {
+ w = (*getitem)(v, i);
+ if (!getidoublearray(w, 1, 0, width, vec))
+ return NULL;
+ v3d(vec);
+ }
+
+ INCREF(None);
+ return None;
+}
+
+/*
+vnarray, nvarray -- an array of n3f and v3f calls.
+The argument is an array (list or tuple) of pairs of points and normals.
+Each pair is a tuple (NOT a list) of a point and a normal for that point.
+Each point or normal must be a tuple (NOT a list) of coordinates (x, y, z).
+Three coordinates must be given. Float and int values may be mixed.
+For each pair, n3f() is called for the normal, and then v3f() is called
+for the vector.
+
+vnarray and nvarray differ only in the order of the vector and normal in
+the pair: vnarray expects (v, n) while nvarray expects (n, v).
+*/
+
+static object *gen_nvarray(); /* Forward */
+
+% nvarray
+
+static object *
+gl_nvarray(self, args)
+ object *self;
+ object *args;
+{
+ return gen_nvarray(args, 0);
+}
+
+% vnarray
+
+static object *
+gl_vnarray(self, args)
+ object *self;
+ object *args;
+{
+ return gen_nvarray(args, 1);
+}
+
+/* Generic, internal version of {nv,nv}array: inorm indicates the
+ argument order, 0: normal first, 1: vector first. */
+
+static object *
+gen_nvarray(args, inorm)
+ object *args;
+ int inorm;
+{
+ object *v, *w, *wnorm, *wvec;
+ int i, n;
+ float norm[3], vec[3];
+ object * (*getitem) FPROTO((object *, int));
+
+ if (!getiobjectarg(args, 1, 0, &v))
+ return NULL;
+
+ if (is_listobject(v)) {
+ n = getlistsize(v);
+ getitem = getlistitem;
+ }
+ else if (is_tupleobject(v)) {
+ n = gettuplesize(v);
+ getitem = gettupleitem;
+ }
+ else {
+ err_badarg();
+ return NULL;
+ }
+
+ for (i = 0; i < n; i++) {
+ w = (*getitem)(v, i);
+ if (!is_tupleobject(w) || gettuplesize(w) != 2) {
+ err_badarg();
+ return NULL;
+ }
+ wnorm = gettupleitem(w, inorm);
+ wvec = gettupleitem(w, 1 - inorm);
+ if (!getifloatarray(wnorm, 1, 0, 3, norm) ||
+ !getifloatarray(wvec, 1, 0, 3, vec))
+ return NULL;
+ n3f(norm);
+ v3f(vec);
+ }
+
+ INCREF(None);
+ return None;
+}
+
+/* nurbssurface(s_knots[], t_knots[], ctl[][], s_order, t_order, type).
+ The dimensions of ctl[] are computed as follows:
+ [len(s_knots) - s_order], [len(t_knots) - t_order]
+*/
+
+% nurbssurface
+
+static object *
+gl_nurbssurface(self, args)
+ object *self;
+ object *args;
+{
+ long arg1 ;
+ double * arg2 ;
+ long arg3 ;
+ double * arg4 ;
+ double *arg5 ;
+ long arg6 ;
+ long arg7 ;
+ long arg8 ;
+ long ncoords;
+ long s_byte_stride, t_byte_stride;
+ long s_nctl, t_nctl;
+ long s, t;
+ object *v, *w, *pt;
+ double *pnext;
+ if (!getilongarraysize(args, 6, 0, &arg1))
+ return NULL;
+ if ((arg2 = NEW(double, arg1 )) == NULL) {
+ return err_nomem();
+ }
+ if (!getidoublearray(args, 6, 0, arg1 , arg2))
+ return NULL;
+ if (!getilongarraysize(args, 6, 1, &arg3))
+ return NULL;
+ if ((arg4 = NEW(double, arg3 )) == NULL) {
+ return err_nomem();
+ }
+ if (!getidoublearray(args, 6, 1, arg3 , arg4))
+ return NULL;
+ if (!getilongarg(args, 6, 3, &arg6))
+ return NULL;
+ if (!getilongarg(args, 6, 4, &arg7))
+ return NULL;
+ if (!getilongarg(args, 6, 5, &arg8))
+ return NULL;
+ if (arg8 == N_XYZ)
+ ncoords = 3;
+ else if (arg8 == N_XYZW)
+ ncoords = 4;
+ else {
+ err_badarg();
+ return NULL;
+ }
+ s_nctl = arg1 - arg6;
+ t_nctl = arg3 - arg7;
+ if (!getiobjectarg(args, 6, 2, &v))
+ return NULL;
+ if (!is_listobject(v) || getlistsize(v) != s_nctl) {
+ err_badarg();
+ return NULL;
+ }
+ if ((arg5 = NEW(double, s_nctl*t_nctl*ncoords )) == NULL) {
+ return err_nomem();
+ }
+ pnext = arg5;
+ for (s = 0; s < s_nctl; s++) {
+ w = getlistitem(v, s);
+ if (w == NULL || !is_listobject(w) ||
+ getlistsize(w) != t_nctl) {
+ err_badarg();
+ return NULL;
+ }
+ for (t = 0; t < t_nctl; t++) {
+ pt = getlistitem(w, t);
+ if (!getidoublearray(pt, 1, 0, ncoords, pnext))
+ return NULL;
+ pnext += ncoords;
+ }
+ }
+ s_byte_stride = sizeof(double) * ncoords;
+ t_byte_stride = s_byte_stride * s_nctl;
+ nurbssurface( arg1 , arg2 , arg3 , arg4 ,
+ s_byte_stride , t_byte_stride , arg5 , arg6 , arg7 , arg8 );
+ DEL(arg2);
+ DEL(arg4);
+ DEL(arg5);
+ INCREF(None);
+ return None;
+}
+
+/* nurbscurve(knots, ctlpoints, order, type).
+ The length of ctlpoints is len(knots)-order. */
+
+%nurbscurve
+
+static object *
+gl_nurbscurve(self, args)
+ object *self;
+ object *args;
+{
+ long arg1 ;
+ double * arg2 ;
+ long arg3 ;
+ double * arg4 ;
+ long arg5 ;
+ long arg6 ;
+ int ncoords, npoints;
+ int i;
+ object *v;
+ double *pnext;
+ if (!getilongarraysize(args, 4, 0, &arg1))
+ return NULL;
+ if ((arg2 = NEW(double, arg1 )) == NULL) {
+ return err_nomem();
+ }
+ if (!getidoublearray(args, 4, 0, arg1 , arg2))
+ return NULL;
+ if (!getilongarg(args, 4, 2, &arg5))
+ return NULL;
+ if (!getilongarg(args, 4, 3, &arg6))
+ return NULL;
+ if (arg6 == N_ST)
+ ncoords = 2;
+ else if (arg6 == N_STW)
+ ncoords = 3;
+ else {
+ err_badarg();
+ return NULL;
+ }
+ npoints = arg1 - arg5;
+ if (!getiobjectarg(args, 4, 1, &v))
+ return NULL;
+ if (!is_listobject(v) || getlistsize(v) != npoints) {
+ err_badarg();
+ return NULL;
+ }
+ if ((arg4 = NEW(double, npoints*ncoords )) == NULL) {
+ return err_nomem();
+ }
+ pnext = arg4;
+ for (i = 0; i < npoints; i++) {
+ if (!getidoublearray(getlistitem(v, i), 1, 0, ncoords, pnext))
+ return NULL;
+ pnext += ncoords;
+ }
+ arg3 = (sizeof(double)) * ncoords;
+ nurbscurve( arg1 , arg2 , arg3 , arg4 , arg5 , arg6 );
+ DEL(arg2);
+ DEL(arg4);
+ INCREF(None);
+ return None;
+}
+
+/* pwlcurve(points, type).
+ Points is a list of points. Type must be N_ST. */
+
+%pwlcurve
+
+static object *
+gl_pwlcurve(self, args)
+ object *self;
+ object *args;
+{
+ object *v;
+ long type;
+ double *data, *pnext;
+ long npoints, ncoords;
+ int i;
+ if (!getiobjectarg(args, 2, 0, &v))
+ return NULL;
+ if (!getilongarg(args, 2, 1, &type))
+ return NULL;
+ if (!is_listobject(v)) {
+ err_badarg();
+ return NULL;
+ }
+ npoints = getlistsize(v);
+ if (type == N_ST)
+ ncoords = 2;
+ else {
+ err_badarg();
+ return NULL;
+ }
+ if ((data = NEW(double, npoints*ncoords)) == NULL) {
+ return err_nomem();
+ }
+ pnext = data;
+ for (i = 0; i < npoints; i++) {
+ if (!getidoublearray(getlistitem(v, i), 1, 0, ncoords, pnext))
+ return NULL;
+ pnext += ncoords;
+ }
+ pwlcurve(npoints, data, sizeof(double)*ncoords, type);
+ DEL(data);
+ INCREF(None);
+ return None;
+}
+
+
+/* Picking and Selecting */
+
+static short *pickbuffer = NULL;
+static long pickbuffersize;
+
+static object *
+pick_select(args, func)
+ object *args;
+ void (*func)();
+{
+ if (!getilongarg(args, 1, 0, &pickbuffersize))
+ return NULL;
+ if (pickbuffer != NULL) {
+ err_setstr(RuntimeError,
+ "pick/gselect: already picking/selecting");
+ return NULL;
+ }
+ if ((pickbuffer = NEW(short, pickbuffersize)) == NULL) {
+ return err_nomem();
+ }
+ (*func)(pickbuffer, pickbuffersize);
+ INCREF(None);
+ return None;
+}
+
+static object *
+endpick_select(args, func)
+ object *args;
+ long (*func)();
+{
+ object *v, *w;
+ int i, nhits, n;
+ if (!getnoarg(args))
+ return NULL;
+ if (pickbuffer == NULL) {
+ err_setstr(RuntimeError,
+ "endpick/endselect: not in pick/select mode");
+ return NULL;
+ }
+ nhits = (*func)(pickbuffer);
+ if (nhits < 0) {
+ nhits = -nhits; /* How to report buffer overflow otherwise? */
+ }
+ /* Scan the buffer to see how many integers */
+ n = 0;
+ for (; nhits > 0; nhits--) {
+ n += 1 + pickbuffer[n];
+ }
+ v = newlistobject(n);
+ if (v == NULL)
+ return NULL;
+ /* XXX Could do it nicer and interpret the data structure here,
+ returning a list of lists. But this can be done in Python... */
+ for (i = 0; i < n; i++) {
+ w = newintobject((long)pickbuffer[i]);
+ if (w == NULL) {
+ DECREF(v);
+ return NULL;
+ }
+ setlistitem(v, i, w);
+ }
+ DEL(pickbuffer);
+ pickbuffer = NULL;
+ return v;
+}
+
+extern void pick(), gselect();
+extern long endpick(), endselect();
+
+%pick
+static object *gl_pick(self, args) object *self, *args; {
+ return pick_select(args, pick);
+}
+
+%endpick
+static object *gl_endpick(self, args) object *self, *args; {
+ return endpick_select(args, endpick);
+}
+
+%gselect
+static object *gl_gselect(self, args) object *self, *args; {
+ return pick_select(args, gselect);
+}
+
+%endselect
+static object *gl_endselect(self, args) object *self, *args; {
+ return endpick_select(args, endselect);
+}
+
+
+/* XXX The generator botches this one. Here's a quick hack to fix it. */
+
+% getmatrix float r[16]
+
+static object *
+gl_getmatrix(self, args)
+ object *self;
+ object *args;
+{
+ float arg1 [ 16 ] ;
+ object *v, *w;
+ int i;
+ getmatrix( arg1 );
+ v = newlistobject(16);
+ if (v == NULL) {
+ return err_nomem();
+ }
+ for (i = 0; i < 16; i++) {
+ w = mknewfloatobject(arg1[i]);
+ if (w == NULL) {
+ DECREF(v);
+ return NULL;
+ }
+ setlistitem(v, i, w);
+ }
+ return v;
+}
+
+/* End of manually written stubs */
+
+%%
+
+long getshade
+void devport short s long s
+void rdr2i long s long s
+void rectfs short s short s short s short s
+void rects short s short s short s short s
+void rmv2i long s long s
+void noport
+void popviewport
+void clear
+void clearhitcode
+void closeobj
+void cursoff
+void curson
+void doublebuffer
+void finish
+void gconfig
+void ginit
+void greset
+void multimap
+void onemap
+void popattributes
+void popmatrix
+void pushattributes
+void pushmatrix
+void pushviewport
+void qreset
+void RGBmode
+void singlebuffer
+void swapbuffers
+void gsync
+void tpon
+void tpoff
+void clkon
+void clkoff
+void ringbell
+#void callfunc
+void gbegin
+void textinit
+void initnames
+void pclos
+void popname
+void spclos
+void zclear
+void screenspace
+void reshapeviewport
+void winpush
+void winpop
+void foreground
+void endfullscrn
+void endpupmode
+void fullscrn
+void pupmode
+void winconstraints
+void pagecolor short s
+void textcolor short s
+void color short s
+void curveit short s
+void font short s
+void linewidth short s
+void setlinestyle short s
+void setmap short s
+void swapinterval short s
+void writemask short s
+void textwritemask short s
+void qdevice short s
+void unqdevice short s
+void curvebasis short s
+void curveprecision short s
+void loadname short s
+void passthrough short s
+void pushname short s
+void setmonitor short s
+void setshade short s
+void setpattern short s
+void pagewritemask short s
+#
+void callobj long s
+void delobj long s
+void editobj long s
+void makeobj long s
+void maketag long s
+void chunksize long s
+void compactify long s
+void deltag long s
+void lsrepeat long s
+void objinsert long s
+void objreplace long s
+void winclose long s
+void blanktime long s
+void freepup long s
+# This is not in the library!?
+###void pupcolor long s
+#
+void backbuffer long s
+void frontbuffer long s
+void lsbackup long s
+void resetls long s
+void lampon long s
+void lampoff long s
+void setbell long s
+void blankscreen long s
+void depthcue long s
+void zbuffer long s
+void backface long s
+#
+void cmov2i long s long s
+void draw2i long s long s
+void move2i long s long s
+void pnt2i long s long s
+void patchbasis long s long s
+void patchprecision long s long s
+void pdr2i long s long s
+void pmv2i long s long s
+void rpdr2i long s long s
+void rpmv2i long s long s
+void xfpt2i long s long s
+void objdelete long s long s
+void patchcurves long s long s
+void minsize long s long s
+void maxsize long s long s
+void keepaspect long s long s
+void prefsize long s long s
+void stepunit long s long s
+void fudge long s long s
+void winmove long s long s
+#
+void attachcursor short s short s
+void deflinestyle short s short s
+void noise short s short s
+void picksize short s short s
+void qenter short s short s
+void setdepth short s short s
+void cmov2s short s short s
+void draw2s short s short s
+void move2s short s short s
+void pdr2s short s short s
+void pmv2s short s short s
+void pnt2s short s short s
+void rdr2s short s short s
+void rmv2s short s short s
+void rpdr2s short s short s
+void rpmv2s short s short s
+void xfpt2s short s short s
+#
+void cmov2 float s float s
+void draw2 float s float s
+void move2 float s float s
+void pnt2 float s float s
+void pdr2 float s float s
+void pmv2 float s float s
+void rdr2 float s float s
+void rmv2 float s float s
+void rpdr2 float s float s
+void rpmv2 float s float s
+void xfpt2 float s float s
+#
+void loadmatrix float s[16]
+void multmatrix float s[16]
+void crv float s[16]
+void rcrv float s[16]
+#
+# Methods that have strings.
+#
+void addtopup long s char *s long s
+void charstr char *s
+void getport char *s
+long strwidth char *s
+long winopen char *s
+void wintitle char *s
+#
+# Methods that have 1 long (# of elements) and an array
+#
+void polf long s float s[3*arg1]
+void polf2 long s float s[2*arg1]
+void poly long s float s[3*arg1]
+void poly2 long s float s[2*arg1]
+void crvn long s float s[3*arg1]
+void rcrvn long s float s[4*arg1]
+#
+void polf2i long s long s[2*arg1]
+void polfi long s long s[3*arg1]
+void poly2i long s long s[2*arg1]
+void polyi long s long s[3*arg1]
+#
+void polf2s long s short s[2*arg1]
+void polfs long s short s[3*arg1]
+void polys long s short s[3*arg1]
+void poly2s long s short s[2*arg1]
+#
+void defcursor short s short s[16]
+void writepixels short s short s[arg1]
+void defbasis long s float s[16]
+void gewrite short s short s[arg1]
+#
+void rotate short s char s
+# This is not in the library!?
+###void setbutton short s char s
+void rot float s char s
+#
+void circfi long s long s long s
+void circi long s long s long s
+void cmovi long s long s long s
+void drawi long s long s long s
+void movei long s long s long s
+void pnti long s long s long s
+void newtag long s long s long s
+void pdri long s long s long s
+void pmvi long s long s long s
+void rdri long s long s long s
+void rmvi long s long s long s
+void rpdri long s long s long s
+void rpmvi long s long s long s
+void xfpti long s long s long s
+#
+void circ float s float s float s
+void circf float s float s float s
+void cmov float s float s float s
+void draw float s float s float s
+void move float s float s float s
+void pnt float s float s float s
+void scale float s float s float s
+void translate float s float s float s
+void pdr float s float s float s
+void pmv float s float s float s
+void rdr float s float s float s
+void rmv float s float s float s
+void rpdr float s float s float s
+void rpmv float s float s float s
+void xfpt float s float s float s
+#
+void RGBcolor short s short s short s
+void RGBwritemask short s short s short s
+void setcursor short s short s short s
+void tie short s short s short s
+void circfs short s short s short s
+void circs short s short s short s
+void cmovs short s short s short s
+void draws short s short s short s
+void moves short s short s short s
+void pdrs short s short s short s
+void pmvs short s short s short s
+void pnts short s short s short s
+void rdrs short s short s short s
+void rmvs short s short s short s
+void rpdrs short s short s short s
+void rpmvs short s short s short s
+void xfpts short s short s short s
+void curorigin short s short s short s
+void cyclemap short s short s short s
+#
+void patch float s[16] float s[16] float s[16]
+void splf long s float s[3*arg1] short s[arg1]
+void splf2 long s float s[2*arg1] short s[arg1]
+void splfi long s long s[3*arg1] short s[arg1]
+void splf2i long s long s[2*arg1] short s[arg1]
+void splfs long s short s[3*arg1] short s[arg1]
+void splf2s long s short s[2*arg1] short s[arg1]
+void defpattern short s short s short s[arg2*arg2/16]
+#
+void rpatch float s[16] float s[16] float s[16] float s[16]
+#
+# routines that send 4 floats
+#
+void ortho2 float s float s float s float s
+void rect float s float s float s float s
+void rectf float s float s float s float s
+void xfpt4 float s float s float s float s
+#
+void textport short s short s short s short s
+void mapcolor short s short s short s short s
+void scrmask short s short s short s short s
+void setvaluator short s short s short s short s
+void viewport short s short s short s short s
+void shaderange short s short s short s short s
+void xfpt4s short s short s short s short s
+void rectfi long s long s long s long s
+void recti long s long s long s long s
+void xfpt4i long s long s long s long s
+void prefposition long s long s long s long s
+#
+void arc float s float s float s short s short s
+void arcf float s float s float s short s short s
+void arcfi long s long s long s short s short s
+void arci long s long s long s short s short s
+#
+void bbox2 short s short s float s float s float s float s
+void bbox2i short s short s long s long s long s long s
+void bbox2s short s short s short s short s short s short s
+void blink short s short s short s short s short s
+void ortho float s float s float s float s float s float s
+void window float s float s float s float s float s float s
+void lookat float s float s float s float s float s float s short s
+#
+void perspective short s float s float s float s
+void polarview float s short s short s short s
+# XXX getichararray not supported
+#void writeRGB short s char s[arg1] char s[arg1] char s[arg1]
+#
+void arcfs short s short s short s short s short s
+void arcs short s short s short s short s short s
+void rectcopy short s short s short s short s short s short s
+void RGBcursor short s short s short s short s short s short s short s
+#
+long getbutton short s
+long getcmmode
+long getlsbackup
+long getresetls
+long getdcm
+long getzbuffer
+long ismex
+long isobj long s
+long isqueued short s
+long istag long s
+#
+long genobj
+long gentag
+long getbuffer
+long getcolor
+long getdisplaymode
+long getfont
+long getheight
+long gethitcode
+long getlstyle
+long getlwidth
+long getmap
+long getplanes
+long getwritemask
+long qtest
+long getlsrepeat
+long getmonitor
+long getopenobj
+long getpattern
+long winget
+long winattach
+long getothermonitor
+long newpup
+#
+long getvaluator short s
+void winset long s
+long dopup long s
+void getdepth short r short r
+void getcpos short r short r
+void getsize long r long r
+void getorigin long r long r
+void getviewport short r short r short r short r
+void gettp short r short r short r short r
+void getgpos float r float r float r float r
+void winposition long s long s long s long s
+void gRGBcolor short r short r short r
+void gRGBmask short r short r short r
+void getscrmask short r short r short r short r
+void gRGBcursor short r short r short r short r short r short r short r short r long *
+void getmcolor short s short r short r short r
+void mapw long s short s short s float r float r float r float r float r float r
+void mapw2 long s short s short s float r float r
+void defrasterfont short s short s short s Fontchar s[arg3] short s short s[4*arg5]
+long qread short r
+void getcursor short r short r short r long r
+#
+# For these we receive arrays of stuff
+#
+void getdev long s short s[arg1] short r[arg1]
+#XXX not generated correctly yet
+#void getmatrix float r[16]
+long readpixels short s short r[retval]
+long readRGB short s char r[retval] char r[retval] char r[retval]
+long blkqread short s short r[arg1]
+#
+# New 4D routines
+#
+void cmode
+void concave long s
+void curstype long s
+void drawmode long s
+void gammaramp short s[256] short s[256] short s[256]
+long getbackface
+long getdescender
+long getdrawmode
+long getmmode
+long getsm
+long getvideo long s
+void imakebackground
+void lmbind short s short s
+void lmdef long s long s long s float s[arg3]
+void mmode long s
+void normal float s[3]
+void overlay long s
+void RGBrange short s short s short s short s short s short s short s short s
+void setvideo long s long s
+void shademodel long s
+void underlay long s
+#
+# New Personal Iris/GT Routines
+#
+void bgnclosedline
+void bgnline
+void bgnpoint
+void bgnpolygon
+void bgnsurface
+void bgntmesh
+void bgntrim
+void endclosedline
+void endline
+void endpoint
+void endpolygon
+void endsurface
+void endtmesh
+void endtrim
+void blendfunction long s long s
+void c3f float s[3]
+void c3i long s[3]
+void c3s short s[3]
+void c4f float s[4]
+void c4i long s[4]
+void c4s short s[4]
+void colorf float s
+void cpack long s
+void czclear long s long s
+void dglclose long s
+long dglopen char *s long s
+long getgdesc long s
+void getnurbsproperty long s float r
+void glcompat long s long s
+void iconsize long s long s
+void icontitle char *s
+void lRGBrange short s short s short s short s short s short s long s long s
+void linesmooth long s
+void lmcolor long s
+void logicop long s
+long lrectread short s short s short s short s long r[retval]
+void lrectwrite short s short s short s short s long s[(arg2-arg1+1)*(arg4-arg3+1)]
+long rectread short s short s short s short s short r[retval]
+void rectwrite short s short s short s short s short s[(arg2-arg1+1)*(arg4-arg3+1)]
+void lsetdepth long s long s
+void lshaderange short s short s long s long s
+void n3f float s[3]
+void noborder
+void pntsmooth long s
+void readsource long s
+void rectzoom float s float s
+void sbox float s float s float s float s
+void sboxi long s long s long s long s
+void sboxs short s short s short s short s
+void sboxf float s float s float s float s
+void sboxfi long s long s long s long s
+void sboxfs short s short s short s short s
+void setnurbsproperty long s float s
+void setpup long s long s long s
+void smoothline long s
+void subpixel long s
+void swaptmesh
+long swinopen long s
+void v2f float s[2]
+void v2i long s[2]
+void v2s short s[2]
+void v3f float s[3]
+void v3i long s[3]
+void v3s short s[3]
+void v4f float s[4]
+void v4i long s[4]
+void v4s short s[4]
+void videocmd long s
+long windepth long s
+void wmpack long s
+void zdraw long s
+void zfunction long s
+void zsource long s
+void zwritemask long s
+#
+# uses doubles
+#
+void v2d double s[2]
+void v3d double s[3]
+void v4d double s[4]
diff --git a/src/dictobject.c b/src/dictobject.c
new file mode 100644
index 0000000..3bbd1d5
--- /dev/null
+++ b/src/dictobject.c
@@ -0,0 +1,605 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Dictionary object implementation; using a hash table */
+
+/*
+XXX Note -- although this may look professional, I didn't think very hard
+about the problem and it is possible that obvious improvements exist.
+A similar module that I saw by Chris Torek:
+- uses chaining instead of hashed linear probing
+- remembers the hash value with the entry to speed up table resizing
+- sets the table size to a power of 2
+- uses a different hash function:
+ h = 0; p = str; while (*p) h = (h<<5) - h + *p++;
+*/
+
+#include "allobjects.h"
+
+
+/*
+Table of primes suitable as keys, in ascending order.
+The first line are the largest primes less than some powers of two,
+the second line is the largest prime less than 6000,
+and the third line is a selection from Knuth, Vol. 3, Sec. 6.1, Table 1.
+The final value is a sentinel and should cause the memory allocation
+of that many entries to fail (if none of the earlier values cause such
+failure already).
+*/
+static unsigned int primes[] = {
+ 3, 7, 13, 31, 61, 127, 251, 509, 1021, 2017, 4093,
+ 5987,
+ 9551, 15683, 19609, 31397,
+ 0xffffffff /* All bits set -- truncation OK */
+};
+
+/* String used as dummy key to fill deleted entries */
+static stringobject *dummy; /* Initialized by first call to newdictobject() */
+
+/*
+Invariant for entries: when in use, de_value is not NULL and de_key is
+not NULL and not dummy; when not in use, de_value is NULL and de_key
+is either NULL or dummy. A dummy key value cannot be replaced by NULL,
+since otherwise other keys may be lost.
+*/
+typedef struct {
+ stringobject *de_key;
+ object *de_value;
+} dictentry;
+
+/*
+To ensure the lookup algorithm terminates, the table size must be a
+prime number and there must be at least one NULL key in the table.
+The value di_fill is the number of non-NULL keys; di_used is the number
+of non-NULL, non-dummy keys.
+To avoid slowing down lookups on a near-full table, we resize the table
+when it is more than half filled.
+*/
+typedef struct {
+ OB_HEAD
+ int di_fill;
+ int di_used;
+ int di_size;
+ dictentry *di_table;
+} dictobject;
+
+object *
+newdictobject()
+{
+ register dictobject *dp;
+ if (dummy == NULL) { /* Auto-initialize dummy */
+ dummy = (stringobject *) newstringobject("");
+ if (dummy == NULL)
+ return NULL;
+ }
+ dp = NEWOBJ(dictobject, &Dicttype);
+ if (dp == NULL)
+ return NULL;
+ dp->di_size = primes[0];
+ dp->di_table = (dictentry *) calloc(sizeof(dictentry), dp->di_size);
+ if (dp->di_table == NULL) {
+ DEL(dp);
+ return err_nomem();
+ }
+ dp->di_fill = 0;
+ dp->di_used = 0;
+ return (object *)dp;
+}
+
+/*
+The basic lookup function used by all operations.
+This is essentially Algorithm D from Knuth Vol. 3, Sec. 6.4.
+Open addressing is preferred over chaining since the link overhead for
+chaining would be substantial (100% with typical malloc overhead).
+
+First a 32-bit hash value, 'sum', is computed from the key string.
+The first character is added an extra time shifted by 8 to avoid hashing
+single-character keys (often heavily used variables) too close together.
+All arithmetic on sum should ignore overflow.
+
+The initial probe index is then computed as sum mod the table size.
+Subsequent probe indices are incr apart (mod table size), where incr
+is also derived from sum, with the additional requirement that it is
+relative prime to the table size (i.e., 1 <= incr < size, since the size
+is a prime number). My choice for incr is somewhat arbitrary.
+*/
+static dictentry *lookdict PROTO((dictobject *, char *));
+static dictentry *
+lookdict(dp, key)
+ register dictobject *dp;
+ char *key;
+{
+ register int i, incr;
+ register dictentry *freeslot = NULL;
+ register unsigned char *p = (unsigned char *) key;
+ register unsigned long sum = *p << 7;
+ while (*p != '\0')
+ sum = sum + sum + *p++;
+ i = sum % dp->di_size;
+ do {
+ sum = sum + sum + 1;
+ incr = sum % dp->di_size;
+ } while (incr == 0);
+ for (;;) {
+ register dictentry *ep = &dp->di_table[i];
+ if (ep->de_key == NULL) {
+ if (freeslot != NULL)
+ return freeslot;
+ else
+ return ep;
+ }
+ if (ep->de_key == dummy) {
+ if (freeslot != NULL)
+ freeslot = ep;
+ }
+ else if (GETSTRINGVALUE(ep->de_key)[0] == key[0]) {
+ if (strcmp(GETSTRINGVALUE(ep->de_key), key) == 0) {
+ return ep;
+ }
+ }
+ i = (i + incr) % dp->di_size;
+ }
+}
+
+/*
+Internal routine to insert a new item into the table.
+Used both by the internal resize routine and by the public insert routine.
+Eats a reference to key and one to value.
+*/
+static void insertdict PROTO((dictobject *, stringobject *, object *));
+static void
+insertdict(dp, key, value)
+ register dictobject *dp;
+ stringobject *key;
+ object *value;
+{
+ register dictentry *ep;
+ ep = lookdict(dp, GETSTRINGVALUE(key));
+ if (ep->de_value != NULL) {
+ DECREF(ep->de_value);
+ DECREF(key);
+ }
+ else {
+ if (ep->de_key == NULL)
+ dp->di_fill++;
+ else
+ DECREF(ep->de_key);
+ ep->de_key = key;
+ dp->di_used++;
+ }
+ ep->de_value = value;
+}
+
+/*
+Restructure the table by allocating a new table and reinserting all
+items again. When entries have been deleted, the new table may
+actually be smaller than the old one.
+*/
+static int dictresize PROTO((dictobject *));
+static int
+dictresize(dp)
+ dictobject *dp;
+{
+ register int oldsize = dp->di_size;
+ register int newsize;
+ register dictentry *oldtable = dp->di_table;
+ register dictentry *newtable;
+ register dictentry *ep;
+ register int i;
+ newsize = dp->di_size;
+ for (i = 0; ; i++) {
+ if (primes[i] > dp->di_used*2) {
+ newsize = primes[i];
+ break;
+ }
+ }
+ newtable = (dictentry *) calloc(sizeof(dictentry), newsize);
+ if (newtable == NULL) {
+ err_nomem();
+ return -1;
+ }
+ dp->di_size = newsize;
+ dp->di_table = newtable;
+ dp->di_fill = 0;
+ dp->di_used = 0;
+ for (i = 0, ep = oldtable; i < oldsize; i++, ep++) {
+ if (ep->de_value != NULL)
+ insertdict(dp, ep->de_key, ep->de_value);
+ else if (ep->de_key != NULL)
+ DECREF(ep->de_key);
+ }
+ DEL(oldtable);
+ return 0;
+}
+
+object *
+dictlookup(op, key)
+ object *op;
+ char *key;
+{
+ if (!is_dictobject(op))
+ fatal("dictlookup on non-dictionary");
+ return lookdict((dictobject *)op, key) -> de_value;
+}
+
+#ifdef NOT_USED
+static object *
+dict2lookup(op, key)
+ register object *op;
+ register object *key;
+{
+ register object *res;
+ if (!is_dictobject(op)) {
+ err_badcall();
+ return NULL;
+ }
+ if (!is_stringobject(key)) {
+ err_badarg();
+ return NULL;
+ }
+ res = lookdict((dictobject *)op, ((stringobject *)key)->ob_sval)
+ -> de_value;
+ if (res == NULL)
+ err_setstr(KeyError, "key not in dictionary");
+ return res;
+}
+#endif
+
+static int
+dict2insert(op, key, value)
+ register object *op;
+ object *key;
+ object *value;
+{
+ register dictobject *dp;
+ register stringobject *keyobj;
+ if (!is_dictobject(op)) {
+ err_badcall();
+ return -1;
+ }
+ dp = (dictobject *)op;
+ if (!is_stringobject(key)) {
+ err_badarg();
+ return -1;
+ }
+ keyobj = (stringobject *)key;
+ /* if fill >= 2/3 size, resize */
+ if (dp->di_fill*3 >= dp->di_size*2) {
+ if (dictresize(dp) != 0) {
+ if (dp->di_fill+1 > dp->di_size)
+ return -1;
+ }
+ }
+ INCREF(keyobj);
+ INCREF(value);
+ insertdict(dp, keyobj, value);
+ return 0;
+}
+
+int
+dictinsert(op, key, value)
+ object *op;
+ char *key;
+ object *value;
+{
+ register object *keyobj;
+ register int err;
+ keyobj = newstringobject(key);
+ if (keyobj == NULL) {
+ err_nomem();
+ return -1;
+ }
+ err = dict2insert(op, keyobj, value);
+ DECREF(keyobj);
+ return err;
+}
+
+int
+dictremove(op, key)
+ object *op;
+ char *key;
+{
+ register dictobject *dp;
+ register dictentry *ep;
+ if (!is_dictobject(op)) {
+ err_badcall();
+ return -1;
+ }
+ dp = (dictobject *)op;
+ ep = lookdict(dp, key);
+ if (ep->de_value == NULL) {
+ err_setstr(KeyError, "key not in dictionary");
+ return -1;
+ }
+ DECREF(ep->de_key);
+ INCREF(dummy);
+ ep->de_key = dummy;
+ DECREF(ep->de_value);
+ ep->de_value = NULL;
+ dp->di_used--;
+ return 0;
+}
+
+static int
+dict2remove(op, key)
+ object *op;
+ register object *key;
+{
+ if (!is_stringobject(key)) {
+ err_badarg();
+ return -1;
+ }
+ return dictremove(op, GETSTRINGVALUE((stringobject *)key));
+}
+
+int
+getdictsize(op)
+ register object *op;
+{
+ if (!is_dictobject(op)) {
+ err_badcall();
+ return -1;
+ }
+ return ((dictobject *)op) -> di_size;
+}
+
+static object *
+getdict2key(op, i)
+ object *op;
+ register int i;
+{
+ /* XXX This can't return errors since its callers assume
+ that NULL means there was no key at that point */
+ register dictobject *dp;
+ if (!is_dictobject(op)) {
+ /* err_badcall(); */
+ return NULL;
+ }
+ dp = (dictobject *)op;
+ if (i < 0 || i >= dp->di_size) {
+ /* err_badarg(); */
+ return NULL;
+ }
+ if (dp->di_table[i].de_value == NULL) {
+ /* Not an error! */
+ return NULL;
+ }
+ return (object *) dp->di_table[i].de_key;
+}
+
+char *
+getdictkey(op, i)
+ object *op;
+ int i;
+{
+ register object *keyobj = getdict2key(op, i);
+ if (keyobj == NULL)
+ return NULL;
+ return GETSTRINGVALUE((stringobject *)keyobj);
+}
+
+/* Methods */
+
+static void
+dict_dealloc(dp)
+ register dictobject *dp;
+{
+ register int i;
+ register dictentry *ep;
+ for (i = 0, ep = dp->di_table; i < dp->di_size; i++, ep++) {
+ if (ep->de_key != NULL)
+ DECREF(ep->de_key);
+ if (ep->de_value != NULL)
+ DECREF(ep->de_value);
+ }
+ if (dp->di_table != NULL)
+ DEL(dp->di_table);
+ DEL(dp);
+}
+
+static void
+dict_print(dp, fp, flags)
+ register dictobject *dp;
+ register FILE *fp;
+ register int flags;
+{
+ register int i;
+ register int any;
+ register dictentry *ep;
+ fprintf(fp, "{");
+ any = 0;
+ for (i = 0, ep = dp->di_table; i < dp->di_size && !StopPrint;
+ i++, ep++) {
+ if (ep->de_value != NULL) {
+ if (any++ > 0)
+ fprintf(fp, "; ");
+ printobject((object *)ep->de_key, fp, flags);
+ fprintf(fp, ": ");
+ printobject(ep->de_value, fp, flags);
+ }
+ }
+ fprintf(fp, "}");
+}
+
+static void
+js(pv, w)
+ object **pv;
+ object *w;
+{
+ joinstring(pv, w);
+ if (w != NULL)
+ DECREF(w);
+}
+
+static object *
+dict_repr(dp)
+ dictobject *dp;
+{
+ auto object *v;
+ register object *w;
+ object *semi, *colon;
+ register int i;
+ register int any;
+ register dictentry *ep;
+ v = newstringobject("{");
+ semi = newstringobject("; ");
+ colon = newstringobject(": ");
+ any = 0;
+ for (i = 0, ep = dp->di_table; i < dp->di_size && !StopPrint;
+ i++, ep++) {
+ if (ep->de_value != NULL) {
+ if (any++)
+ joinstring(&v, semi);
+ js(&v, w = reprobject((object *)ep->de_key));
+ joinstring(&v, colon);
+ js(&v, w = reprobject(ep->de_value));
+ }
+ }
+ js(&v, w = newstringobject("}"));
+ if (semi != NULL)
+ DECREF(semi);
+ if (colon != NULL)
+ DECREF(colon);
+ return v;
+}
+
+static int
+dict_length(dp)
+ dictobject *dp;
+{
+ return dp->di_used;
+}
+
+static object *
+dict_subscript(dp, v)
+ dictobject *dp;
+ register object *v;
+{
+ if (!is_stringobject(v)) {
+ err_badarg();
+ return NULL;
+ }
+ v = lookdict(dp, GETSTRINGVALUE((stringobject *)v)) -> de_value;
+ if (v == NULL)
+ err_setstr(KeyError, "key not in dictionary");
+ else
+ INCREF(v);
+ return v;
+}
+
+static int
+dict_ass_sub(dp, v, w)
+ dictobject *dp;
+ object *v, *w;
+{
+ if (w == NULL)
+ return dict2remove((object *)dp, v);
+ else
+ return dict2insert((object *)dp, v, w);
+}
+
+static mapping_methods dict_as_mapping = {
+ dict_length, /*mp_length*/
+ dict_subscript, /*mp_subscript*/
+ dict_ass_sub, /*mp_ass_subscript*/
+};
+
+static object *
+dict_keys(dp, args)
+ register dictobject *dp;
+ object *args;
+{
+ register object *v;
+ register int i, j;
+ if (!getnoarg(args))
+ return NULL;
+ v = newlistobject(dp->di_used);
+ if (v == NULL)
+ return NULL;
+ for (i = 0, j = 0; i < dp->di_size; i++) {
+ if (dp->di_table[i].de_value != NULL) {
+ stringobject *key = dp->di_table[i].de_key;
+ INCREF(key);
+ setlistitem(v, j, (object *)key);
+ j++;
+ }
+ }
+ return v;
+}
+
+object *
+getdictkeys(dp)
+ object *dp;
+{
+ if (dp == NULL || !is_dictobject(dp)) {
+ err_badcall();
+ return NULL;
+ }
+ return dict_keys((dictobject *)dp, (object *)NULL);
+}
+
+static object *
+dict_has_key(dp, args)
+ register dictobject *dp;
+ object *args;
+{
+ object *key;
+ register long ok;
+ if (!getstrarg(args, &key))
+ return NULL;
+ ok = lookdict(dp, GETSTRINGVALUE((stringobject *)key))->de_value
+ != NULL;
+ return newintobject(ok);
+}
+
+static struct methodlist dict_methods[] = {
+ {"keys", dict_keys},
+ {"has_key", dict_has_key},
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+dict_getattr(dp, name)
+ dictobject *dp;
+ char *name;
+{
+ return findmethod(dict_methods, (object *)dp, name);
+}
+
+typeobject Dicttype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "dictionary",
+ sizeof(dictobject),
+ 0,
+ dict_dealloc, /*tp_dealloc*/
+ dict_print, /*tp_print*/
+ dict_getattr, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ dict_repr, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ &dict_as_mapping, /*tp_as_mapping*/
+};
diff --git a/src/dictobject.h b/src/dictobject.h
new file mode 100644
index 0000000..d665aa5
--- /dev/null
+++ b/src/dictobject.h
@@ -0,0 +1,44 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/*
+Dictionary object type -- mapping from char * to object.
+NB: the key is given as a char *, not as a stringobject.
+These functions set errno for errors. Functions dictremove() and
+dictinsert() return nonzero for errors, getdictsize() returns -1,
+the others NULL. A successful call to dictinsert() calls INCREF()
+for the inserted item.
+*/
+
+extern typeobject Dicttype;
+
+#define is_dictobject(op) ((op)->ob_type == &Dicttype)
+
+extern object *newdictobject PROTO((void));
+extern object *dictlookup PROTO((object *dp, char *key));
+extern int dictinsert PROTO((object *dp, char *key, object *item));
+extern int dictremove PROTO((object *dp, char *key));
+extern int getdictsize PROTO((object *dp));
+extern char *getdictkey PROTO((object *dp, int i));
+extern object *getdictkeys PROTO((object *dp));
diff --git a/src/errcode.h b/src/errcode.h
new file mode 100644
index 0000000..3324489
--- /dev/null
+++ b/src/errcode.h
@@ -0,0 +1,36 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Error codes passed around between file input, tokenizer, parser and
+ interpreter. This was necessary so we can turn them into Python
+ exceptions at a higher level. */
+
+#define E_OK 10 /* No error */
+#define E_EOF 11 /* (Unexpected) EOF read */
+#define E_INTR 12 /* Interrupted */
+#define E_TOKEN 13 /* Bad token */
+#define E_SYNTAX 14 /* Syntax error */
+#define E_NOMEM 15 /* Ran out of memory */
+#define E_DONE 16 /* Parsing complete */
+#define E_ERROR 17 /* Execution error */
diff --git a/src/errors.c b/src/errors.c
new file mode 100644
index 0000000..b3e6aa3
--- /dev/null
+++ b/src/errors.c
@@ -0,0 +1,196 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Error handling -- see also run.c */
+
+/* New error handling interface.
+
+ The following problem exists (existed): methods of built-in modules
+ are called with 'self' and 'args' arguments, but without a context
+ argument, so they have no way to raise a specific exception.
+ The same is true for the object implementations: no context argument.
+ The old convention was to set 'errno' and to return NULL.
+ The caller (usually call_function() in eval.c) detects the NULL
+ return value and then calls puterrno(ctx) to turn the errno value
+ into a true exception. Problems with this approach are:
+ - it used standard errno values to indicate Python-specific errors,
+ but this means that when such an error code is reported by a system
+ call (e.g., in module posix), the user gets a confusing message
+ - errno is a global variable, which makes extensions to a multi-
+ threading environment difficult; e.g., in IRIX, multi-threaded
+ programs must use the function oserror() instead of looking in errno
+ - there is no portable way to add new error numbers for specic
+ situations -- the value space for errno is reserved to the OS, yet
+ the way to turn module-specific errors into a module-specific
+ exception requires module-specific values for errno
+ - there is no way to add a more situation-specific message to an
+ error.
+
+ The new interface solves all these problems. To return an error, a
+ built-in function calls err_set(exception), err_setval(exception,
+ value) or err_setstr(exception, string), and returns NULL. These
+ functions save the value for later use by puterrno(). To adapt this
+ scheme to a multi-threaded environment, only the implementation of
+ err_setval() has to be changed.
+*/
+
+#include "allobjects.h"
+
+#include <errno.h>
+#ifndef errno
+extern int errno;
+#endif
+
+#include "errcode.h"
+
+extern char *strerror PROTO((int));
+
+/* Last exception stored by err_setval() */
+
+static object *last_exception;
+static object *last_exc_val;
+
+void
+err_setval(exception, value)
+ object *exception;
+ object *value;
+{
+ XDECREF(last_exception);
+ XINCREF(exception);
+ last_exception = exception;
+
+ XDECREF(last_exc_val);
+ XINCREF(value);
+ last_exc_val = value;
+}
+
+void
+err_set(exception)
+ object *exception;
+{
+ err_setval(exception, (object *)NULL);
+}
+
+void
+err_setstr(exception, string)
+ object *exception;
+ char *string;
+{
+ object *value = newstringobject(string);
+ err_setval(exception, value);
+ XDECREF(value);
+}
+
+int
+err_occurred()
+{
+ return last_exception != NULL;
+}
+
+void
+err_get(p_exc, p_val)
+ object **p_exc;
+ object **p_val;
+{
+ *p_exc = last_exception;
+ last_exception = NULL;
+ *p_val = last_exc_val;
+ last_exc_val = NULL;
+}
+
+void
+err_clear()
+{
+ XDECREF(last_exception);
+ last_exception = NULL;
+ XDECREF(last_exc_val);
+ last_exc_val = NULL;
+}
+
+/* Convenience functions to set a type error exception and return 0 */
+
+int
+err_badarg()
+{
+ err_setstr(TypeError, "illegal argument type for built-in operation");
+ return 0;
+}
+
+object *
+err_nomem()
+{
+ err_set(MemoryError);
+ return NULL;
+}
+
+object *
+err_errno(exc)
+ object *exc;
+{
+ object *v = newtupleobject(2);
+ if (v != NULL) {
+ settupleitem(v, 0, newintobject((long)errno));
+ settupleitem(v, 1, newstringobject(strerror(errno)));
+ }
+ err_setval(exc, v);
+ XDECREF(v);
+ return NULL;
+}
+
+void
+err_badcall()
+{
+ err_setstr(SystemError, "bad argument to internal function");
+}
+
+/* Set the error appropriate to the given input error code (see errcode.h) */
+
+void
+err_input(err)
+ int err;
+{
+ switch (err) {
+ case E_DONE:
+ case E_OK:
+ break;
+ case E_SYNTAX:
+ err_setstr(RuntimeError, "syntax error");
+ break;
+ case E_TOKEN:
+ err_setstr(RuntimeError, "illegal token");
+ break;
+ case E_INTR:
+ err_set(KeyboardInterrupt);
+ break;
+ case E_NOMEM:
+ err_nomem();
+ break;
+ case E_EOF:
+ err_set(EOFError);
+ break;
+ default:
+ err_setstr(RuntimeError, "unknown input error");
+ break;
+ }
+}
diff --git a/src/errors.h b/src/errors.h
new file mode 100644
index 0000000..4baa142
--- /dev/null
+++ b/src/errors.h
@@ -0,0 +1,58 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Error handling definitions */
+
+void err_set PROTO((object *));
+void err_setval PROTO((object *, object *));
+void err_setstr PROTO((object *, char *));
+int err_occurred PROTO((void));
+void err_get PROTO((object **, object **));
+void err_clear PROTO((void));
+
+/* Predefined exceptions */
+
+extern object *RuntimeError;
+extern object *EOFError;
+extern object *TypeError;
+extern object *MemoryError;
+extern object *NameError;
+extern object *SystemError;
+extern object *KeyboardInterrupt;
+
+/* Some more planned for the future */
+
+#define IndexError RuntimeError
+#define KeyError RuntimeError
+#define ZeroDivisionError RuntimeError
+#define OverflowError RuntimeError
+
+/* Convenience functions */
+
+extern int err_badarg PROTO((void));
+extern object *err_nomem PROTO((void));
+extern object *err_errno PROTO((object *));
+extern void err_input PROTO((int));
+
+extern void err_badcall PROTO((void));
diff --git a/src/fgetsintr.c b/src/fgetsintr.c
new file mode 100644
index 0000000..bda1ed8
--- /dev/null
+++ b/src/fgetsintr.c
@@ -0,0 +1,94 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Interruptable version of fgets().
+ Return < 0 for interrupted, 1 for EOF, 0 for valid input. */
+
+/* XXX This uses longjmp() from a signal out of fgets().
+ Should use read() instead?! */
+
+#include "pgenheaders.h"
+
+#include <signal.h>
+#include <setjmp.h>
+
+#include "errcode.h"
+#include "sigtype.h"
+#include "fgetsintr.h"
+
+#ifndef AMOEBA
+#define sig_block() /*empty*/
+#define sig_unblock() /*empty*/
+#endif
+
+static jmp_buf jback;
+
+static void catcher PROTO((int));
+
+static void
+catcher(sig)
+ int sig;
+{
+ longjmp(jback, 1);
+}
+
+int
+fgets_intr(buf, size, fp)
+ char *buf;
+ int size;
+ FILE *fp;
+{
+ int ret;
+ SIGTYPE (*sigsave)();
+
+ if (setjmp(jback)) {
+ clearerr(fp);
+ signal(SIGINT, sigsave);
+#ifdef THINK_C_3_0
+ Set_Echo(1);
+#endif
+ return E_INTR;
+ }
+
+ /* The casts to (SIGTYPE(*)()) are needed by THINK_C only */
+
+ sigsave = signal(SIGINT, (SIGTYPE(*)()) SIG_IGN);
+ if (sigsave != (SIGTYPE(*)()) SIG_IGN)
+ signal(SIGINT, (SIGTYPE(*)()) catcher);
+
+#ifndef THINK_C
+ if (intrcheck())
+ ret = E_INTR;
+ else
+#endif
+ {
+ sig_block();
+ ret = (fgets(buf, size, fp) == NULL) ? E_EOF : E_OK;
+ sig_unblock();
+ }
+
+ if (sigsave != (SIGTYPE(*)()) SIG_IGN)
+ signal(SIGINT, (SIGTYPE(*)()) sigsave);
+ return ret;
+}
diff --git a/src/fgetsintr.h b/src/fgetsintr.h
new file mode 100644
index 0000000..87f1d2a
--- /dev/null
+++ b/src/fgetsintr.h
@@ -0,0 +1,25 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+extern int fgets_intr PROTO((char *, int, FILE *));
diff --git a/src/fileobject.c b/src/fileobject.c
new file mode 100644
index 0000000..640e27b
--- /dev/null
+++ b/src/fileobject.c
@@ -0,0 +1,293 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* File object implementation */
+
+/* XXX This should become a built-in module 'io'. It should support more
+ functionality, better exception handling for invalid calls, etc.
+ (Especially reading on a write-only file or vice versa!)
+ It should also cooperate with posix to support popen(), which should
+ share most code but have a special close function. */
+
+#include "allobjects.h"
+
+#include "errno.h"
+#ifndef errno
+extern int errno;
+#endif
+
+typedef struct {
+ OB_HEAD
+ FILE *f_fp;
+ object *f_name;
+ object *f_mode;
+ /* XXX Should move the 'need space' on printing flag here */
+} fileobject;
+
+FILE *
+getfilefile(f)
+ object *f;
+{
+ if (!is_fileobject(f)) {
+ err_badcall();
+ return NULL;
+ }
+ return ((fileobject *)f)->f_fp;
+}
+
+object *
+newopenfileobject(fp, name, mode)
+ FILE *fp;
+ char *name;
+ char *mode;
+{
+ fileobject *f = NEWOBJ(fileobject, &Filetype);
+ if (f == NULL)
+ return NULL;
+ f->f_fp = NULL;
+ f->f_name = newstringobject(name);
+ f->f_mode = newstringobject(mode);
+ if (f->f_name == NULL || f->f_mode == NULL) {
+ DECREF(f);
+ return NULL;
+ }
+ f->f_fp = fp;
+ return (object *) f;
+}
+
+object *
+newfileobject(name, mode)
+ char *name, *mode;
+{
+ fileobject *f;
+ FILE *fp;
+ f = (fileobject *) newopenfileobject((FILE *)NULL, name, mode);
+ if (f == NULL)
+ return NULL;
+#ifdef THINK_C
+ if (*mode == '*') {
+ FILE *fopenRF();
+ f->f_fp = fopenRF(name, mode+1);
+ }
+ else
+#endif
+ f->f_fp = fopen(name, mode);
+ if (f->f_fp == NULL) {
+ err_errno(RuntimeError);
+ DECREF(f);
+ return NULL;
+ }
+ return (object *)f;
+}
+
+/* Methods */
+
+static void
+file_dealloc(f)
+ fileobject *f;
+{
+ if (f->f_fp != NULL)
+ fclose(f->f_fp);
+ if (f->f_name != NULL)
+ DECREF(f->f_name);
+ if (f->f_mode != NULL)
+ DECREF(f->f_mode);
+ free((char *)f);
+}
+
+static void
+file_print(f, fp, flags)
+ fileobject *f;
+ FILE *fp;
+ int flags;
+{
+ fprintf(fp, "<%s file ", f->f_fp == NULL ? "closed" : "open");
+ printobject(f->f_name, fp, flags);
+ fprintf(fp, ", mode ");
+ printobject(f->f_mode, fp, flags);
+ fprintf(fp, ">");
+}
+
+static object *
+file_repr(f)
+ fileobject *f;
+{
+ char buf[300];
+ /* XXX This differs from file_print if the filename contains
+ quotes or other funny characters. */
+ sprintf(buf, "<%s file '%.256s', mode '%.10s'>",
+ f->f_fp == NULL ? "closed" : "open",
+ getstringvalue(f->f_name),
+ getstringvalue(f->f_mode));
+ return newstringobject(buf);
+}
+
+static object *
+file_close(f, args)
+ fileobject *f;
+ object *args;
+{
+ if (args != NULL) {
+ err_badarg();
+ return NULL;
+ }
+ if (f->f_fp != NULL) {
+ fclose(f->f_fp);
+ f->f_fp = NULL;
+ }
+ INCREF(None);
+ return None;
+}
+
+static object *
+file_read(f, args)
+ fileobject *f;
+ object *args;
+{
+ int n;
+ object *v;
+ if (f->f_fp == NULL) {
+ err_badarg();
+ return NULL;
+ }
+ if (args == NULL || !is_intobject(args)) {
+ err_badarg();
+ return NULL;
+ }
+ n = getintvalue(args);
+ if (n < 0) {
+ err_badarg();
+ return NULL;
+ }
+ v = newsizedstringobject((char *)NULL, n);
+ if (v == NULL)
+ return NULL;
+ n = fread(getstringvalue(v), 1, n, f->f_fp);
+ /* EOF is reported as an empty string */
+ /* XXX should detect real I/O errors? */
+ resizestring(&v, n);
+ return v;
+}
+
+/* XXX Should this be unified with raw_input()? */
+
+static object *
+file_readline(f, args)
+ fileobject *f;
+ object *args;
+{
+ int n;
+ object *v;
+ if (f->f_fp == NULL) {
+ err_badarg();
+ return NULL;
+ }
+ if (args == NULL) {
+ n = 10000; /* XXX should really be unlimited */
+ }
+ else if (is_intobject(args)) {
+ n = getintvalue(args);
+ if (n < 0) {
+ err_badarg();
+ return NULL;
+ }
+ }
+ else {
+ err_badarg();
+ return NULL;
+ }
+ v = newsizedstringobject((char *)NULL, n);
+ if (v == NULL)
+ return NULL;
+#ifndef THINK_C_3_0
+ /* XXX Think C 3.0 wrongly reads up to n characters... */
+ n = n+1;
+#endif
+ if (fgets(getstringvalue(v), n, f->f_fp) == NULL) {
+ /* EOF is reported as an empty string */
+ /* XXX should detect real I/O errors? */
+ n = 0;
+ }
+ else {
+ n = strlen(getstringvalue(v));
+ }
+ resizestring(&v, n);
+ return v;
+}
+
+static object *
+file_write(f, args)
+ fileobject *f;
+ object *args;
+{
+ int n, n2;
+ if (f->f_fp == NULL) {
+ err_badarg();
+ return NULL;
+ }
+ if (args == NULL || !is_stringobject(args)) {
+ err_badarg();
+ return NULL;
+ }
+ errno = 0;
+ n2 = fwrite(getstringvalue(args), 1, n = getstringsize(args), f->f_fp);
+ if (n2 != n) {
+ if (errno == 0)
+ errno = EIO;
+ err_errno(RuntimeError);
+ return NULL;
+ }
+ INCREF(None);
+ return None;
+}
+
+static struct methodlist file_methods[] = {
+ {"write", file_write},
+ {"read", file_read},
+ {"readline", file_readline},
+ {"close", file_close},
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+file_getattr(f, name)
+ fileobject *f;
+ char *name;
+{
+ return findmethod(file_methods, (object *)f, name);
+}
+
+typeobject Filetype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "file",
+ sizeof(fileobject),
+ 0,
+ file_dealloc, /*tp_dealloc*/
+ file_print, /*tp_print*/
+ file_getattr, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ file_repr, /*tp_repr*/
+};
diff --git a/src/fileobject.h b/src/fileobject.h
new file mode 100644
index 0000000..eefae74
--- /dev/null
+++ b/src/fileobject.h
@@ -0,0 +1,33 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* File object interface */
+
+extern typeobject Filetype;
+
+#define is_fileobject(op) ((op)->ob_type == &Filetype)
+
+extern object *newfileobject PROTO((char *, char *));
+extern object *newopenfileobject PROTO((FILE *, char *, char *));
+extern FILE *getfilefile PROTO((object *));
diff --git a/src/firstsets.c b/src/firstsets.c
new file mode 100644
index 0000000..6bd7ce0
--- /dev/null
+++ b/src/firstsets.c
@@ -0,0 +1,133 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Computation of FIRST stets */
+
+#include "pgenheaders.h"
+#include "grammar.h"
+#include "token.h"
+
+extern int debugging;
+
+/* Forward */
+static void calcfirstset PROTO((grammar *, dfa *));
+
+void
+addfirstsets(g)
+ grammar *g;
+{
+ int i;
+ dfa *d;
+
+ printf("Adding FIRST sets ...\n");
+ for (i = 0; i < g->g_ndfas; i++) {
+ d = &g->g_dfa[i];
+ if (d->d_first == NULL)
+ calcfirstset(g, d);
+ }
+}
+
+static void
+calcfirstset(g, d)
+ grammar *g;
+ dfa *d;
+{
+ int i, j;
+ state *s;
+ arc *a;
+ int nsyms;
+ int *sym;
+ int nbits;
+ static bitset dummy;
+ bitset result;
+ int type;
+ dfa *d1;
+ label *l0;
+
+ if (debugging)
+ printf("Calculate FIRST set for '%s'\n", d->d_name);
+
+ if (dummy == NULL)
+ dummy = newbitset(1);
+ if (d->d_first == dummy) {
+ fprintf(stderr, "Left-recursion for '%s'\n", d->d_name);
+ return;
+ }
+ if (d->d_first != NULL) {
+ fprintf(stderr, "Re-calculating FIRST set for '%s' ???\n",
+ d->d_name);
+ }
+ d->d_first = dummy;
+
+ l0 = g->g_ll.ll_label;
+ nbits = g->g_ll.ll_nlabels;
+ result = newbitset(nbits);
+
+ sym = NEW(int, 1);
+ if (sym == NULL)
+ fatal("no mem for new sym in calcfirstset");
+ nsyms = 1;
+ sym[0] = findlabel(&g->g_ll, d->d_type, (char *)NULL);
+
+ s = &d->d_state[d->d_initial];
+ for (i = 0; i < s->s_narcs; i++) {
+ a = &s->s_arc[i];
+ for (j = 0; j < nsyms; j++) {
+ if (sym[j] == a->a_lbl)
+ break;
+ }
+ if (j >= nsyms) { /* New label */
+ RESIZE(sym, int, nsyms + 1);
+ if (sym == NULL)
+ fatal("no mem to resize sym in calcfirstset");
+ sym[nsyms++] = a->a_lbl;
+ type = l0[a->a_lbl].lb_type;
+ if (ISNONTERMINAL(type)) {
+ d1 = finddfa(g, type);
+ if (d1->d_first == dummy) {
+ fprintf(stderr,
+ "Left-recursion below '%s'\n",
+ d->d_name);
+ }
+ else {
+ if (d1->d_first == NULL)
+ calcfirstset(g, d1);
+ mergebitset(result, d1->d_first, nbits);
+ }
+ }
+ else if (ISTERMINAL(type)) {
+ addbit(result, a->a_lbl);
+ }
+ }
+ }
+ d->d_first = result;
+ if (debugging) {
+ printf("FIRST set for '%s': {", d->d_name);
+ for (i = 0; i < nbits; i++) {
+ if (testbit(result, i))
+ printf(" %s", labelrepr(&l0[i]));
+ }
+ printf(" }\n");
+ }
+}
diff --git a/src/floatobject.c b/src/floatobject.c
new file mode 100644
index 0000000..c637989
--- /dev/null
+++ b/src/floatobject.c
@@ -0,0 +1,271 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Float object implementation */
+
+/* XXX There should be overflow checks here, but it's hard to check
+ for any kind of float exception without losing portability. */
+
+#include "allobjects.h"
+
+#include <errno.h>
+#ifndef errno
+extern int errno;
+#endif
+
+#include <ctype.h>
+#include <math.h>
+
+#ifndef THINK_C
+extern double fmod PROTO((double, double));
+extern double pow PROTO((double, double));
+#endif
+
+object *
+newfloatobject(fval)
+ double fval;
+{
+ /* For efficiency, this code is copied from newobject() */
+ register floatobject *op = (floatobject *) malloc(sizeof(floatobject));
+ if (op == NULL)
+ return err_nomem();
+ NEWREF(op);
+ op->ob_type = &Floattype;
+ op->ob_fval = fval;
+ return (object *) op;
+}
+
+double
+getfloatvalue(op)
+ object *op;
+{
+ if (!is_floatobject(op)) {
+ err_badarg();
+ return -1;
+ }
+ else
+ return ((floatobject *)op) -> ob_fval;
+}
+
+/* Methods */
+
+static void
+float_buf_repr(buf, v)
+ char *buf;
+ floatobject *v;
+{
+ register char *cp;
+ /* Subroutine for float_repr and float_print.
+ We want float numbers to be recognizable as such,
+ i.e., they should contain a decimal point or an exponent.
+ However, %g may print the number as an integer;
+ in such cases, we append ".0" to the string. */
+ sprintf(buf, "%.12g", v->ob_fval);
+ cp = buf;
+ if (*cp == '-')
+ cp++;
+ for (; *cp != '\0'; cp++) {
+ /* Any non-digit means it's not an integer;
+ this takes care of NAN and INF as well. */
+ if (!isdigit(*cp))
+ break;
+ }
+ if (*cp == '\0') {
+ *cp++ = '.';
+ *cp++ = '0';
+ *cp++ = '\0';
+ }
+}
+
+static void
+float_print(v, fp, flags)
+ floatobject *v;
+ FILE *fp;
+ int flags;
+{
+ char buf[100];
+ float_buf_repr(buf, v);
+ fputs(buf, fp);
+}
+
+static object *
+float_repr(v)
+ floatobject *v;
+{
+ char buf[100];
+ float_buf_repr(buf, v);
+ return newstringobject(buf);
+}
+
+static int
+float_compare(v, w)
+ floatobject *v, *w;
+{
+ double i = v->ob_fval;
+ double j = w->ob_fval;
+ return (i < j) ? -1 : (i > j) ? 1 : 0;
+}
+
+static object *
+float_add(v, w)
+ floatobject *v;
+ object *w;
+{
+ if (!is_floatobject(w)) {
+ err_badarg();
+ return NULL;
+ }
+ return newfloatobject(v->ob_fval + ((floatobject *)w) -> ob_fval);
+}
+
+static object *
+float_sub(v, w)
+ floatobject *v;
+ object *w;
+{
+ if (!is_floatobject(w)) {
+ err_badarg();
+ return NULL;
+ }
+ return newfloatobject(v->ob_fval - ((floatobject *)w) -> ob_fval);
+}
+
+static object *
+float_mul(v, w)
+ floatobject *v;
+ object *w;
+{
+ if (!is_floatobject(w)) {
+ err_badarg();
+ return NULL;
+ }
+ return newfloatobject(v->ob_fval * ((floatobject *)w) -> ob_fval);
+}
+
+static object *
+float_div(v, w)
+ floatobject *v;
+ object *w;
+{
+ if (!is_floatobject(w)) {
+ err_badarg();
+ return NULL;
+ }
+ if (((floatobject *)w) -> ob_fval == 0) {
+ err_setstr(ZeroDivisionError, "float division by zero");
+ return NULL;
+ }
+ return newfloatobject(v->ob_fval / ((floatobject *)w) -> ob_fval);
+}
+
+static object *
+float_rem(v, w)
+ floatobject *v;
+ object *w;
+{
+ double wx;
+ if (!is_floatobject(w)) {
+ err_badarg();
+ return NULL;
+ }
+ wx = ((floatobject *)w) -> ob_fval;
+ if (wx == 0.0) {
+ err_setstr(ZeroDivisionError, "float division by zero");
+ return NULL;
+ }
+ return newfloatobject(fmod(v->ob_fval, wx));
+}
+
+static object *
+float_pow(v, w)
+ floatobject *v;
+ object *w;
+{
+ double iv, iw, ix;
+ if (!is_floatobject(w)) {
+ err_badarg();
+ return NULL;
+ }
+ iv = v->ob_fval;
+ iw = ((floatobject *)w)->ob_fval;
+ if (iw == 0.0)
+ return newfloatobject(1.0); /* x**0 is always 1, even 0**0 */
+ errno = 0;
+ ix = pow(iv, iw);
+ if (errno != 0) {
+ /* XXX could it be another type of error? */
+ err_errno(OverflowError);
+ return NULL;
+ }
+ return newfloatobject(ix);
+}
+
+static object *
+float_neg(v)
+ floatobject *v;
+{
+ return newfloatobject(-v->ob_fval);
+}
+
+static object *
+float_pos(v)
+ floatobject *v;
+{
+ return newfloatobject(v->ob_fval);
+}
+
+static number_methods float_as_number = {
+ float_add, /*tp_add*/
+ float_sub, /*tp_subtract*/
+ float_mul, /*tp_multiply*/
+ float_div, /*tp_divide*/
+ float_rem, /*tp_remainder*/
+ float_pow, /*tp_power*/
+ float_neg, /*tp_negate*/
+ float_pos, /*tp_plus*/
+};
+
+typeobject Floattype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "float",
+ sizeof(floatobject),
+ 0,
+ free, /*tp_dealloc*/
+ float_print, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ float_compare, /*tp_compare*/
+ float_repr, /*tp_repr*/
+ &float_as_number, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
+
+/*
+XXX This is not enough. Need:
+- automatic casts for mixed arithmetic (3.1 * 4)
+- mixed comparisons (!)
+- look at other uses of ints that could be extended to floats
+*/
diff --git a/src/floatobject.h b/src/floatobject.h
new file mode 100644
index 0000000..52db73e
--- /dev/null
+++ b/src/floatobject.h
@@ -0,0 +1,44 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Float object interface */
+
+/*
+floatobject represents a (double precision) floating point number.
+*/
+
+typedef struct {
+ OB_HEAD
+ double ob_fval;
+} floatobject;
+
+extern typeobject Floattype;
+
+#define is_floatobject(op) ((op)->ob_type == &Floattype)
+
+extern object *newfloatobject PROTO((double));
+extern double getfloatvalue PROTO((object *));
+
+/* Macro, trading safety for speed */
+#define GETFLOATVALUE(op) ((op)->ob_fval)
diff --git a/src/fmod.c b/src/fmod.c
new file mode 100644
index 0000000..fe90e07
--- /dev/null
+++ b/src/fmod.c
@@ -0,0 +1,51 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Portable fmod(x, y) implementation for systems that don't have it */
+
+#include <math.h>
+#include <errno.h>
+
+extern int errno;
+
+double
+fmod(x, y)
+ double x, y;
+{
+ double i, f;
+
+ if (y == 0.0) {
+ errno = EDOM;
+ return 0.0;
+ }
+
+ /* return f such that x = i*y + f for some integer i
+ such that |f| < |y| and f has the same sign as x */
+
+ i = floor(x/y);
+ f = x - i*y;
+ if ((x < 0.0) != (y < 0.0))
+ f = f-y;
+ return f;
+}
diff --git a/src/frameobject.c b/src/frameobject.c
new file mode 100644
index 0000000..4f9e250
--- /dev/null
+++ b/src/frameobject.c
@@ -0,0 +1,156 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Frame object implementation */
+
+#include "allobjects.h"
+
+#include "compile.h"
+#include "frameobject.h"
+#include "opcode.h"
+#include "structmember.h"
+
+#define OFF(x) offsetof(frameobject, x)
+
+static struct memberlist frame_memberlist[] = {
+ {"f_back", T_OBJECT, OFF(f_back)},
+ {"f_code", T_OBJECT, OFF(f_code)},
+ {"f_globals", T_OBJECT, OFF(f_globals)},
+ {"f_locals", T_OBJECT, OFF(f_locals)},
+ {NULL} /* Sentinel */
+};
+
+static object *
+frame_getattr(f, name)
+ frameobject *f;
+ char *name;
+{
+ return getmember((char *)f, frame_memberlist, name);
+}
+
+static void
+frame_dealloc(f)
+ frameobject *f;
+{
+ XDECREF(f->f_back);
+ XDECREF(f->f_code);
+ XDECREF(f->f_globals);
+ XDECREF(f->f_locals);
+ XDEL(f->f_valuestack);
+ XDEL(f->f_blockstack);
+ DEL(f);
+}
+
+typeobject Frametype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "frame",
+ sizeof(frameobject),
+ 0,
+ frame_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ frame_getattr, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
+
+frameobject *
+newframeobject(back, code, globals, locals, nvalues, nblocks)
+ frameobject *back;
+ codeobject *code;
+ object *globals;
+ object *locals;
+ int nvalues;
+ int nblocks;
+{
+ frameobject *f;
+ if ((back != NULL && !is_frameobject(back)) ||
+ code == NULL || !is_codeobject(code) ||
+ globals == NULL || !is_dictobject(globals) ||
+ locals == NULL || !is_dictobject(locals) ||
+ nvalues < 0 || nblocks < 0) {
+ err_badcall();
+ return NULL;
+ }
+ f = NEWOBJ(frameobject, &Frametype);
+ if (f != NULL) {
+ if (back)
+ INCREF(back);
+ f->f_back = back;
+ INCREF(code);
+ f->f_code = code;
+ INCREF(globals);
+ f->f_globals = globals;
+ INCREF(locals);
+ f->f_locals = locals;
+ f->f_valuestack = NEW(object *, nvalues+1);
+ f->f_blockstack = NEW(block, nblocks+1);
+ f->f_nvalues = nvalues;
+ f->f_nblocks = nblocks;
+ f->f_iblock = 0;
+ if (f->f_valuestack == NULL || f->f_blockstack == NULL) {
+ err_nomem();
+ DECREF(f);
+ f = NULL;
+ }
+ }
+ return f;
+}
+
+/* Block management */
+
+void
+setup_block(f, type, handler, level)
+ frameobject *f;
+ int type;
+ int handler;
+ int level;
+{
+ block *b;
+ if (f->f_iblock >= f->f_nblocks) {
+ fprintf(stderr, "XXX block stack overflow\n");
+ abort();
+ }
+ b = &f->f_blockstack[f->f_iblock++];
+ b->b_type = type;
+ b->b_level = level;
+ b->b_handler = handler;
+}
+
+block *
+pop_block(f)
+ frameobject *f;
+{
+ block *b;
+ if (f->f_iblock <= 0) {
+ fprintf(stderr, "XXX block stack underflow\n");
+ abort();
+ }
+ b = &f->f_blockstack[--f->f_iblock];
+ return b;
+}
diff --git a/src/frameobject.h b/src/frameobject.h
new file mode 100644
index 0000000..8ea0fa2
--- /dev/null
+++ b/src/frameobject.h
@@ -0,0 +1,80 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Frame object interface */
+
+typedef struct {
+ int b_type; /* what kind of block this is */
+ int b_handler; /* where to jump to find handler */
+ int b_level; /* value stack level to pop to */
+} block;
+
+typedef struct _frame {
+ OB_HEAD
+ struct _frame *f_back; /* previous frame, or NULL */
+ codeobject *f_code; /* code segment */
+ object *f_globals; /* global symbol table (dictobject) */
+ object *f_locals; /* local symbol table (dictobject) */
+ object **f_valuestack; /* malloc'ed array */
+ block *f_blockstack; /* malloc'ed array */
+ int f_nvalues; /* size of f_valuestack */
+ int f_nblocks; /* size of f_blockstack */
+ int f_iblock; /* index in f_blockstack */
+} frameobject;
+
+
+/* Standard object interface */
+
+extern typeobject Frametype;
+
+#define is_frameobject(op) ((op)->ob_type == &Frametype)
+
+frameobject * newframeobject PROTO(
+ (frameobject *, codeobject *, object *, object *, int, int));
+
+
+/* The rest of the interface is specific for frame objects */
+
+/* List access macros */
+
+#ifdef NDEBUG
+#define GETITEM(v, i) GETLISTITEM((listobject *)(v), (i))
+#define GETITEMNAME(v, i) GETSTRINGVALUE((stringobject *)GETITEM((v), (i)))
+#else
+#define GETITEM(v, i) getlistitem((v), (i))
+#define GETITEMNAME(v, i) getstringvalue(getlistitem((v), (i)))
+#endif
+
+#define GETUSTRINGVALUE(s) ((unsigned char *)GETSTRINGVALUE(s))
+
+/* Code access macros */
+
+#define Getconst(f, i) (GETITEM((f)->f_code->co_consts, (i)))
+#define Getname(f, i) (GETITEMNAME((f)->f_code->co_names, (i)))
+
+
+/* Block management functions */
+
+void setup_block PROTO((frameobject *, int, int, int));
+block *pop_block PROTO((frameobject *));
diff --git a/src/funcobject.c b/src/funcobject.c
new file mode 100644
index 0000000..1088d7b
--- /dev/null
+++ b/src/funcobject.c
@@ -0,0 +1,113 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Function object implementation */
+
+#include "allobjects.h"
+
+#include "structmember.h"
+
+typedef struct {
+ OB_HEAD
+ object *func_code;
+ object *func_globals;
+} funcobject;
+
+object *
+newfuncobject(code, globals)
+ object *code;
+ object *globals;
+{
+ funcobject *op = NEWOBJ(funcobject, &Functype);
+ if (op != NULL) {
+ INCREF(code);
+ op->func_code = code;
+ INCREF(globals);
+ op->func_globals = globals;
+ }
+ return (object *)op;
+}
+
+object *
+getfunccode(op)
+ object *op;
+{
+ if (!is_funcobject(op)) {
+ err_badcall();
+ return NULL;
+ }
+ return ((funcobject *) op) -> func_code;
+}
+
+object *
+getfuncglobals(op)
+ object *op;
+{
+ if (!is_funcobject(op)) {
+ err_badcall();
+ return NULL;
+ }
+ return ((funcobject *) op) -> func_globals;
+}
+
+/* Methods */
+
+#define OFF(x) offsetof(funcobject, x)
+
+static struct memberlist func_memberlist[] = {
+ {"func_code", T_OBJECT, OFF(func_code)},
+ {"func_globals",T_OBJECT, OFF(func_globals)},
+ {NULL} /* Sentinel */
+};
+
+static object *
+func_getattr(op, name)
+ funcobject *op;
+ char *name;
+{
+ return getmember((char *)op, func_memberlist, name);
+}
+
+static void
+func_dealloc(op)
+ funcobject *op;
+{
+ DECREF(op->func_code);
+ DECREF(op->func_globals);
+ DEL(op);
+}
+
+typeobject Functype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "function",
+ sizeof(funcobject),
+ 0,
+ func_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ func_getattr, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+};
diff --git a/src/funcobject.h b/src/funcobject.h
new file mode 100644
index 0000000..de8b1a7
--- /dev/null
+++ b/src/funcobject.h
@@ -0,0 +1,33 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Function object interface */
+
+extern typeobject Functype;
+
+#define is_funcobject(op) ((op)->ob_type == &Functype)
+
+extern object *newfuncobject PROTO((object *, object *));
+extern object *getfunccode PROTO((object *));
+extern object *getfuncglobals PROTO((object *));
diff --git a/src/getcwd.c b/src/getcwd.c
new file mode 100644
index 0000000..3de6291
--- /dev/null
+++ b/src/getcwd.c
@@ -0,0 +1,102 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Two PD getcwd() implementations.
+ Author: Guido van Rossum, CWI Amsterdam, Jan 1991, <[email protected]>. */
+
+/* #define NO_GETWD /* Turn this on to popen pwd instead of calling getwd() */
+
+#include <stdio.h>
+#include <errno.h>
+
+extern int errno;
+
+#ifndef NO_GETWD
+
+/* Default: Version for BSD systems -- use getwd() */
+
+#include "sys/param.h"
+
+extern char *getwd();
+
+char *
+getcwd(buf, size)
+ char *buf;
+ int size;
+{
+ char localbuf[MAXPATHLEN+1];
+ char *ret;
+
+ if (size <= 0) {
+ errno = EINVAL;
+ return NULL;
+ }
+ ret = getwd(localbuf);
+ if (ret != NULL && strlen(localbuf) >= size) {
+ errno = ERANGE;
+ return NULL;
+ }
+ if (ret == NULL) {
+ errno = EACCES; /* Most likely error */
+ return NULL;
+ }
+ strncpy(buf, localbuf, size);
+ return buf;
+}
+
+#else
+
+/* NO_GETWD defined: Version for backward UNIXes -- popen /bin/pwd */
+
+#define PWD_CMD "/bin/pwd"
+
+char *
+getcwd(buf, size)
+ char *buf;
+ int size;
+{
+ FILE *fp;
+ char *p;
+ int sts;
+ if (size <= 0) {
+ errno = EINVAL;
+ return NULL;
+ }
+ if ((fp = popen(PWD_CMD, "r")) == NULL)
+ return NULL;
+ if (fgets(buf, size, fp) == NULL || (sts = pclose(fp)) != 0) {
+ errno = EACCES; /* Most likely error */
+ return NULL;
+ }
+ for (p = buf; *p != '\n'; p++) {
+ if (*p == '\0') {
+ errno = ERANGE;
+ return NULL;
+ }
+ }
+ *p = '\0';
+ return buf;
+}
+
+#endif
diff --git a/src/graminit.c b/src/graminit.c
new file mode 100644
index 0000000..2f18183
--- /dev/null
+++ b/src/graminit.c
@@ -0,0 +1,1094 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+#include "pgenheaders.h"
+#include "grammar.h"
+static arc arcs_0_0[3] = {
+ {2, 1},
+ {3, 1},
+ {4, 2},
+};
+static arc arcs_0_1[1] = {
+ {0, 1},
+};
+static arc arcs_0_2[1] = {
+ {2, 1},
+};
+static state states_0[3] = {
+ {3, arcs_0_0},
+ {1, arcs_0_1},
+ {1, arcs_0_2},
+};
+static arc arcs_1_0[3] = {
+ {2, 0},
+ {6, 0},
+ {7, 1},
+};
+static arc arcs_1_1[1] = {
+ {0, 1},
+};
+static state states_1[2] = {
+ {3, arcs_1_0},
+ {1, arcs_1_1},
+};
+static arc arcs_2_0[1] = {
+ {9, 1},
+};
+static arc arcs_2_1[1] = {
+ {2, 2},
+};
+static arc arcs_2_2[1] = {
+ {0, 2},
+};
+static state states_2[3] = {
+ {1, arcs_2_0},
+ {1, arcs_2_1},
+ {1, arcs_2_2},
+};
+static arc arcs_3_0[1] = {
+ {9, 1},
+};
+static arc arcs_3_1[1] = {
+ {7, 2},
+};
+static arc arcs_3_2[1] = {
+ {0, 2},
+};
+static state states_3[3] = {
+ {1, arcs_3_0},
+ {1, arcs_3_1},
+ {1, arcs_3_2},
+};
+static arc arcs_4_0[1] = {
+ {12, 1},
+};
+static arc arcs_4_1[1] = {
+ {13, 2},
+};
+static arc arcs_4_2[1] = {
+ {14, 3},
+};
+static arc arcs_4_3[1] = {
+ {15, 4},
+};
+static arc arcs_4_4[1] = {
+ {16, 5},
+};
+static arc arcs_4_5[1] = {
+ {0, 5},
+};
+static state states_4[6] = {
+ {1, arcs_4_0},
+ {1, arcs_4_1},
+ {1, arcs_4_2},
+ {1, arcs_4_3},
+ {1, arcs_4_4},
+ {1, arcs_4_5},
+};
+static arc arcs_5_0[1] = {
+ {17, 1},
+};
+static arc arcs_5_1[2] = {
+ {18, 2},
+ {19, 3},
+};
+static arc arcs_5_2[1] = {
+ {19, 3},
+};
+static arc arcs_5_3[1] = {
+ {0, 3},
+};
+static state states_5[4] = {
+ {1, arcs_5_0},
+ {2, arcs_5_1},
+ {1, arcs_5_2},
+ {1, arcs_5_3},
+};
+static arc arcs_6_0[1] = {
+ {20, 1},
+};
+static arc arcs_6_1[2] = {
+ {21, 0},
+ {0, 1},
+};
+static state states_6[2] = {
+ {1, arcs_6_0},
+ {2, arcs_6_1},
+};
+static arc arcs_7_0[2] = {
+ {13, 1},
+ {17, 2},
+};
+static arc arcs_7_1[1] = {
+ {0, 1},
+};
+static arc arcs_7_2[1] = {
+ {18, 3},
+};
+static arc arcs_7_3[1] = {
+ {19, 1},
+};
+static state states_7[4] = {
+ {2, arcs_7_0},
+ {1, arcs_7_1},
+ {1, arcs_7_2},
+ {1, arcs_7_3},
+};
+static arc arcs_8_0[2] = {
+ {3, 1},
+ {4, 1},
+};
+static arc arcs_8_1[1] = {
+ {0, 1},
+};
+static state states_8[2] = {
+ {2, arcs_8_0},
+ {1, arcs_8_1},
+};
+static arc arcs_9_0[6] = {
+ {22, 1},
+ {23, 1},
+ {24, 1},
+ {25, 1},
+ {26, 1},
+ {27, 1},
+};
+static arc arcs_9_1[1] = {
+ {0, 1},
+};
+static state states_9[2] = {
+ {6, arcs_9_0},
+ {1, arcs_9_1},
+};
+static arc arcs_10_0[1] = {
+ {28, 1},
+};
+static arc arcs_10_1[2] = {
+ {29, 0},
+ {2, 2},
+};
+static arc arcs_10_2[1] = {
+ {0, 2},
+};
+static state states_10[3] = {
+ {1, arcs_10_0},
+ {2, arcs_10_1},
+ {1, arcs_10_2},
+};
+static arc arcs_11_0[1] = {
+ {30, 1},
+};
+static arc arcs_11_1[2] = {
+ {31, 2},
+ {2, 3},
+};
+static arc arcs_11_2[2] = {
+ {21, 1},
+ {2, 3},
+};
+static arc arcs_11_3[1] = {
+ {0, 3},
+};
+static state states_11[4] = {
+ {1, arcs_11_0},
+ {2, arcs_11_1},
+ {2, arcs_11_2},
+ {1, arcs_11_3},
+};
+static arc arcs_12_0[1] = {
+ {32, 1},
+};
+static arc arcs_12_1[1] = {
+ {28, 2},
+};
+static arc arcs_12_2[1] = {
+ {2, 3},
+};
+static arc arcs_12_3[1] = {
+ {0, 3},
+};
+static state states_12[4] = {
+ {1, arcs_12_0},
+ {1, arcs_12_1},
+ {1, arcs_12_2},
+ {1, arcs_12_3},
+};
+static arc arcs_13_0[1] = {
+ {33, 1},
+};
+static arc arcs_13_1[1] = {
+ {2, 2},
+};
+static arc arcs_13_2[1] = {
+ {0, 2},
+};
+static state states_13[3] = {
+ {1, arcs_13_0},
+ {1, arcs_13_1},
+ {1, arcs_13_2},
+};
+static arc arcs_14_0[3] = {
+ {34, 1},
+ {35, 1},
+ {36, 1},
+};
+static arc arcs_14_1[1] = {
+ {0, 1},
+};
+static state states_14[2] = {
+ {3, arcs_14_0},
+ {1, arcs_14_1},
+};
+static arc arcs_15_0[1] = {
+ {37, 1},
+};
+static arc arcs_15_1[1] = {
+ {2, 2},
+};
+static arc arcs_15_2[1] = {
+ {0, 2},
+};
+static state states_15[3] = {
+ {1, arcs_15_0},
+ {1, arcs_15_1},
+ {1, arcs_15_2},
+};
+static arc arcs_16_0[1] = {
+ {38, 1},
+};
+static arc arcs_16_1[2] = {
+ {9, 2},
+ {2, 3},
+};
+static arc arcs_16_2[1] = {
+ {2, 3},
+};
+static arc arcs_16_3[1] = {
+ {0, 3},
+};
+static state states_16[4] = {
+ {1, arcs_16_0},
+ {2, arcs_16_1},
+ {1, arcs_16_2},
+ {1, arcs_16_3},
+};
+static arc arcs_17_0[1] = {
+ {39, 1},
+};
+static arc arcs_17_1[1] = {
+ {40, 2},
+};
+static arc arcs_17_2[2] = {
+ {21, 3},
+ {2, 4},
+};
+static arc arcs_17_3[1] = {
+ {40, 5},
+};
+static arc arcs_17_4[1] = {
+ {0, 4},
+};
+static arc arcs_17_5[1] = {
+ {2, 4},
+};
+static state states_17[6] = {
+ {1, arcs_17_0},
+ {1, arcs_17_1},
+ {2, arcs_17_2},
+ {1, arcs_17_3},
+ {1, arcs_17_4},
+ {1, arcs_17_5},
+};
+static arc arcs_18_0[2] = {
+ {41, 1},
+ {42, 2},
+};
+static arc arcs_18_1[1] = {
+ {13, 3},
+};
+static arc arcs_18_2[1] = {
+ {13, 4},
+};
+static arc arcs_18_3[2] = {
+ {21, 1},
+ {2, 5},
+};
+static arc arcs_18_4[1] = {
+ {41, 6},
+};
+static arc arcs_18_5[1] = {
+ {0, 5},
+};
+static arc arcs_18_6[2] = {
+ {43, 7},
+ {13, 8},
+};
+static arc arcs_18_7[1] = {
+ {2, 5},
+};
+static arc arcs_18_8[2] = {
+ {21, 9},
+ {2, 5},
+};
+static arc arcs_18_9[1] = {
+ {13, 8},
+};
+static state states_18[10] = {
+ {2, arcs_18_0},
+ {1, arcs_18_1},
+ {1, arcs_18_2},
+ {2, arcs_18_3},
+ {1, arcs_18_4},
+ {1, arcs_18_5},
+ {2, arcs_18_6},
+ {1, arcs_18_7},
+ {2, arcs_18_8},
+ {1, arcs_18_9},
+};
+static arc arcs_19_0[6] = {
+ {44, 1},
+ {45, 1},
+ {46, 1},
+ {47, 1},
+ {11, 1},
+ {48, 1},
+};
+static arc arcs_19_1[1] = {
+ {0, 1},
+};
+static state states_19[2] = {
+ {6, arcs_19_0},
+ {1, arcs_19_1},
+};
+static arc arcs_20_0[1] = {
+ {49, 1},
+};
+static arc arcs_20_1[1] = {
+ {31, 2},
+};
+static arc arcs_20_2[1] = {
+ {15, 3},
+};
+static arc arcs_20_3[1] = {
+ {16, 4},
+};
+static arc arcs_20_4[3] = {
+ {50, 1},
+ {51, 5},
+ {0, 4},
+};
+static arc arcs_20_5[1] = {
+ {15, 6},
+};
+static arc arcs_20_6[1] = {
+ {16, 7},
+};
+static arc arcs_20_7[1] = {
+ {0, 7},
+};
+static state states_20[8] = {
+ {1, arcs_20_0},
+ {1, arcs_20_1},
+ {1, arcs_20_2},
+ {1, arcs_20_3},
+ {3, arcs_20_4},
+ {1, arcs_20_5},
+ {1, arcs_20_6},
+ {1, arcs_20_7},
+};
+static arc arcs_21_0[1] = {
+ {52, 1},
+};
+static arc arcs_21_1[1] = {
+ {31, 2},
+};
+static arc arcs_21_2[1] = {
+ {15, 3},
+};
+static arc arcs_21_3[1] = {
+ {16, 4},
+};
+static arc arcs_21_4[2] = {
+ {51, 5},
+ {0, 4},
+};
+static arc arcs_21_5[1] = {
+ {15, 6},
+};
+static arc arcs_21_6[1] = {
+ {16, 7},
+};
+static arc arcs_21_7[1] = {
+ {0, 7},
+};
+static state states_21[8] = {
+ {1, arcs_21_0},
+ {1, arcs_21_1},
+ {1, arcs_21_2},
+ {1, arcs_21_3},
+ {2, arcs_21_4},
+ {1, arcs_21_5},
+ {1, arcs_21_6},
+ {1, arcs_21_7},
+};
+static arc arcs_22_0[1] = {
+ {53, 1},
+};
+static arc arcs_22_1[1] = {
+ {28, 2},
+};
+static arc arcs_22_2[1] = {
+ {54, 3},
+};
+static arc arcs_22_3[1] = {
+ {28, 4},
+};
+static arc arcs_22_4[1] = {
+ {15, 5},
+};
+static arc arcs_22_5[1] = {
+ {16, 6},
+};
+static arc arcs_22_6[2] = {
+ {51, 7},
+ {0, 6},
+};
+static arc arcs_22_7[1] = {
+ {15, 8},
+};
+static arc arcs_22_8[1] = {
+ {16, 9},
+};
+static arc arcs_22_9[1] = {
+ {0, 9},
+};
+static state states_22[10] = {
+ {1, arcs_22_0},
+ {1, arcs_22_1},
+ {1, arcs_22_2},
+ {1, arcs_22_3},
+ {1, arcs_22_4},
+ {1, arcs_22_5},
+ {2, arcs_22_6},
+ {1, arcs_22_7},
+ {1, arcs_22_8},
+ {1, arcs_22_9},
+};
+static arc arcs_23_0[1] = {
+ {55, 1},
+};
+static arc arcs_23_1[1] = {
+ {15, 2},
+};
+static arc arcs_23_2[1] = {
+ {16, 3},
+};
+static arc arcs_23_3[3] = {
+ {56, 1},
+ {57, 4},
+ {0, 3},
+};
+static arc arcs_23_4[1] = {
+ {15, 5},
+};
+static arc arcs_23_5[1] = {
+ {16, 6},
+};
+static arc arcs_23_6[1] = {
+ {0, 6},
+};
+static state states_23[7] = {
+ {1, arcs_23_0},
+ {1, arcs_23_1},
+ {1, arcs_23_2},
+ {3, arcs_23_3},
+ {1, arcs_23_4},
+ {1, arcs_23_5},
+ {1, arcs_23_6},
+};
+static arc arcs_24_0[1] = {
+ {58, 1},
+};
+static arc arcs_24_1[2] = {
+ {40, 2},
+ {0, 1},
+};
+static arc arcs_24_2[2] = {
+ {21, 3},
+ {0, 2},
+};
+static arc arcs_24_3[1] = {
+ {40, 4},
+};
+static arc arcs_24_4[1] = {
+ {0, 4},
+};
+static state states_24[5] = {
+ {1, arcs_24_0},
+ {2, arcs_24_1},
+ {2, arcs_24_2},
+ {1, arcs_24_3},
+ {1, arcs_24_4},
+};
+static arc arcs_25_0[2] = {
+ {3, 1},
+ {2, 2},
+};
+static arc arcs_25_1[1] = {
+ {0, 1},
+};
+static arc arcs_25_2[1] = {
+ {59, 3},
+};
+static arc arcs_25_3[2] = {
+ {2, 3},
+ {6, 4},
+};
+static arc arcs_25_4[3] = {
+ {6, 4},
+ {2, 4},
+ {60, 1},
+};
+static state states_25[5] = {
+ {2, arcs_25_0},
+ {1, arcs_25_1},
+ {1, arcs_25_2},
+ {2, arcs_25_3},
+ {3, arcs_25_4},
+};
+static arc arcs_26_0[1] = {
+ {61, 1},
+};
+static arc arcs_26_1[2] = {
+ {62, 0},
+ {0, 1},
+};
+static state states_26[2] = {
+ {1, arcs_26_0},
+ {2, arcs_26_1},
+};
+static arc arcs_27_0[1] = {
+ {63, 1},
+};
+static arc arcs_27_1[2] = {
+ {64, 0},
+ {0, 1},
+};
+static state states_27[2] = {
+ {1, arcs_27_0},
+ {2, arcs_27_1},
+};
+static arc arcs_28_0[2] = {
+ {65, 1},
+ {66, 2},
+};
+static arc arcs_28_1[1] = {
+ {63, 2},
+};
+static arc arcs_28_2[1] = {
+ {0, 2},
+};
+static state states_28[3] = {
+ {2, arcs_28_0},
+ {1, arcs_28_1},
+ {1, arcs_28_2},
+};
+static arc arcs_29_0[1] = {
+ {40, 1},
+};
+static arc arcs_29_1[2] = {
+ {67, 0},
+ {0, 1},
+};
+static state states_29[2] = {
+ {1, arcs_29_0},
+ {2, arcs_29_1},
+};
+static arc arcs_30_0[6] = {
+ {68, 1},
+ {69, 2},
+ {29, 3},
+ {54, 3},
+ {65, 4},
+ {70, 5},
+};
+static arc arcs_30_1[3] = {
+ {29, 3},
+ {69, 3},
+ {0, 1},
+};
+static arc arcs_30_2[2] = {
+ {29, 3},
+ {0, 2},
+};
+static arc arcs_30_3[1] = {
+ {0, 3},
+};
+static arc arcs_30_4[1] = {
+ {54, 3},
+};
+static arc arcs_30_5[2] = {
+ {65, 3},
+ {0, 5},
+};
+static state states_30[6] = {
+ {6, arcs_30_0},
+ {3, arcs_30_1},
+ {2, arcs_30_2},
+ {1, arcs_30_3},
+ {1, arcs_30_4},
+ {2, arcs_30_5},
+};
+static arc arcs_31_0[1] = {
+ {71, 1},
+};
+static arc arcs_31_1[3] = {
+ {72, 0},
+ {73, 0},
+ {0, 1},
+};
+static state states_31[2] = {
+ {1, arcs_31_0},
+ {3, arcs_31_1},
+};
+static arc arcs_32_0[1] = {
+ {74, 1},
+};
+static arc arcs_32_1[4] = {
+ {43, 0},
+ {75, 0},
+ {76, 0},
+ {0, 1},
+};
+static state states_32[2] = {
+ {1, arcs_32_0},
+ {4, arcs_32_1},
+};
+static arc arcs_33_0[3] = {
+ {72, 1},
+ {73, 1},
+ {77, 2},
+};
+static arc arcs_33_1[1] = {
+ {74, 3},
+};
+static arc arcs_33_2[2] = {
+ {78, 2},
+ {0, 2},
+};
+static arc arcs_33_3[1] = {
+ {0, 3},
+};
+static state states_33[4] = {
+ {3, arcs_33_0},
+ {1, arcs_33_1},
+ {2, arcs_33_2},
+ {1, arcs_33_3},
+};
+static arc arcs_34_0[7] = {
+ {17, 1},
+ {79, 2},
+ {81, 3},
+ {83, 4},
+ {13, 5},
+ {84, 5},
+ {85, 5},
+};
+static arc arcs_34_1[2] = {
+ {9, 6},
+ {19, 5},
+};
+static arc arcs_34_2[2] = {
+ {9, 7},
+ {80, 5},
+};
+static arc arcs_34_3[1] = {
+ {82, 5},
+};
+static arc arcs_34_4[1] = {
+ {9, 8},
+};
+static arc arcs_34_5[1] = {
+ {0, 5},
+};
+static arc arcs_34_6[1] = {
+ {19, 5},
+};
+static arc arcs_34_7[1] = {
+ {80, 5},
+};
+static arc arcs_34_8[1] = {
+ {83, 5},
+};
+static state states_34[9] = {
+ {7, arcs_34_0},
+ {2, arcs_34_1},
+ {2, arcs_34_2},
+ {1, arcs_34_3},
+ {1, arcs_34_4},
+ {1, arcs_34_5},
+ {1, arcs_34_6},
+ {1, arcs_34_7},
+ {1, arcs_34_8},
+};
+static arc arcs_35_0[3] = {
+ {17, 1},
+ {79, 2},
+ {87, 3},
+};
+static arc arcs_35_1[2] = {
+ {9, 4},
+ {19, 5},
+};
+static arc arcs_35_2[1] = {
+ {86, 6},
+};
+static arc arcs_35_3[1] = {
+ {13, 5},
+};
+static arc arcs_35_4[1] = {
+ {19, 5},
+};
+static arc arcs_35_5[1] = {
+ {0, 5},
+};
+static arc arcs_35_6[1] = {
+ {80, 5},
+};
+static state states_35[7] = {
+ {3, arcs_35_0},
+ {2, arcs_35_1},
+ {1, arcs_35_2},
+ {1, arcs_35_3},
+ {1, arcs_35_4},
+ {1, arcs_35_5},
+ {1, arcs_35_6},
+};
+static arc arcs_36_0[2] = {
+ {40, 1},
+ {15, 2},
+};
+static arc arcs_36_1[2] = {
+ {15, 2},
+ {0, 1},
+};
+static arc arcs_36_2[2] = {
+ {40, 3},
+ {0, 2},
+};
+static arc arcs_36_3[1] = {
+ {0, 3},
+};
+static state states_36[4] = {
+ {2, arcs_36_0},
+ {2, arcs_36_1},
+ {2, arcs_36_2},
+ {1, arcs_36_3},
+};
+static arc arcs_37_0[1] = {
+ {40, 1},
+};
+static arc arcs_37_1[2] = {
+ {21, 2},
+ {0, 1},
+};
+static arc arcs_37_2[2] = {
+ {40, 1},
+ {0, 2},
+};
+static state states_37[3] = {
+ {1, arcs_37_0},
+ {2, arcs_37_1},
+ {2, arcs_37_2},
+};
+static arc arcs_38_0[1] = {
+ {31, 1},
+};
+static arc arcs_38_1[2] = {
+ {21, 2},
+ {0, 1},
+};
+static arc arcs_38_2[2] = {
+ {31, 1},
+ {0, 2},
+};
+static state states_38[3] = {
+ {1, arcs_38_0},
+ {2, arcs_38_1},
+ {2, arcs_38_2},
+};
+static arc arcs_39_0[1] = {
+ {88, 1},
+};
+static arc arcs_39_1[1] = {
+ {13, 2},
+};
+static arc arcs_39_2[1] = {
+ {14, 3},
+};
+static arc arcs_39_3[2] = {
+ {29, 4},
+ {15, 5},
+};
+static arc arcs_39_4[1] = {
+ {89, 6},
+};
+static arc arcs_39_5[1] = {
+ {16, 7},
+};
+static arc arcs_39_6[1] = {
+ {15, 5},
+};
+static arc arcs_39_7[1] = {
+ {0, 7},
+};
+static state states_39[8] = {
+ {1, arcs_39_0},
+ {1, arcs_39_1},
+ {1, arcs_39_2},
+ {2, arcs_39_3},
+ {1, arcs_39_4},
+ {1, arcs_39_5},
+ {1, arcs_39_6},
+ {1, arcs_39_7},
+};
+static arc arcs_40_0[1] = {
+ {77, 1},
+};
+static arc arcs_40_1[1] = {
+ {90, 2},
+};
+static arc arcs_40_2[2] = {
+ {21, 0},
+ {0, 2},
+};
+static state states_40[3] = {
+ {1, arcs_40_0},
+ {1, arcs_40_1},
+ {2, arcs_40_2},
+};
+static arc arcs_41_0[1] = {
+ {17, 1},
+};
+static arc arcs_41_1[2] = {
+ {9, 2},
+ {19, 3},
+};
+static arc arcs_41_2[1] = {
+ {19, 3},
+};
+static arc arcs_41_3[1] = {
+ {0, 3},
+};
+static state states_41[4] = {
+ {1, arcs_41_0},
+ {2, arcs_41_1},
+ {1, arcs_41_2},
+ {1, arcs_41_3},
+};
+static dfa dfas[42] = {
+ {256, "single_input", 0, 3, states_0,
+ "\004\060\002\100\343\006\262\000\000\203\072\001"},
+ {257, "file_input", 0, 2, states_1,
+ "\204\060\002\100\343\006\262\000\000\203\072\001"},
+ {258, "expr_input", 0, 3, states_2,
+ "\000\040\002\000\000\000\000\000\002\203\072\000"},
+ {259, "eval_input", 0, 3, states_3,
+ "\000\040\002\000\000\000\000\000\002\203\072\000"},
+ {260, "funcdef", 0, 6, states_4,
+ "\000\020\000\000\000\000\000\000\000\000\000\000"},
+ {261, "parameters", 0, 4, states_5,
+ "\000\000\002\000\000\000\000\000\000\000\000\000"},
+ {262, "fplist", 0, 2, states_6,
+ "\000\040\002\000\000\000\000\000\000\000\000\000"},
+ {263, "fpdef", 0, 4, states_7,
+ "\000\040\002\000\000\000\000\000\000\000\000\000"},
+ {264, "stmt", 0, 2, states_8,
+ "\000\060\002\100\343\006\262\000\000\203\072\001"},
+ {265, "simple_stmt", 0, 2, states_9,
+ "\000\040\002\100\343\006\000\000\000\203\072\000"},
+ {266, "expr_stmt", 0, 3, states_10,
+ "\000\040\002\000\000\000\000\000\000\203\072\000"},
+ {267, "print_stmt", 0, 4, states_11,
+ "\000\000\000\100\000\000\000\000\000\000\000\000"},
+ {268, "del_stmt", 0, 4, states_12,
+ "\000\000\000\000\001\000\000\000\000\000\000\000"},
+ {269, "pass_stmt", 0, 3, states_13,
+ "\000\000\000\000\002\000\000\000\000\000\000\000"},
+ {270, "flow_stmt", 0, 2, states_14,
+ "\000\000\000\000\340\000\000\000\000\000\000\000"},
+ {271, "break_stmt", 0, 3, states_15,
+ "\000\000\000\000\040\000\000\000\000\000\000\000"},
+ {272, "return_stmt", 0, 4, states_16,
+ "\000\000\000\000\100\000\000\000\000\000\000\000"},
+ {273, "raise_stmt", 0, 6, states_17,
+ "\000\000\000\000\200\000\000\000\000\000\000\000"},
+ {274, "import_stmt", 0, 10, states_18,
+ "\000\000\000\000\000\006\000\000\000\000\000\000"},
+ {275, "compound_stmt", 0, 2, states_19,
+ "\000\020\000\000\000\000\262\000\000\000\000\001"},
+ {276, "if_stmt", 0, 8, states_20,
+ "\000\000\000\000\000\000\002\000\000\000\000\000"},
+ {277, "while_stmt", 0, 8, states_21,
+ "\000\000\000\000\000\000\020\000\000\000\000\000"},
+ {278, "for_stmt", 0, 10, states_22,
+ "\000\000\000\000\000\000\040\000\000\000\000\000"},
+ {279, "try_stmt", 0, 7, states_23,
+ "\000\000\000\000\000\000\200\000\000\000\000\000"},
+ {280, "except_clause", 0, 5, states_24,
+ "\000\000\000\000\000\000\000\004\000\000\000\000"},
+ {281, "suite", 0, 5, states_25,
+ "\004\040\002\100\343\006\000\000\000\203\072\000"},
+ {282, "test", 0, 2, states_26,
+ "\000\040\002\000\000\000\000\000\002\203\072\000"},
+ {283, "and_test", 0, 2, states_27,
+ "\000\040\002\000\000\000\000\000\002\203\072\000"},
+ {284, "not_test", 0, 3, states_28,
+ "\000\040\002\000\000\000\000\000\002\203\072\000"},
+ {285, "comparison", 0, 2, states_29,
+ "\000\040\002\000\000\000\000\000\000\203\072\000"},
+ {286, "comp_op", 0, 6, states_30,
+ "\000\000\000\040\000\000\100\000\162\000\000\000"},
+ {287, "expr", 0, 2, states_31,
+ "\000\040\002\000\000\000\000\000\000\203\072\000"},
+ {288, "term", 0, 2, states_32,
+ "\000\040\002\000\000\000\000\000\000\203\072\000"},
+ {289, "factor", 0, 4, states_33,
+ "\000\040\002\000\000\000\000\000\000\203\072\000"},
+ {290, "atom", 0, 9, states_34,
+ "\000\040\002\000\000\000\000\000\000\200\072\000"},
+ {291, "trailer", 0, 7, states_35,
+ "\000\000\002\000\000\000\000\000\000\200\200\000"},
+ {292, "subscript", 0, 4, states_36,
+ "\000\240\002\000\000\000\000\000\000\203\072\000"},
+ {293, "exprlist", 0, 3, states_37,
+ "\000\040\002\000\000\000\000\000\000\203\072\000"},
+ {294, "testlist", 0, 3, states_38,
+ "\000\040\002\000\000\000\000\000\002\203\072\000"},
+ {295, "classdef", 0, 8, states_39,
+ "\000\000\000\000\000\000\000\000\000\000\000\001"},
+ {296, "baselist", 0, 3, states_40,
+ "\000\040\002\000\000\000\000\000\000\200\072\000"},
+ {297, "arguments", 0, 4, states_41,
+ "\000\000\002\000\000\000\000\000\000\000\000\000"},
+};
+static label labels[91] = {
+ {0, "EMPTY"},
+ {256, 0},
+ {4, 0},
+ {265, 0},
+ {275, 0},
+ {257, 0},
+ {264, 0},
+ {0, 0},
+ {258, 0},
+ {294, 0},
+ {259, 0},
+ {260, 0},
+ {1, "def"},
+ {1, 0},
+ {261, 0},
+ {11, 0},
+ {281, 0},
+ {7, 0},
+ {262, 0},
+ {8, 0},
+ {263, 0},
+ {12, 0},
+ {266, 0},
+ {267, 0},
+ {269, 0},
+ {268, 0},
+ {270, 0},
+ {274, 0},
+ {293, 0},
+ {22, 0},
+ {1, "print"},
+ {282, 0},
+ {1, "del"},
+ {1, "pass"},
+ {271, 0},
+ {272, 0},
+ {273, 0},
+ {1, "break"},
+ {1, "return"},
+ {1, "raise"},
+ {287, 0},
+ {1, "import"},
+ {1, "from"},
+ {16, 0},
+ {276, 0},
+ {277, 0},
+ {278, 0},
+ {279, 0},
+ {295, 0},
+ {1, "if"},
+ {1, "elif"},
+ {1, "else"},
+ {1, "while"},
+ {1, "for"},
+ {1, "in"},
+ {1, "try"},
+ {280, 0},
+ {1, "finally"},
+ {1, "except"},
+ {5, 0},
+ {6, 0},
+ {283, 0},
+ {1, "or"},
+ {284, 0},
+ {1, "and"},
+ {1, "not"},
+ {285, 0},
+ {286, 0},
+ {20, 0},
+ {21, 0},
+ {1, "is"},
+ {288, 0},
+ {14, 0},
+ {15, 0},
+ {289, 0},
+ {17, 0},
+ {24, 0},
+ {290, 0},
+ {291, 0},
+ {9, 0},
+ {10, 0},
+ {26, 0},
+ {27, 0},
+ {25, 0},
+ {2, 0},
+ {3, 0},
+ {292, 0},
+ {23, 0},
+ {1, "class"},
+ {296, 0},
+ {297, 0},
+};
+grammar gram = {
+ 42,
+ dfas,
+ {91, labels},
+ 256
+};
diff --git a/src/graminit.h b/src/graminit.h
new file mode 100644
index 0000000..051b549
--- /dev/null
+++ b/src/graminit.h
@@ -0,0 +1,66 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+#define single_input 256
+#define file_input 257
+#define expr_input 258
+#define eval_input 259
+#define funcdef 260
+#define parameters 261
+#define fplist 262
+#define fpdef 263
+#define stmt 264
+#define simple_stmt 265
+#define expr_stmt 266
+#define print_stmt 267
+#define del_stmt 268
+#define pass_stmt 269
+#define flow_stmt 270
+#define break_stmt 271
+#define return_stmt 272
+#define raise_stmt 273
+#define import_stmt 274
+#define compound_stmt 275
+#define if_stmt 276
+#define while_stmt 277
+#define for_stmt 278
+#define try_stmt 279
+#define except_clause 280
+#define suite 281
+#define test 282
+#define and_test 283
+#define not_test 284
+#define comparison 285
+#define comp_op 286
+#define expr 287
+#define term 288
+#define factor 289
+#define atom 290
+#define trailer 291
+#define subscript 292
+#define exprlist 293
+#define testlist 294
+#define classdef 295
+#define baselist 296
+#define arguments 297
diff --git a/src/grammar.c b/src/grammar.c
new file mode 100644
index 0000000..4ba4a1a
--- /dev/null
+++ b/src/grammar.c
@@ -0,0 +1,233 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Grammar implementation */
+
+#include "pgenheaders.h"
+
+#include <ctype.h>
+
+#include "assert.h"
+#include "token.h"
+#include "grammar.h"
+
+extern int debugging;
+
+grammar *
+newgrammar(start)
+ int start;
+{
+ grammar *g;
+
+ g = NEW(grammar, 1);
+ if (g == NULL)
+ fatal("no mem for new grammar");
+ g->g_ndfas = 0;
+ g->g_dfa = NULL;
+ g->g_start = start;
+ g->g_ll.ll_nlabels = 0;
+ g->g_ll.ll_label = NULL;
+ return g;
+}
+
+dfa *
+adddfa(g, type, name)
+ grammar *g;
+ int type;
+ char *name;
+{
+ dfa *d;
+
+ RESIZE(g->g_dfa, dfa, g->g_ndfas + 1);
+ if (g->g_dfa == NULL)
+ fatal("no mem to resize dfa in adddfa");
+ d = &g->g_dfa[g->g_ndfas++];
+ d->d_type = type;
+ d->d_name = name;
+ d->d_nstates = 0;
+ d->d_state = NULL;
+ d->d_initial = -1;
+ d->d_first = NULL;
+ return d; /* Only use while fresh! */
+}
+
+int
+addstate(d)
+ dfa *d;
+{
+ state *s;
+
+ RESIZE(d->d_state, state, d->d_nstates + 1);
+ if (d->d_state == NULL)
+ fatal("no mem to resize state in addstate");
+ s = &d->d_state[d->d_nstates++];
+ s->s_narcs = 0;
+ s->s_arc = NULL;
+ return s - d->d_state;
+}
+
+void
+addarc(d, from, to, lbl)
+ dfa *d;
+ int lbl;
+{
+ state *s;
+ arc *a;
+
+ assert(0 <= from && from < d->d_nstates);
+ assert(0 <= to && to < d->d_nstates);
+
+ s = &d->d_state[from];
+ RESIZE(s->s_arc, arc, s->s_narcs + 1);
+ if (s->s_arc == NULL)
+ fatal("no mem to resize arc list in addarc");
+ a = &s->s_arc[s->s_narcs++];
+ a->a_lbl = lbl;
+ a->a_arrow = to;
+}
+
+int
+addlabel(ll, type, str)
+ labellist *ll;
+ int type;
+ char *str;
+{
+ int i;
+ label *lb;
+
+ for (i = 0; i < ll->ll_nlabels; i++) {
+ if (ll->ll_label[i].lb_type == type &&
+ strcmp(ll->ll_label[i].lb_str, str) == 0)
+ return i;
+ }
+ RESIZE(ll->ll_label, label, ll->ll_nlabels + 1);
+ if (ll->ll_label == NULL)
+ fatal("no mem to resize labellist in addlabel");
+ lb = &ll->ll_label[ll->ll_nlabels++];
+ lb->lb_type = type;
+ lb->lb_str = str; /* XXX strdup(str) ??? */
+ return lb - ll->ll_label;
+}
+
+/* Same, but rather dies than adds */
+
+int
+findlabel(ll, type, str)
+ labellist *ll;
+ int type;
+ char *str;
+{
+ int i;
+ label *lb;
+
+ for (i = 0; i < ll->ll_nlabels; i++) {
+ if (ll->ll_label[i].lb_type == type /*&&
+ strcmp(ll->ll_label[i].lb_str, str) == 0*/)
+ return i;
+ }
+ fprintf(stderr, "Label %d/'%s' not found\n", type, str);
+ abort();
+}
+
+/* Forward */
+static void translabel PROTO((grammar *, label *));
+
+void
+translatelabels(g)
+ grammar *g;
+{
+ int i;
+
+ printf("Translating labels ...\n");
+ /* Don't translate EMPTY */
+ for (i = EMPTY+1; i < g->g_ll.ll_nlabels; i++)
+ translabel(g, &g->g_ll.ll_label[i]);
+}
+
+static void
+translabel(g, lb)
+ grammar *g;
+ label *lb;
+{
+ int i;
+
+ if (debugging)
+ printf("Translating label %s ...\n", labelrepr(lb));
+
+ if (lb->lb_type == NAME) {
+ for (i = 0; i < g->g_ndfas; i++) {
+ if (strcmp(lb->lb_str, g->g_dfa[i].d_name) == 0) {
+ if (debugging)
+ printf("Label %s is non-terminal %d.\n",
+ lb->lb_str,
+ g->g_dfa[i].d_type);
+ lb->lb_type = g->g_dfa[i].d_type;
+ lb->lb_str = NULL;
+ return;
+ }
+ }
+ for (i = 0; i < (int)N_TOKENS; i++) {
+ if (strcmp(lb->lb_str, tok_name[i]) == 0) {
+ if (debugging)
+ printf("Label %s is terminal %d.\n",
+ lb->lb_str, i);
+ lb->lb_type = i;
+ lb->lb_str = NULL;
+ return;
+ }
+ }
+ printf("Can't translate NAME label '%s'\n", lb->lb_str);
+ return;
+ }
+
+ if (lb->lb_type == STRING) {
+ if (isalpha(lb->lb_str[1])) {
+ char *p, *strchr();
+ if (debugging)
+ printf("Label %s is a keyword\n", lb->lb_str);
+ lb->lb_type = NAME;
+ lb->lb_str++;
+ p = strchr(lb->lb_str, '\'');
+ if (p)
+ *p = '\0';
+ }
+ else {
+ if (lb->lb_str[2] == lb->lb_str[0]) {
+ int type = (int) tok_1char(lb->lb_str[1]);
+ if (type != OP) {
+ lb->lb_type = type;
+ lb->lb_str = NULL;
+ }
+ else
+ printf("Unknown OP label %s\n",
+ lb->lb_str);
+ }
+ else
+ printf("Can't translate STRING label %s\n",
+ lb->lb_str);
+ }
+ }
+ else
+ printf("Can't translate label '%s'\n", labelrepr(lb));
+}
diff --git a/src/grammar.h b/src/grammar.h
new file mode 100644
index 0000000..82f34c3
--- /dev/null
+++ b/src/grammar.h
@@ -0,0 +1,105 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Grammar interface */
+
+#include "bitset.h" /* Sigh... */
+
+/* A label of an arc */
+
+typedef struct _label {
+ int lb_type;
+ char *lb_str;
+} label;
+
+#define EMPTY 0 /* Label number 0 is by definition the empty label */
+
+/* A list of labels */
+
+typedef struct _labellist {
+ int ll_nlabels;
+ label *ll_label;
+} labellist;
+
+/* An arc from one state to another */
+
+typedef struct _arc {
+ short a_lbl; /* Label of this arc */
+ short a_arrow; /* State where this arc goes to */
+} arc;
+
+/* A state in a DFA */
+
+typedef struct _state {
+ int s_narcs;
+ arc *s_arc; /* Array of arcs */
+
+ /* Optional accelerators */
+ int s_lower; /* Lowest label index */
+ int s_upper; /* Highest label index */
+ int *s_accel; /* Accelerator */
+ int s_accept; /* Nonzero for accepting state */
+} state;
+
+/* A DFA */
+
+typedef struct _dfa {
+ int d_type; /* Non-terminal this represents */
+ char *d_name; /* For printing */
+ int d_initial; /* Initial state */
+ int d_nstates;
+ state *d_state; /* Array of states */
+ bitset d_first;
+} dfa;
+
+/* A grammar */
+
+typedef struct _grammar {
+ int g_ndfas;
+ dfa *g_dfa; /* Array of DFAs */
+ labellist g_ll;
+ int g_start; /* Start symbol of the grammar */
+ int g_accel; /* Set if accelerators present */
+} grammar;
+
+/* FUNCTIONS */
+
+grammar *newgrammar PROTO((int start));
+dfa *adddfa PROTO((grammar *g, int type, char *name));
+int addstate PROTO((dfa *d));
+void addarc PROTO((dfa *d, int from, int to, int lbl));
+dfa *finddfa PROTO((grammar *g, int type));
+char *typename PROTO((grammar *g, int lbl));
+
+int addlabel PROTO((labellist *ll, int type, char *str));
+int findlabel PROTO((labellist *ll, int type, char *str));
+char *labelrepr PROTO((label *lb));
+void translatelabels PROTO((grammar *g));
+
+void addfirstsets PROTO((grammar *g));
+
+void addaccellerators PROTO((grammar *g));
+
+void printgrammar PROTO((grammar *g, FILE *fp));
+void printnonterminals PROTO((grammar *g, FILE *fp));
diff --git a/src/grammar1.c b/src/grammar1.c
new file mode 100644
index 0000000..eafe4fe
--- /dev/null
+++ b/src/grammar1.c
@@ -0,0 +1,75 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Grammar subroutines needed by parser */
+
+#include "pgenheaders.h"
+#include "assert.h"
+#include "grammar.h"
+#include "token.h"
+
+/* Return the DFA for the given type */
+
+dfa *
+finddfa(g, type)
+ grammar *g;
+ register int type;
+{
+ register int i;
+ register dfa *d;
+
+ for (i = g->g_ndfas, d = g->g_dfa; --i >= 0; d++) {
+ if (d->d_type == type)
+ return d;
+ }
+ assert(0);
+ /* NOTREACHED */
+}
+
+char *
+labelrepr(lb)
+ label *lb;
+{
+ static char buf[100];
+
+ if (lb->lb_type == ENDMARKER)
+ return "EMPTY";
+ else if (ISNONTERMINAL(lb->lb_type)) {
+ if (lb->lb_str == NULL) {
+ sprintf(buf, "NT%d", lb->lb_type);
+ return buf;
+ }
+ else
+ return lb->lb_str;
+ }
+ else {
+ if (lb->lb_str == NULL)
+ return tok_name[lb->lb_type];
+ else {
+ sprintf(buf, "%.32s(%.32s)",
+ tok_name[lb->lb_type], lb->lb_str);
+ return buf;
+ }
+ }
+}
diff --git a/src/import.c b/src/import.c
new file mode 100644
index 0000000..d461007
--- /dev/null
+++ b/src/import.c
@@ -0,0 +1,259 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Module definition and import implementation */
+
+#include "allobjects.h"
+
+#include "node.h"
+#include "token.h"
+#include "graminit.h"
+#include "import.h"
+#include "errcode.h"
+#include "sysmodule.h"
+#include "pythonrun.h"
+
+/* Define pathname separator used in file names */
+
+#ifdef THINK_C
+#define SEP ':'
+#endif
+
+#ifndef SEP
+#define SEP '/'
+#endif
+
+static object *modules;
+
+/* Initialization */
+
+void
+initimport()
+{
+ if ((modules = newdictobject()) == NULL)
+ fatal("no mem for dictionary of modules");
+}
+
+object *
+get_modules()
+{
+ return modules;
+}
+
+object *
+add_module(name)
+ char *name;
+{
+ object *m;
+ if ((m = dictlookup(modules, name)) != NULL && is_moduleobject(m))
+ return m;
+ m = newmoduleobject(name);
+ if (m == NULL)
+ return NULL;
+ if (dictinsert(modules, name, m) != 0) {
+ DECREF(m);
+ return NULL;
+ }
+ DECREF(m); /* Yes, it still exists, in modules! */
+ return m;
+}
+
+static FILE *
+open_module(name, suffix, namebuf)
+ char *name;
+ char *suffix;
+ char *namebuf; /* XXX No buffer overflow checks! */
+{
+ object *path;
+ FILE *fp;
+
+ path = sysget("path");
+ if (path == NULL || !is_listobject(path)) {
+ strcpy(namebuf, name);
+ strcat(namebuf, suffix);
+ fp = fopen(namebuf, "r");
+ }
+ else {
+ int npath = getlistsize(path);
+ int i;
+ fp = NULL;
+ for (i = 0; i < npath; i++) {
+ object *v = getlistitem(path, i);
+ int len;
+ if (!is_stringobject(v))
+ continue;
+ strcpy(namebuf, getstringvalue(v));
+ len = getstringsize(v);
+ if (len > 0 && namebuf[len-1] != SEP)
+ namebuf[len++] = SEP;
+ strcpy(namebuf+len, name);
+ strcat(namebuf, suffix);
+ fp = fopen(namebuf, "r");
+ if (fp != NULL)
+ break;
+ }
+ }
+ return fp;
+}
+
+static object *
+get_module(m, name, m_ret)
+ /*module*/object *m;
+ char *name;
+ object **m_ret;
+{
+ object *d;
+ FILE *fp;
+ node *n;
+ int err;
+ char namebuf[256];
+
+ fp = open_module(name, ".py", namebuf);
+ if (fp == NULL) {
+ if (m == NULL)
+ err_setstr(NameError, name);
+ else
+ err_setstr(RuntimeError, "no module source file");
+ return NULL;
+ }
+ err = parse_file(fp, namebuf, file_input, &n);
+ fclose(fp);
+ if (err != E_DONE) {
+ err_input(err);
+ return NULL;
+ }
+ if (m == NULL) {
+ m = add_module(name);
+ if (m == NULL) {
+ freetree(n);
+ return NULL;
+ }
+ *m_ret = m;
+ }
+ d = getmoduledict(m);
+ return run_node(n, namebuf, d, d);
+}
+
+static object *
+load_module(name)
+ char *name;
+{
+ object *m, *v;
+ v = get_module((object *)NULL, name, &m);
+ if (v == NULL)
+ return NULL;
+ DECREF(v);
+ return m;
+}
+
+object *
+import_module(name)
+ char *name;
+{
+ object *m;
+ if ((m = dictlookup(modules, name)) == NULL) {
+ if (init_builtin(name)) {
+ if ((m = dictlookup(modules, name)) == NULL)
+ err_setstr(SystemError, "builtin module missing");
+ }
+ else {
+ m = load_module(name);
+ }
+ }
+ return m;
+}
+
+object *
+reload_module(m)
+ object *m;
+{
+ if (m == NULL || !is_moduleobject(m)) {
+ err_setstr(TypeError, "reload() argument must be module");
+ return NULL;
+ }
+ /* XXX Ought to check for builtin modules -- can't reload these... */
+ return get_module(m, getmodulename(m), (object **)NULL);
+}
+
+static void
+cleardict(d)
+ object *d;
+{
+ int i;
+ for (i = getdictsize(d); --i >= 0; ) {
+ char *k;
+ k = getdictkey(d, i);
+ if (k != NULL)
+ (void) dictremove(d, k);
+ }
+}
+
+void
+doneimport()
+{
+ if (modules != NULL) {
+ int i;
+ /* Explicitly erase all modules; this is the safest way
+ to get rid of at least *some* circular dependencies */
+ for (i = getdictsize(modules); --i >= 0; ) {
+ char *k;
+ k = getdictkey(modules, i);
+ if (k != NULL) {
+ object *m;
+ m = dictlookup(modules, k);
+ if (m != NULL && is_moduleobject(m)) {
+ object *d;
+ d = getmoduledict(m);
+ if (d != NULL && is_dictobject(d)) {
+ cleardict(d);
+ }
+ }
+ }
+ }
+ cleardict(modules);
+ }
+ DECREF(modules);
+}
+
+
+/* Initialize built-in modules when first imported */
+
+extern struct {
+ char *name;
+ void (*initfunc)();
+} inittab[];
+
+static int
+init_builtin(name)
+ char *name;
+{
+ int i;
+ for (i = 0; inittab[i].name != NULL; i++) {
+ if (strcmp(name, inittab[i].name) == 0) {
+ (*inittab[i].initfunc)();
+ return 1;
+ }
+ }
+ return 0;
+}
diff --git a/src/import.h b/src/import.h
new file mode 100644
index 0000000..0923395
--- /dev/null
+++ b/src/import.h
@@ -0,0 +1,31 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Module definition and import interface */
+
+object *get_modules PROTO((void));
+object *add_module PROTO((char *name));
+object *import_module PROTO((char *name));
+object *reload_module PROTO((object *m));
+void doneimport PROTO((void));
diff --git a/src/intobject.c b/src/intobject.c
new file mode 100644
index 0000000..dba9cc6
--- /dev/null
+++ b/src/intobject.c
@@ -0,0 +1,307 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Integer object implementation */
+
+#include "allobjects.h"
+
+/* Standard Booleans */
+
+intobject FalseObject = {
+ OB_HEAD_INIT(&Inttype)
+ 0
+};
+
+intobject TrueObject = {
+ OB_HEAD_INIT(&Inttype)
+ 1
+};
+
+static object *
+err_ovf()
+{
+ err_setstr(OverflowError, "integer overflow");
+ return NULL;
+}
+
+static object *
+err_zdiv()
+{
+ err_setstr(ZeroDivisionError, "integer division by zero");
+ return NULL;
+}
+
+/* Integers are quite normal objects, to make object handling uniform.
+ (Using odd pointers to represent integers would save much space
+ but require extra checks for this special case throughout the code.)
+ Since, a typical Python program spends much of its time allocating
+ and deallocating integers, these operations should be very fast.
+ Therefore we use a dedicated allocation scheme with a much lower
+ overhead (in space and time) than straight malloc(): a simple
+ dedicated free list, filled when necessary with memory from malloc().
+*/
+
+#define BLOCK_SIZE 1000 /* 1K less typical malloc overhead */
+#define N_INTOBJECTS (BLOCK_SIZE / sizeof(intobject))
+
+static intobject *
+fill_free_list()
+{
+ intobject *p, *q;
+ p = NEW(intobject, N_INTOBJECTS);
+ if (p == NULL)
+ return (intobject *)err_nomem();
+ q = p + N_INTOBJECTS;
+ while (--q > p)
+ *(intobject **)q = q-1;
+ *(intobject **)q = NULL;
+ return p + N_INTOBJECTS - 1;
+}
+
+static intobject *free_list = NULL;
+
+object *
+newintobject(ival)
+ long ival;
+{
+ register intobject *v;
+ if (free_list == NULL) {
+ if ((free_list = fill_free_list()) == NULL)
+ return NULL;
+ }
+ v = free_list;
+ free_list = *(intobject **)free_list;
+ NEWREF(v);
+ v->ob_type = &Inttype;
+ v->ob_ival = ival;
+ return (object *) v;
+}
+
+static void
+int_dealloc(v)
+ intobject *v;
+{
+ *(intobject **)v = free_list;
+ free_list = v;
+}
+
+long
+getintvalue(op)
+ register object *op;
+{
+ if (!is_intobject(op)) {
+ err_badcall();
+ return -1;
+ }
+ else
+ return ((intobject *)op) -> ob_ival;
+}
+
+/* Methods */
+
+static void
+int_print(v, fp, flags)
+ intobject *v;
+ FILE *fp;
+ int flags;
+{
+ fprintf(fp, "%ld", v->ob_ival);
+}
+
+static object *
+int_repr(v)
+ intobject *v;
+{
+ char buf[20];
+ sprintf(buf, "%ld", v->ob_ival);
+ return newstringobject(buf);
+}
+
+static int
+int_compare(v, w)
+ intobject *v, *w;
+{
+ register long i = v->ob_ival;
+ register long j = w->ob_ival;
+ return (i < j) ? -1 : (i > j) ? 1 : 0;
+}
+
+static object *
+int_add(v, w)
+ intobject *v;
+ register object *w;
+{
+ register long a, b, x;
+ if (!is_intobject(w)) {
+ err_badarg();
+ return NULL;
+ }
+ a = v->ob_ival;
+ b = ((intobject *)w) -> ob_ival;
+ x = a + b;
+ if ((x^a) < 0 && (x^b) < 0)
+ return err_ovf();
+ return newintobject(x);
+}
+
+static object *
+int_sub(v, w)
+ intobject *v;
+ register object *w;
+{
+ register long a, b, x;
+ if (!is_intobject(w)) {
+ err_badarg();
+ return NULL;
+ }
+ a = v->ob_ival;
+ b = ((intobject *)w) -> ob_ival;
+ x = a - b;
+ if ((x^a) < 0 && (x^~b) < 0)
+ return err_ovf();
+ return newintobject(x);
+}
+
+static object *
+int_mul(v, w)
+ intobject *v;
+ register object *w;
+{
+ register long a, b;
+ double x;
+ if (!is_intobject(w)) {
+ err_badarg();
+ return NULL;
+ }
+ a = v->ob_ival;
+ b = ((intobject *)w) -> ob_ival;
+ x = (double)a * (double)b;
+ if (x > 0x7fffffff || x < (double) (long) 0x80000000)
+ return err_ovf();
+ return newintobject(a * b);
+}
+
+static object *
+int_div(v, w)
+ intobject *v;
+ register object *w;
+{
+ if (!is_intobject(w)) {
+ err_badarg();
+ return NULL;
+ }
+ if (((intobject *)w) -> ob_ival == 0)
+ return err_zdiv();
+ return newintobject(v->ob_ival / ((intobject *)w) -> ob_ival);
+}
+
+static object *
+int_rem(v, w)
+ intobject *v;
+ register object *w;
+{
+ if (!is_intobject(w)) {
+ err_badarg();
+ return NULL;
+ }
+ if (((intobject *)w) -> ob_ival == 0)
+ return err_zdiv();
+ return newintobject(v->ob_ival % ((intobject *)w) -> ob_ival);
+}
+
+static object *
+int_pow(v, w)
+ intobject *v;
+ register object *w;
+{
+ register long iv, iw, ix;
+ register int neg;
+ if (!is_intobject(w)) {
+ err_badarg();
+ return NULL;
+ }
+ iv = v->ob_ival;
+ iw = ((intobject *)w)->ob_ival;
+ neg = 0;
+ if (iw < 0)
+ neg = 1, iw = -iw;
+ ix = 1;
+ for (; iw > 0; iw--)
+ ix = ix * iv;
+ if (neg) {
+ if (ix == 0)
+ return err_zdiv();
+ ix = 1/ix;
+ }
+ /* XXX How to check for overflow? */
+ return newintobject(ix);
+}
+
+static object *
+int_neg(v)
+ intobject *v;
+{
+ register long a, x;
+ a = v->ob_ival;
+ x = -a;
+ if (a < 0 && x < 0)
+ return err_ovf();
+ return newintobject(x);
+}
+
+static object *
+int_pos(v)
+ intobject *v;
+{
+ INCREF(v);
+ return (object *)v;
+}
+
+static number_methods int_as_number = {
+ int_add, /*tp_add*/
+ int_sub, /*tp_subtract*/
+ int_mul, /*tp_multiply*/
+ int_div, /*tp_divide*/
+ int_rem, /*tp_remainder*/
+ int_pow, /*tp_power*/
+ int_neg, /*tp_negate*/
+ int_pos, /*tp_plus*/
+};
+
+typeobject Inttype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "int",
+ sizeof(intobject),
+ 0,
+ int_dealloc, /*tp_dealloc*/
+ int_print, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ int_compare, /*tp_compare*/
+ int_repr, /*tp_repr*/
+ &int_as_number, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
diff --git a/src/intobject.h b/src/intobject.h
new file mode 100644
index 0000000..8a5330d
--- /dev/null
+++ b/src/intobject.h
@@ -0,0 +1,72 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Integer object interface */
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+intobject represents a (long) integer. This is an immutable object;
+an integer cannot change its value after creation.
+
+There are functions to create new integer objects, to test an object
+for integer-ness, and to get the integer value. The latter functions
+returns -1 and sets errno to EBADF if the object is not an intobject.
+None of the functions should be applied to nil objects.
+
+The type intobject is (unfortunately) exposed bere so we can declare
+TrueObject and FalseObject below; don't use this.
+*/
+
+typedef struct {
+ OB_HEAD
+ long ob_ival;
+} intobject;
+
+extern typeobject Inttype;
+
+#define is_intobject(op) ((op)->ob_type == &Inttype)
+
+extern object *newintobject PROTO((long));
+extern long getintvalue PROTO((object *));
+
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+False and True are special intobjects used by Boolean expressions.
+All values of type Boolean must point to either of these; but in
+contexts where integers are required they are integers (valued 0 and 1).
+Hope these macros don't conflict with other people's.
+
+Don't forget to apply INCREF() when returning True or False!!!
+*/
+
+extern intobject FalseObject, TrueObject; /* Don't use these directly */
+
+#define False ((object *) &FalseObject)
+#define True ((object *) &TrueObject)
+
+/* Macro, trading safety for speed */
+#define GETINTVALUE(op) ((op)->ob_ival)
diff --git a/src/intrcheck.c b/src/intrcheck.c
new file mode 100644
index 0000000..8e2fb5b
--- /dev/null
+++ b/src/intrcheck.c
@@ -0,0 +1,144 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Check for interrupts */
+
+#ifdef MSDOS
+
+/* This might work for MS-DOS (untested though): */
+
+void
+initintr()
+{
+}
+
+int
+intrcheck()
+{
+ int interrupted = 0;
+ while (kbhit()) {
+ if (getch() == '\003')
+ interrupted = 1;
+ }
+ return interrupted;
+}
+
+#define OK
+
+#endif
+
+
+#ifdef THINK_C
+
+/* This is for THINK C 4.0.
+ For 3.0, you may have to remove the signal stuff. */
+
+#include <MacHeaders>
+#include <signal.h>
+#include "sigtype.h"
+
+static int interrupted;
+
+static SIGTYPE
+intcatcher(sig)
+ int sig;
+{
+ interrupted = 1;
+ signal(SIGINT, intcatcher);
+}
+
+void
+initintr()
+{
+ if (signal(SIGINT, SIG_IGN) != SIG_IGN)
+ signal(SIGINT, intcatcher);
+}
+
+int
+intrcheck()
+{
+ register EvQElPtr q;
+
+ /* This is like THINK C 4.0's <console.h>.
+ I'm not sure why FlushEvents must be called from asm{}. */
+ for (q = (EvQElPtr)EventQueue.qHead; q; q = (EvQElPtr)q->qLink) {
+ if (q->evtQWhat == keyDown &&
+ (char)q->evtQMessage == '.' &&
+ (q->evtQModifiers & cmdKey) != 0) {
+
+ asm {
+ moveq #keyDownMask,d0
+ _FlushEvents
+ }
+ interrupted = 1;
+ break;
+ }
+ }
+ if (interrupted) {
+ interrupted = 0;
+ return 1;
+ }
+ return 0;
+}
+
+#define OK
+
+#endif /* THINK_C */
+
+
+#ifndef OK
+
+/* Default version -- for real operating systems and for Standard C */
+
+#include <stdio.h>
+#include <signal.h>
+#include "sigtype.h"
+
+static int interrupted;
+
+static SIGTYPE
+intcatcher(sig)
+ int sig;
+{
+ interrupted = 1;
+ signal(SIGINT, intcatcher);
+}
+
+void
+initintr()
+{
+ if (signal(SIGINT, SIG_IGN) != SIG_IGN)
+ signal(SIGINT, intcatcher);
+}
+
+int
+intrcheck()
+{
+ if (!interrupted)
+ return 0;
+ interrupted = 0;
+ return 1;
+}
+
+#endif /* !OK */
diff --git a/src/listnode.c b/src/listnode.c
new file mode 100644
index 0000000..333d01f
--- /dev/null
+++ b/src/listnode.c
@@ -0,0 +1,93 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* List a node on a file */
+
+#include "pgenheaders.h"
+#include "token.h"
+#include "node.h"
+
+/* Forward */
+static void list1node PROTO((FILE *, node *));
+
+void
+listtree(n)
+ node *n;
+{
+ listnode(stdout, n);
+}
+
+static int level, atbol;
+
+void
+listnode(fp, n)
+ FILE *fp;
+ node *n;
+{
+ level = 0;
+ atbol = 1;
+ list1node(fp, n);
+}
+
+static void
+list1node(fp, n)
+ FILE *fp;
+ node *n;
+{
+ if (n == 0)
+ return;
+ if (ISNONTERMINAL(TYPE(n))) {
+ int i;
+ for (i = 0; i < NCH(n); i++)
+ list1node(fp, CHILD(n, i));
+ }
+ else if (ISTERMINAL(TYPE(n))) {
+ switch (TYPE(n)) {
+ case INDENT:
+ ++level;
+ break;
+ case DEDENT:
+ --level;
+ break;
+ default:
+ if (atbol) {
+ int i;
+ for (i = 0; i < level; ++i)
+ fprintf(fp, "\t");
+ atbol = 0;
+ }
+ if (TYPE(n) == NEWLINE) {
+ if (STR(n) != NULL)
+ fprintf(fp, "%s", STR(n));
+ fprintf(fp, "\n");
+ atbol = 1;
+ }
+ else
+ fprintf(fp, "%s ", STR(n));
+ break;
+ }
+ }
+ else
+ fprintf(fp, "? ");
+}
diff --git a/src/listobject.c b/src/listobject.c
new file mode 100644
index 0000000..be1382c
--- /dev/null
+++ b/src/listobject.c
@@ -0,0 +1,519 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* List object implementation */
+
+#include "allobjects.h"
+
+object *
+newlistobject(size)
+ int size;
+{
+ int i;
+ listobject *op;
+ if (size < 0) {
+ err_badcall();
+ return NULL;
+ }
+ op = (listobject *) malloc(sizeof(listobject));
+ if (op == NULL) {
+ return err_nomem();
+ }
+ if (size <= 0) {
+ op->ob_item = NULL;
+ }
+ else {
+ op->ob_item = (object **) malloc(size * sizeof(object *));
+ if (op->ob_item == NULL) {
+ free((ANY *)op);
+ return err_nomem();
+ }
+ }
+ NEWREF(op);
+ op->ob_type = &Listtype;
+ op->ob_size = size;
+ for (i = 0; i < size; i++)
+ op->ob_item[i] = NULL;
+ return (object *) op;
+}
+
+int
+getlistsize(op)
+ object *op;
+{
+ if (!is_listobject(op)) {
+ err_badcall();
+ return -1;
+ }
+ else
+ return ((listobject *)op) -> ob_size;
+}
+
+object *
+getlistitem(op, i)
+ object *op;
+ int i;
+{
+ if (!is_listobject(op)) {
+ err_badcall();
+ return NULL;
+ }
+ if (i < 0 || i >= ((listobject *)op) -> ob_size) {
+ err_setstr(IndexError, "list index out of range");
+ return NULL;
+ }
+ return ((listobject *)op) -> ob_item[i];
+}
+
+int
+setlistitem(op, i, newitem)
+ register object *op;
+ register int i;
+ register object *newitem;
+{
+ register object *olditem;
+ if (!is_listobject(op)) {
+ if (newitem != NULL)
+ DECREF(newitem);
+ err_badcall();
+ return -1;
+ }
+ if (i < 0 || i >= ((listobject *)op) -> ob_size) {
+ if (newitem != NULL)
+ DECREF(newitem);
+ err_setstr(IndexError, "list assignment index out of range");
+ return -1;
+ }
+ olditem = ((listobject *)op) -> ob_item[i];
+ ((listobject *)op) -> ob_item[i] = newitem;
+ if (olditem != NULL)
+ DECREF(olditem);
+ return 0;
+}
+
+static int
+ins1(self, where, v)
+ listobject *self;
+ int where;
+ object *v;
+{
+ int i;
+ object **items;
+ if (v == NULL) {
+ err_badcall();
+ return -1;
+ }
+ items = self->ob_item;
+ RESIZE(items, object *, self->ob_size+1);
+ if (items == NULL) {
+ err_nomem();
+ return -1;
+ }
+ if (where < 0)
+ where = 0;
+ if (where > self->ob_size)
+ where = self->ob_size;
+ for (i = self->ob_size; --i >= where; )
+ items[i+1] = items[i];
+ INCREF(v);
+ items[where] = v;
+ self->ob_item = items;
+ self->ob_size++;
+ return 0;
+}
+
+int
+inslistitem(op, where, newitem)
+ object *op;
+ int where;
+ object *newitem;
+{
+ if (!is_listobject(op)) {
+ err_badcall();
+ return -1;
+ }
+ return ins1((listobject *)op, where, newitem);
+}
+
+int
+addlistitem(op, newitem)
+ object *op;
+ object *newitem;
+{
+ if (!is_listobject(op)) {
+ err_badcall();
+ return -1;
+ }
+ return ins1((listobject *)op,
+ (int) ((listobject *)op)->ob_size, newitem);
+}
+
+/* Methods */
+
+static void
+list_dealloc(op)
+ listobject *op;
+{
+ int i;
+ for (i = 0; i < op->ob_size; i++) {
+ if (op->ob_item[i] != NULL)
+ DECREF(op->ob_item[i]);
+ }
+ if (op->ob_item != NULL)
+ free((ANY *)op->ob_item);
+ free((ANY *)op);
+}
+
+static void
+list_print(op, fp, flags)
+ listobject *op;
+ FILE *fp;
+ int flags;
+{
+ int i;
+ fprintf(fp, "[");
+ for (i = 0; i < op->ob_size && !StopPrint; i++) {
+ if (i > 0) {
+ fprintf(fp, ", ");
+ }
+ printobject(op->ob_item[i], fp, flags);
+ }
+ fprintf(fp, "]");
+}
+
+object *
+list_repr(v)
+ listobject *v;
+{
+ object *s, *t, *comma;
+ int i;
+ s = newstringobject("[");
+ comma = newstringobject(", ");
+ for (i = 0; i < v->ob_size && s != NULL; i++) {
+ if (i > 0)
+ joinstring(&s, comma);
+ t = reprobject(v->ob_item[i]);
+ joinstring(&s, t);
+ DECREF(t);
+ }
+ DECREF(comma);
+ t = newstringobject("]");
+ joinstring(&s, t);
+ DECREF(t);
+ return s;
+}
+
+static int
+list_compare(v, w)
+ listobject *v, *w;
+{
+ int len = (v->ob_size < w->ob_size) ? v->ob_size : w->ob_size;
+ int i;
+ for (i = 0; i < len; i++) {
+ int cmp = cmpobject(v->ob_item[i], w->ob_item[i]);
+ if (cmp != 0)
+ return cmp;
+ }
+ return v->ob_size - w->ob_size;
+}
+
+static int
+list_length(a)
+ listobject *a;
+{
+ return a->ob_size;
+}
+
+static object *
+list_item(a, i)
+ listobject *a;
+ int i;
+{
+ if (i < 0 || i >= a->ob_size) {
+ err_setstr(IndexError, "list index out of range");
+ return NULL;
+ }
+ INCREF(a->ob_item[i]);
+ return a->ob_item[i];
+}
+
+static object *
+list_slice(a, ilow, ihigh)
+ listobject *a;
+ int ilow, ihigh;
+{
+ listobject *np;
+ int i;
+ if (ilow < 0)
+ ilow = 0;
+ else if (ilow > a->ob_size)
+ ilow = a->ob_size;
+ if (ihigh < 0)
+ ihigh = 0;
+ if (ihigh < ilow)
+ ihigh = ilow;
+ else if (ihigh > a->ob_size)
+ ihigh = a->ob_size;
+ np = (listobject *) newlistobject(ihigh - ilow);
+ if (np == NULL)
+ return NULL;
+ for (i = ilow; i < ihigh; i++) {
+ object *v = a->ob_item[i];
+ INCREF(v);
+ np->ob_item[i - ilow] = v;
+ }
+ return (object *)np;
+}
+
+static object *
+list_concat(a, bb)
+ listobject *a;
+ object *bb;
+{
+ int size;
+ int i;
+ listobject *np;
+ if (!is_listobject(bb)) {
+ err_badarg();
+ return NULL;
+ }
+#define b ((listobject *)bb)
+ size = a->ob_size + b->ob_size;
+ np = (listobject *) newlistobject(size);
+ if (np == NULL) {
+ return err_nomem();
+ }
+ for (i = 0; i < a->ob_size; i++) {
+ object *v = a->ob_item[i];
+ INCREF(v);
+ np->ob_item[i] = v;
+ }
+ for (i = 0; i < b->ob_size; i++) {
+ object *v = b->ob_item[i];
+ INCREF(v);
+ np->ob_item[i + a->ob_size] = v;
+ }
+ return (object *)np;
+#undef b
+}
+
+static int
+list_ass_item(a, i, v)
+ listobject *a;
+ int i;
+ object *v;
+{
+ if (i < 0 || i >= a->ob_size) {
+ err_setstr(IndexError, "list assignment index out of range");
+ return -1;
+ }
+ if (v == NULL)
+ return list_ass_slice(a, i, i+1, v);
+ INCREF(v);
+ DECREF(a->ob_item[i]);
+ a->ob_item[i] = v;
+ return 0;
+}
+
+static int
+list_ass_slice(a, ilow, ihigh, v)
+ listobject *a;
+ int ilow, ihigh;
+ object *v;
+{
+ object **item;
+ int n; /* Size of replacement list */
+ int d; /* Change in size */
+ int k; /* Loop index */
+#define b ((listobject *)v)
+ if (v == NULL)
+ n = 0;
+ else if (is_listobject(v))
+ n = b->ob_size;
+ else {
+ err_badarg();
+ return -1;
+ }
+ if (ilow < 0)
+ ilow = 0;
+ else if (ilow > a->ob_size)
+ ilow = a->ob_size;
+ if (ihigh < 0)
+ ihigh = 0;
+ if (ihigh < ilow)
+ ihigh = ilow;
+ else if (ihigh > a->ob_size)
+ ihigh = a->ob_size;
+ item = a->ob_item;
+ d = n - (ihigh-ilow);
+ if (d <= 0) { /* Delete -d items; DECREF ihigh-ilow items */
+ for (k = ilow; k < ihigh; k++)
+ DECREF(item[k]);
+ if (d < 0) {
+ for (/*k = ihigh*/; k < a->ob_size; k++)
+ item[k+d] = item[k];
+ a->ob_size += d;
+ RESIZE(item, object *, a->ob_size); /* Can't fail */
+ a->ob_item = item;
+ }
+ }
+ else { /* Insert d items; DECREF ihigh-ilow items */
+ RESIZE(item, object *, a->ob_size + d);
+ if (item == NULL) {
+ err_nomem();
+ return -1;
+ }
+ for (k = a->ob_size; --k >= ihigh; )
+ item[k+d] = item[k];
+ for (/*k = ihigh-1*/; k >= ilow; --k)
+ DECREF(item[k]);
+ a->ob_item = item;
+ a->ob_size += d;
+ }
+ for (k = 0; k < n; k++, ilow++) {
+ object *w = b->ob_item[k];
+ INCREF(w);
+ item[ilow] = w;
+ }
+ return 0;
+#undef b
+}
+
+static object *
+ins(self, where, v)
+ listobject *self;
+ int where;
+ object *v;
+{
+ if (ins1(self, where, v) != 0)
+ return NULL;
+ INCREF(None);
+ return None;
+}
+
+static object *
+listinsert(self, args)
+ listobject *self;
+ object *args;
+{
+ int i;
+ if (args == NULL || !is_tupleobject(args) || gettuplesize(args) != 2) {
+ err_badarg();
+ return NULL;
+ }
+ if (!getintarg(gettupleitem(args, 0), &i))
+ return NULL;
+ return ins(self, i, gettupleitem(args, 1));
+}
+
+static object *
+listappend(self, args)
+ listobject *self;
+ object *args;
+{
+ return ins(self, (int) self->ob_size, args);
+}
+
+static int
+cmp(v, w)
+ char *v, *w;
+{
+ return cmpobject(* (object **) v, * (object **) w);
+}
+
+static object *
+listsort(self, args)
+ listobject *self;
+ object *args;
+{
+ if (args != NULL) {
+ err_badarg();
+ return NULL;
+ }
+ err_clear();
+ if (self->ob_size > 1)
+ qsort((char *)self->ob_item,
+ (int) self->ob_size, sizeof(object *), cmp);
+ if (err_occurred())
+ return NULL;
+ INCREF(None);
+ return None;
+}
+
+int
+sortlist(v)
+ object *v;
+{
+ if (v == NULL || !is_listobject(v)) {
+ err_badcall();
+ return -1;
+ }
+ v = listsort((listobject *)v, (object *)NULL);
+ if (v == NULL)
+ return -1;
+ DECREF(v);
+ return 0;
+}
+
+static struct methodlist list_methods[] = {
+ {"append", listappend},
+ {"insert", listinsert},
+ {"sort", listsort},
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+list_getattr(f, name)
+ listobject *f;
+ char *name;
+{
+ return findmethod(list_methods, (object *)f, name);
+}
+
+static sequence_methods list_as_sequence = {
+ list_length, /*sq_length*/
+ list_concat, /*sq_concat*/
+ 0, /*sq_repeat*/
+ list_item, /*sq_item*/
+ list_slice, /*sq_slice*/
+ list_ass_item, /*sq_ass_item*/
+ list_ass_slice, /*sq_ass_slice*/
+};
+
+typeobject Listtype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "list",
+ sizeof(listobject),
+ 0,
+ list_dealloc, /*tp_dealloc*/
+ list_print, /*tp_print*/
+ list_getattr, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ list_compare, /*tp_compare*/
+ list_repr, /*tp_repr*/
+ 0, /*tp_as_number*/
+ &list_as_sequence, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
diff --git a/src/listobject.h b/src/listobject.h
new file mode 100644
index 0000000..103ceb6
--- /dev/null
+++ b/src/listobject.h
@@ -0,0 +1,59 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* List object interface */
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+Another generally useful object type is an list of object pointers.
+This is a mutable type: the list items can be changed, and items can be
+added or removed. Out-of-range indices or non-list objects are ignored.
+
+*** WARNING *** setlistitem does not increment the new item's reference
+count, but does decrement the reference count of the item it replaces,
+if not nil. It does *decrement* the reference count if it is *not*
+inserted in the list. Similarly, getlistitem does not increment the
+returned item's reference count.
+*/
+
+typedef struct {
+ OB_VARHEAD
+ object **ob_item;
+} listobject;
+
+extern typeobject Listtype;
+
+#define is_listobject(op) ((op)->ob_type == &Listtype)
+
+extern object *newlistobject PROTO((int size));
+extern int getlistsize PROTO((object *));
+extern object *getlistitem PROTO((object *, int));
+extern int setlistitem PROTO((object *, int, object *));
+extern int inslistitem PROTO((object *, int, object *));
+extern int addlistitem PROTO((object *, object *));
+extern int sortlist PROTO((object *));
+
+/* Macro, trading safety for speed */
+#define GETLISTITEM(op, i) ((op)->ob_item[i])
diff --git a/src/macmodule.c b/src/macmodule.c
new file mode 100644
index 0000000..4f20914
--- /dev/null
+++ b/src/macmodule.c
@@ -0,0 +1,246 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Macintosh OS module implementation */
+
+#include "allobjects.h"
+
+#include "import.h"
+#include "modsupport.h"
+
+#include "sigtype.h"
+
+#include "::unixemu:dir.h"
+#include "::unixemu:stat.h"
+
+static object *MacError; /* Exception */
+
+
+static object *
+mac_chdir(self, args)
+ object *self;
+ object *args;
+{
+ object *path;
+ if (!getstrarg(args, &path))
+ return NULL;
+ if (chdir(getstringvalue(path)) != 0)
+ return err_errno(MacError);
+ INCREF(None);
+ return None;
+}
+
+
+static object *
+mac_getcwd(self, args)
+ object *self;
+ object *args;
+{
+ extern char *getwd();
+ char buf[1025];
+ if (!getnoarg(args))
+ return NULL;
+ strcpy(buf, "mac.getcwd() failed"); /* In case getwd() doesn't set a msg */
+ if (getwd(buf) == NULL) {
+ err_setstr(MacError, buf);
+ return NULL;
+ }
+ return newstringobject(buf);
+}
+
+
+static object *
+mac_listdir(self, args)
+ object *self;
+ object *args;
+{
+ object *name, *d, *v;
+ DIR *dirp;
+ struct direct *ep;
+ if (!getstrarg(args, &name))
+ return NULL;
+ if ((dirp = opendir(getstringvalue(name))) == NULL)
+ return err_errno(MacError);
+ if ((d = newlistobject(0)) == NULL) {
+ closedir(dirp);
+ return NULL;
+ }
+ while ((ep = readdir(dirp)) != NULL) {
+ v = newstringobject(ep->d_name);
+ if (v == NULL) {
+ DECREF(d);
+ d = NULL;
+ break;
+ }
+ if (addlistitem(d, v) != 0) {
+ DECREF(v);
+ DECREF(d);
+ d = NULL;
+ break;
+ }
+ DECREF(v);
+ }
+ closedir(dirp);
+ return d;
+}
+
+
+static object *
+mac_mkdir(self, args)
+ object *self;
+ object *args;
+{
+ object *path;
+ int mode;
+ if (!getstrintarg(args, &path, &mode))
+ return NULL;
+ if (mkdir(getstringvalue(path), mode) != 0)
+ return err_errno(MacError);
+ INCREF(None);
+ return None;
+}
+
+
+static object *
+mac_rename(self, args)
+ object *self;
+ object *args;
+{
+ object *src, *dst;
+ if (!getstrstrarg(args, &src, &dst))
+ return NULL;
+ if (rename(getstringvalue(src), getstringvalue(dst)) != 0)
+ return err_errno(MacError);
+ INCREF(None);
+ return None;
+}
+
+
+static object *
+mac_rmdir(self, args)
+ object *self;
+ object *args;
+{
+ object *path;
+ if (!getstrarg(args, &path))
+ return NULL;
+ if (rmdir(getstringvalue(path)) != 0)
+ return err_errno(MacError);
+ INCREF(None);
+ return None;
+}
+
+
+static object *
+mac_stat(self, args)
+ object *self;
+ object *args;
+{
+ struct stat st;
+ object *path;
+ object *v;
+ if (!getstrarg(args, &path))
+ return NULL;
+ if (stat(getstringvalue(path), &st) != 0)
+ return err_errno(MacError);
+ v = newtupleobject(11);
+ if (v == NULL)
+ return NULL;
+#define SET(i, val) settupleitem(v, i, newintobject((long)(val)))
+#define XXX(i, val) SET(i, 0) /* For values my Mac stat doesn't support */
+ SET(0, st.st_mode);
+ XXX(1, st.st_ino);
+ XXX(2, st.st_dev);
+ XXX(3, st.st_nlink);
+ XXX(4, st.st_uid);
+ XXX(5, st.st_gid);
+ SET(6, st.st_size);
+ XXX(7, st.st_atime);
+ SET(8, st.st_mtime);
+ XXX(9, st.st_ctime);
+ SET(10, st.st_rsize); /* Mac-specific: resource size */
+#undef SET
+ if (err_occurred()) {
+ DECREF(v);
+ return NULL;
+ }
+ return v;
+}
+
+
+static object *
+mac_sync(self, args)
+ object *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ sync();
+ INCREF(None);
+ return None;
+}
+
+
+static object *
+mac_unlink(self, args)
+ object *self;
+ object *args;
+{
+ object *path;
+ if (!getstrarg(args, &path))
+ return NULL;
+ if (unlink(getstringvalue(path)) != 0)
+ return err_errno(MacError);
+ INCREF(None);
+ return None;
+}
+
+
+static struct methodlist mac_methods[] = {
+ {"chdir", mac_chdir},
+ {"getcwd", mac_getcwd},
+ {"listdir", mac_listdir},
+ {"mkdir", mac_mkdir},
+ {"rename", mac_rename},
+ {"rmdir", mac_rmdir},
+ {"stat", mac_stat},
+ {"sync", mac_sync},
+ {"unlink", mac_unlink},
+ {NULL, NULL} /* Sentinel */
+};
+
+
+void
+initmac()
+{
+ object *m, *d;
+
+ m = initmodule("mac", mac_methods);
+ d = getmoduledict(m);
+
+ /* Initialize mac.error exception */
+ MacError = newstringobject("mac.error");
+ if (MacError == NULL || dictinsert(d, "error", MacError) != 0)
+ fatal("can't define mac.error");
+}
diff --git a/src/malloc.h b/src/malloc.h
new file mode 100644
index 0000000..c2d9969
--- /dev/null
+++ b/src/malloc.h
@@ -0,0 +1,63 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Lowest-level memory allocation interface */
+
+#ifdef THINK_C
+#define ANY void
+#ifndef THINK_C_3_0
+#define HAVE_STDLIB
+#endif
+#endif
+
+#ifdef __STD_C__
+#define ANY void
+#define HAVE_STDLIB
+#endif
+
+#ifndef ANY
+#define ANY char
+#endif
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+#define NEW(type, n) ( (type *) malloc((n) * sizeof(type)) )
+#define RESIZE(p, type, n) \
+ if ((p) == NULL) \
+ (p) = (type *) malloc((n) * sizeof(type)); \
+ else \
+ (p) = (type *) realloc((char *)(p), (n) * sizeof(type))
+#define DEL(p) free((char *)p)
+#define XDEL(p) if ((p) == NULL) ; else DEL(p)
+
+#ifdef HAVE_STDLIB
+#include <stdlib.h>
+#else
+extern ANY *malloc PROTO((unsigned int));
+extern ANY *calloc PROTO((unsigned int, unsigned int));
+extern ANY *realloc PROTO((ANY *, unsigned int));
+extern void free PROTO((ANY *)); /* XXX sometimes int on Unix old systems */
+#endif
diff --git a/src/mathmodule.c b/src/mathmodule.c
new file mode 100644
index 0000000..3fa8d03
--- /dev/null
+++ b/src/mathmodule.c
@@ -0,0 +1,180 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Math module -- standard C math library functions, pi and e */
+
+#include "allobjects.h"
+
+#include <errno.h>
+#ifndef errno
+extern int errno;
+#endif
+
+#include "modsupport.h"
+
+#include <math.h>
+
+static int
+getdoublearg(args, px)
+ register object *args;
+ double *px;
+{
+ if (args == NULL)
+ return err_badarg();
+ if (is_floatobject(args)) {
+ *px = getfloatvalue(args);
+ return 1;
+ }
+ if (is_intobject(args)) {
+ *px = getintvalue(args);
+ return 1;
+ }
+ return err_badarg();
+}
+
+static int
+get2doublearg(args, px, py)
+ register object *args;
+ double *px, *py;
+{
+ if (args == NULL || !is_tupleobject(args) || gettuplesize(args) != 2)
+ return err_badarg();
+ return getdoublearg(gettupleitem(args, 0), px) &&
+ getdoublearg(gettupleitem(args, 1), py);
+}
+
+static object *
+math_1(args, func)
+ object *args;
+ double (*func) FPROTO((double));
+{
+ double x;
+ if (!getdoublearg(args, &x))
+ return NULL;
+ errno = 0;
+ x = (*func)(x);
+ if (errno != 0)
+ return NULL;
+ else
+ return newfloatobject(x);
+}
+
+static object *
+math_2(args, func)
+ object *args;
+ double (*func) FPROTO((double, double));
+{
+ double x, y;
+ if (!get2doublearg(args, &x, &y))
+ return NULL;
+ errno = 0;
+ x = (*func)(x, y);
+ if (errno != 0)
+ return NULL;
+ else
+ return newfloatobject(x);
+}
+
+#define FUNC1(stubname, func) \
+ static object * stubname(self, args) object *self, *args; { \
+ return math_1(args, func); \
+ }
+
+#define FUNC2(stubname, func) \
+ static object * stubname(self, args) object *self, *args; { \
+ return math_2(args, func); \
+ }
+
+FUNC1(math_acos, acos)
+FUNC1(math_asin, asin)
+FUNC1(math_atan, atan)
+FUNC2(math_atan2, atan2)
+FUNC1(math_ceil, ceil)
+FUNC1(math_cos, cos)
+FUNC1(math_cosh, cosh)
+FUNC1(math_exp, exp)
+FUNC1(math_fabs, fabs)
+FUNC1(math_floor, floor)
+#if 0
+/* XXX This one is not in the Amoeba library yet, so what the heck... */
+FUNC2(math_fmod, fmod)
+#endif
+FUNC1(math_log, log)
+FUNC1(math_log10, log10)
+FUNC2(math_pow, pow)
+FUNC1(math_sin, sin)
+FUNC1(math_sinh, sinh)
+FUNC1(math_sqrt, sqrt)
+FUNC1(math_tan, tan)
+FUNC1(math_tanh, tanh)
+
+#if 0
+/* What about these? */
+double frexp(double x, int *i);
+double ldexp(double x, int n);
+double modf(double x, double *i);
+#endif
+
+static struct methodlist math_methods[] = {
+ {"acos", math_acos},
+ {"asin", math_asin},
+ {"atan", math_atan},
+ {"atan2", math_atan2},
+ {"ceil", math_ceil},
+ {"cos", math_cos},
+ {"cosh", math_cosh},
+ {"exp", math_exp},
+ {"fabs", math_fabs},
+ {"floor", math_floor},
+#if 0
+ {"fmod", math_fmod},
+ {"frexp", math_freqp},
+ {"ldexp", math_ldexp},
+#endif
+ {"log", math_log},
+ {"log10", math_log10},
+#if 0
+ {"modf", math_modf},
+#endif
+ {"pow", math_pow},
+ {"sin", math_sin},
+ {"sinh", math_sinh},
+ {"sqrt", math_sqrt},
+ {"tan", math_tan},
+ {"tanh", math_tanh},
+ {NULL, NULL} /* sentinel */
+};
+
+void
+initmath()
+{
+ object *m, *d, *v;
+
+ m = initmodule("math", math_methods);
+ d = getmoduledict(m);
+ dictinsert(d, "pi", v = newfloatobject(atan(1.0) * 4.0));
+ DECREF(v);
+ dictinsert(d, "e", v = newfloatobject(exp(1.0)));
+ DECREF(v);
+}
diff --git a/src/metagrammar.c b/src/metagrammar.c
new file mode 100644
index 0000000..57d47cb
--- /dev/null
+++ b/src/metagrammar.c
@@ -0,0 +1,176 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+#include "pgenheaders.h"
+#include "metagrammar.h"
+#include "grammar.h"
+#include "pgen.h"
+static arc arcs_0_0[3] = {
+ {2, 0},
+ {3, 0},
+ {4, 1},
+};
+static arc arcs_0_1[1] = {
+ {0, 1},
+};
+static state states_0[2] = {
+ {3, arcs_0_0},
+ {1, arcs_0_1},
+};
+static arc arcs_1_0[1] = {
+ {5, 1},
+};
+static arc arcs_1_1[1] = {
+ {6, 2},
+};
+static arc arcs_1_2[1] = {
+ {7, 3},
+};
+static arc arcs_1_3[1] = {
+ {3, 4},
+};
+static arc arcs_1_4[1] = {
+ {0, 4},
+};
+static state states_1[5] = {
+ {1, arcs_1_0},
+ {1, arcs_1_1},
+ {1, arcs_1_2},
+ {1, arcs_1_3},
+ {1, arcs_1_4},
+};
+static arc arcs_2_0[1] = {
+ {8, 1},
+};
+static arc arcs_2_1[2] = {
+ {9, 0},
+ {0, 1},
+};
+static state states_2[2] = {
+ {1, arcs_2_0},
+ {2, arcs_2_1},
+};
+static arc arcs_3_0[1] = {
+ {10, 1},
+};
+static arc arcs_3_1[2] = {
+ {10, 1},
+ {0, 1},
+};
+static state states_3[2] = {
+ {1, arcs_3_0},
+ {2, arcs_3_1},
+};
+static arc arcs_4_0[2] = {
+ {11, 1},
+ {13, 2},
+};
+static arc arcs_4_1[1] = {
+ {7, 3},
+};
+static arc arcs_4_2[3] = {
+ {14, 4},
+ {15, 4},
+ {0, 2},
+};
+static arc arcs_4_3[1] = {
+ {12, 4},
+};
+static arc arcs_4_4[1] = {
+ {0, 4},
+};
+static state states_4[5] = {
+ {2, arcs_4_0},
+ {1, arcs_4_1},
+ {3, arcs_4_2},
+ {1, arcs_4_3},
+ {1, arcs_4_4},
+};
+static arc arcs_5_0[3] = {
+ {5, 1},
+ {16, 1},
+ {17, 2},
+};
+static arc arcs_5_1[1] = {
+ {0, 1},
+};
+static arc arcs_5_2[1] = {
+ {7, 3},
+};
+static arc arcs_5_3[1] = {
+ {18, 1},
+};
+static state states_5[4] = {
+ {3, arcs_5_0},
+ {1, arcs_5_1},
+ {1, arcs_5_2},
+ {1, arcs_5_3},
+};
+static dfa dfas[6] = {
+ {256, "MSTART", 0, 2, states_0,
+ "\070\000\000"},
+ {257, "RULE", 0, 5, states_1,
+ "\040\000\000"},
+ {258, "RHS", 0, 2, states_2,
+ "\040\010\003"},
+ {259, "ALT", 0, 2, states_3,
+ "\040\010\003"},
+ {260, "ITEM", 0, 5, states_4,
+ "\040\010\003"},
+ {261, "ATOM", 0, 4, states_5,
+ "\040\000\003"},
+};
+static label labels[19] = {
+ {0, "EMPTY"},
+ {256, 0},
+ {257, 0},
+ {4, 0},
+ {0, 0},
+ {1, 0},
+ {11, 0},
+ {258, 0},
+ {259, 0},
+ {18, 0},
+ {260, 0},
+ {9, 0},
+ {10, 0},
+ {261, 0},
+ {16, 0},
+ {14, 0},
+ {3, 0},
+ {7, 0},
+ {8, 0},
+};
+static grammar gram = {
+ 6,
+ dfas,
+ {19, labels},
+ 256
+};
+
+grammar *
+meta_grammar()
+{
+ return &gram;
+}
diff --git a/src/metagrammar.h b/src/metagrammar.h
new file mode 100644
index 0000000..a937b64
--- /dev/null
+++ b/src/metagrammar.h
@@ -0,0 +1,30 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+#define MSTART 256
+#define RULE 257
+#define RHS 258
+#define ALT 259
+#define ITEM 260
+#define ATOM 261
diff --git a/src/methodobject.c b/src/methodobject.c
new file mode 100644
index 0000000..68a0217
--- /dev/null
+++ b/src/methodobject.c
@@ -0,0 +1,147 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Method object implementation */
+
+#include "allobjects.h"
+
+#include "token.h"
+
+typedef struct {
+ OB_HEAD
+ char *m_name;
+ method m_meth;
+ object *m_self;
+} methodobject;
+
+object *
+newmethodobject(name, meth, self)
+ char *name; /* static string */
+ method meth;
+ object *self;
+{
+ methodobject *op = NEWOBJ(methodobject, &Methodtype);
+ if (op != NULL) {
+ op->m_name = name;
+ op->m_meth = meth;
+ if (self != NULL)
+ INCREF(self);
+ op->m_self = self;
+ }
+ return (object *)op;
+}
+
+method
+getmethod(op)
+ object *op;
+{
+ if (!is_methodobject(op)) {
+ err_badcall();
+ return NULL;
+ }
+ return ((methodobject *)op) -> m_meth;
+}
+
+object *
+getself(op)
+ object *op;
+{
+ if (!is_methodobject(op)) {
+ err_badcall();
+ return NULL;
+ }
+ return ((methodobject *)op) -> m_self;
+}
+
+/* Methods (the standard built-in methods, that is) */
+
+static void
+meth_dealloc(m)
+ methodobject *m;
+{
+ if (m->m_self != NULL)
+ DECREF(m->m_self);
+ free((char *)m);
+}
+
+static void
+meth_print(m, fp, flags)
+ methodobject *m;
+ FILE *fp;
+ int flags;
+{
+ if (m->m_self == NULL)
+ fprintf(fp, "<built-in function '%s'>", m->m_name);
+ else
+ fprintf(fp, "<built-in method '%s' of some %s object>",
+ m->m_name, m->m_self->ob_type->tp_name);
+}
+
+static object *
+meth_repr(m)
+ methodobject *m;
+{
+ char buf[200];
+ if (m->m_self == NULL)
+ sprintf(buf, "<built-in function '%.80s'>", m->m_name);
+ else
+ sprintf(buf,
+ "<built-in method '%.80s' of some %.80s object>",
+ m->m_name, m->m_self->ob_type->tp_name);
+ return newstringobject(buf);
+}
+
+typeobject Methodtype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "method",
+ sizeof(methodobject),
+ 0,
+ meth_dealloc, /*tp_dealloc*/
+ meth_print, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ meth_repr, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
+
+/* Find a method in a module's method table.
+ Usually called from an object's getattr method. */
+
+object *
+findmethod(ml, op, name)
+ struct methodlist *ml;
+ object *op;
+ char *name;
+{
+ for (; ml->ml_name != NULL; ml++) {
+ if (strcmp(name, ml->ml_name) == 0)
+ return newmethodobject(ml->ml_name, ml->ml_meth, op);
+ }
+ err_setstr(NameError, name);
+ return NULL;
+}
diff --git a/src/methodobject.h b/src/methodobject.h
new file mode 100644
index 0000000..674ed7d
--- /dev/null
+++ b/src/methodobject.h
@@ -0,0 +1,42 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Method object interface */
+
+extern typeobject Methodtype;
+
+#define is_methodobject(op) ((op)->ob_type == &Methodtype)
+
+typedef object *(*method) FPROTO((object *, object *));
+
+extern object *newmethodobject PROTO((char *, method, object *));
+extern method getmethod PROTO((object *));
+extern object *getself PROTO((object *));
+
+struct methodlist {
+ char *ml_name;
+ method ml_meth;
+};
+
+extern object *findmethod PROTO((struct methodlist *, object *, char *));
diff --git a/src/modsupport.c b/src/modsupport.c
new file mode 100644
index 0000000..1044268
--- /dev/null
+++ b/src/modsupport.c
@@ -0,0 +1,381 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Module support implementation */
+
+#include "allobjects.h"
+#include "modsupport.h"
+#include "import.h"
+
+
+object *
+initmodule(name, methods)
+ char *name;
+ struct methodlist *methods;
+{
+ object *m, *d, *v;
+ struct methodlist *ml;
+ char namebuf[256];
+ if ((m = add_module(name)) == NULL) {
+ fprintf(stderr, "initializing module: %s\n", name);
+ fatal("can't create a module");
+ }
+ d = getmoduledict(m);
+ for (ml = methods; ml->ml_name != NULL; ml++) {
+ sprintf(namebuf, "%s.%s", name, ml->ml_name);
+ v = newmethodobject(strdup(namebuf), ml->ml_meth,
+ (object *)NULL);
+ /* XXX The strdup'ed memory is never freed */
+ if (v == NULL || dictinsert(d, ml->ml_name, v) != 0) {
+ fprintf(stderr, "initializing module: %s\n", name);
+ fatal("can't initialize module");
+ }
+ DECREF(v);
+ }
+ return m;
+}
+
+
+/* Argument list handling tools.
+ All return 1 for success, or call err_set*() and return 0 for failure */
+
+int
+getnoarg(v)
+ object *v;
+{
+ if (v != NULL) {
+ return err_badarg();
+ }
+ return 1;
+}
+
+int
+getintarg(v, a)
+ object *v;
+ int *a;
+{
+ if (v == NULL || !is_intobject(v)) {
+ return err_badarg();
+ }
+ *a = getintvalue(v);
+ return 1;
+}
+
+int
+getintintarg(v, a, b)
+ object *v;
+ int *a;
+ int *b;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getintarg(gettupleitem(v, 0), a) &&
+ getintarg(gettupleitem(v, 1), b);
+}
+
+int
+getlongarg(v, a)
+ object *v;
+ long *a;
+{
+ if (v == NULL || !is_intobject(v)) {
+ return err_badarg();
+ }
+ *a = getintvalue(v);
+ return 1;
+}
+
+int
+getlonglongargs(v, a, b)
+ object *v;
+ long *a, *b;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getlongarg(gettupleitem(v, 0), a) &&
+ getlongarg(gettupleitem(v, 1), b);
+}
+
+int
+getlonglongobjectargs(v, a, b, c)
+ object *v;
+ long *a, *b;
+ object **c;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
+ return err_badarg();
+ }
+ if (getlongarg(gettupleitem(v, 0), a) &&
+ getlongarg(gettupleitem(v, 1), b)) {
+ *c = gettupleitem(v, 2);
+ return 1;
+ }
+ else {
+ return err_badarg();
+ }
+}
+
+int
+getstrarg(v, a)
+ object *v;
+ object **a;
+{
+ if (v == NULL || !is_stringobject(v)) {
+ return err_badarg();
+ }
+ *a = v;
+ return 1;
+}
+
+int
+getstrstrarg(v, a, b)
+ object *v;
+ object **a;
+ object **b;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getstrarg(gettupleitem(v, 0), a) &&
+ getstrarg(gettupleitem(v, 1), b);
+}
+
+int
+getstrstrintarg(v, a, b, c)
+ object *v;
+ object **a;
+ object **b;
+ int *c;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
+ return err_badarg();
+ }
+ return getstrarg(gettupleitem(v, 0), a) &&
+ getstrarg(gettupleitem(v, 1), b) &&
+ getintarg(gettupleitem(v, 2), c);
+}
+
+int
+getstrintarg(v, a, b)
+ object *v;
+ object **a;
+ int *b;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getstrarg(gettupleitem(v, 0), a) &&
+ getintarg(gettupleitem(v, 1), b);
+}
+
+int
+getintstrarg(v, a, b)
+ object *v;
+ int *a;
+ object **b;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getintarg(gettupleitem(v, 0), a) &&
+ getstrarg(gettupleitem(v, 1), b);
+}
+
+int
+getpointarg(v, a)
+ object *v;
+ int *a; /* [2] */
+{
+ return getintintarg(v, a, a+1);
+}
+
+int
+get3pointarg(v, a)
+ object *v;
+ int *a; /* [6] */
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
+ return err_badarg();
+ }
+ return getpointarg(gettupleitem(v, 0), a) &&
+ getpointarg(gettupleitem(v, 1), a+2) &&
+ getpointarg(gettupleitem(v, 2), a+4);
+}
+
+int
+getrectarg(v, a)
+ object *v;
+ int *a; /* [2+2] */
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getpointarg(gettupleitem(v, 0), a) &&
+ getpointarg(gettupleitem(v, 1), a+2);
+}
+
+int
+getrectintarg(v, a)
+ object *v;
+ int *a; /* [4+1] */
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getrectarg(gettupleitem(v, 0), a) &&
+ getintarg(gettupleitem(v, 1), a+4);
+}
+
+int
+getpointintarg(v, a)
+ object *v;
+ int *a; /* [2+1] */
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getpointarg(gettupleitem(v, 0), a) &&
+ getintarg(gettupleitem(v, 1), a+2);
+}
+
+int
+getpointstrarg(v, a, b)
+ object *v;
+ int *a; /* [2] */
+ object **b;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getpointarg(gettupleitem(v, 0), a) &&
+ getstrarg(gettupleitem(v, 1), b);
+}
+
+int
+getstrintintarg(v, a, b, c)
+ object *v;
+ object *a;
+ int *b, *c;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
+ return err_badarg();
+ }
+ return getstrarg(gettupleitem(v, 0), a) &&
+ getintarg(gettupleitem(v, 1), b) &&
+ getintarg(gettupleitem(v, 2), c);
+}
+
+int
+getrectpointarg(v, a)
+ object *v;
+ int *a; /* [4+2] */
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
+ return err_badarg();
+ }
+ return getrectarg(gettupleitem(v, 0), a) &&
+ getpointarg(gettupleitem(v, 1), a+4);
+}
+
+int
+getlongtuplearg(args, a, n)
+ object *args;
+ long *a; /* [n] */
+ int n;
+{
+ int i;
+ if (!is_tupleobject(args) || gettuplesize(args) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ object *v = gettupleitem(args, i);
+ if (!is_intobject(v)) {
+ return err_badarg();
+ }
+ a[i] = getintvalue(v);
+ }
+ return 1;
+}
+
+int
+getshorttuplearg(args, a, n)
+ object *args;
+ short *a; /* [n] */
+ int n;
+{
+ int i;
+ if (!is_tupleobject(args) || gettuplesize(args) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ object *v = gettupleitem(args, i);
+ if (!is_intobject(v)) {
+ return err_badarg();
+ }
+ a[i] = getintvalue(v);
+ }
+ return 1;
+}
+
+int
+getlonglistarg(args, a, n)
+ object *args;
+ long *a; /* [n] */
+ int n;
+{
+ int i;
+ if (!is_listobject(args) || getlistsize(args) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ object *v = getlistitem(args, i);
+ if (!is_intobject(v)) {
+ return err_badarg();
+ }
+ a[i] = getintvalue(v);
+ }
+ return 1;
+}
+
+int
+getshortlistarg(args, a, n)
+ object *args;
+ short *a; /* [n] */
+ int n;
+{
+ int i;
+ if (!is_listobject(args) || getlistsize(args) != n) {
+ return err_badarg();
+ }
+ for (i = 0; i < n; i++) {
+ object *v = getlistitem(args, i);
+ if (!is_intobject(v)) {
+ return err_badarg();
+ }
+ a[i] = getintvalue(v);
+ }
+ return 1;
+}
diff --git a/src/modsupport.h b/src/modsupport.h
new file mode 100644
index 0000000..843b209
--- /dev/null
+++ b/src/modsupport.h
@@ -0,0 +1,27 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Module support interface */
+
+extern object *initmodule PROTO((char *, struct methodlist *));
diff --git a/src/moduleobject.c b/src/moduleobject.c
new file mode 100644
index 0000000..82599f9
--- /dev/null
+++ b/src/moduleobject.c
@@ -0,0 +1,154 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Module object implementation */
+
+#include "allobjects.h"
+
+typedef struct {
+ OB_HEAD
+ object *md_name;
+ object *md_dict;
+} moduleobject;
+
+object *
+newmoduleobject(name)
+ char *name;
+{
+ moduleobject *m = NEWOBJ(moduleobject, &Moduletype);
+ if (m == NULL)
+ return NULL;
+ m->md_name = newstringobject(name);
+ m->md_dict = newdictobject();
+ if (m->md_name == NULL || m->md_dict == NULL) {
+ DECREF(m);
+ return NULL;
+ }
+ return (object *)m;
+}
+
+object *
+getmoduledict(m)
+ object *m;
+{
+ if (!is_moduleobject(m)) {
+ err_badcall();
+ return NULL;
+ }
+ return ((moduleobject *)m) -> md_dict;
+}
+
+char *
+getmodulename(m)
+ object *m;
+{
+ if (!is_moduleobject(m)) {
+ err_badarg();
+ return NULL;
+ }
+ return getstringvalue(((moduleobject *)m) -> md_name);
+}
+
+/* Methods */
+
+static void
+module_dealloc(m)
+ moduleobject *m;
+{
+ if (m->md_name != NULL)
+ DECREF(m->md_name);
+ if (m->md_dict != NULL)
+ DECREF(m->md_dict);
+ free((char *)m);
+}
+
+static void
+module_print(m, fp, flags)
+ moduleobject *m;
+ FILE *fp;
+ int flags;
+{
+ fprintf(fp, "<module '%s'>", getstringvalue(m->md_name));
+}
+
+static object *
+module_repr(m)
+ moduleobject *m;
+{
+ char buf[100];
+ sprintf(buf, "<module '%.80s'>", getstringvalue(m->md_name));
+ return newstringobject(buf);
+}
+
+static object *
+module_getattr(m, name)
+ moduleobject *m;
+ char *name;
+{
+ object *res;
+ if (strcmp(name, "__dict__") == 0) {
+ INCREF(m->md_dict);
+ return m->md_dict;
+ }
+ if (strcmp(name, "__name__") == 0) {
+ INCREF(m->md_name);
+ return m->md_name;
+ }
+ res = dictlookup(m->md_dict, name);
+ if (res == NULL)
+ err_setstr(NameError, name);
+ else
+ INCREF(res);
+ return res;
+}
+
+static int
+module_setattr(m, name, v)
+ moduleobject *m;
+ char *name;
+ object *v;
+{
+ if (strcmp(name, "__dict__") == 0 || strcmp(name, "__name__") == 0) {
+ err_setstr(NameError, "can't assign to reserved member name");
+ return -1;
+ }
+ if (v == NULL)
+ return dictremove(m->md_dict, name);
+ else
+ return dictinsert(m->md_dict, name, v);
+}
+
+typeobject Moduletype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /*ob_size*/
+ "module", /*tp_name*/
+ sizeof(moduleobject), /*tp_size*/
+ 0, /*tp_itemsize*/
+ module_dealloc, /*tp_dealloc*/
+ module_print, /*tp_print*/
+ module_getattr, /*tp_getattr*/
+ module_setattr, /*tp_setattr*/
+ 0, /*tp_compare*/
+ module_repr, /*tp_repr*/
+};
diff --git a/src/moduleobject.h b/src/moduleobject.h
new file mode 100644
index 0000000..4657c22
--- /dev/null
+++ b/src/moduleobject.h
@@ -0,0 +1,33 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Module object interface */
+
+extern typeobject Moduletype;
+
+#define is_moduleobject(op) ((op)->ob_type == &Moduletype)
+
+extern object *newmoduleobject PROTO((char *));
+extern object *getmoduledict PROTO((object *));
+extern char *getmodulename PROTO((object *));
diff --git a/src/node.c b/src/node.c
new file mode 100644
index 0000000..2b76ae8
--- /dev/null
+++ b/src/node.c
@@ -0,0 +1,100 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Parse tree node implementation */
+
+#include "pgenheaders.h"
+#include "node.h"
+
+node *
+newtree(type)
+ int type;
+{
+ node *n = NEW(node, 1);
+ if (n == NULL)
+ return NULL;
+ n->n_type = type;
+ n->n_str = NULL;
+ n->n_lineno = 0;
+ n->n_nchildren = 0;
+ n->n_child = NULL;
+ return n;
+}
+
+#define XXX 3 /* Node alignment factor to speed up realloc */
+#define XXXROUNDUP(n) ((n) == 1 ? 1 : ((n) + XXX - 1) / XXX * XXX)
+
+node *
+addchild(n1, type, str, lineno)
+ register node *n1;
+ int type;
+ char *str;
+ int lineno;
+{
+ register int nch = n1->n_nchildren;
+ register int nch1 = nch+1;
+ register node *n;
+ if (XXXROUNDUP(nch) < nch1) {
+ n = n1->n_child;
+ nch1 = XXXROUNDUP(nch1);
+ RESIZE(n, node, nch1);
+ if (n == NULL)
+ return NULL;
+ n1->n_child = n;
+ }
+ n = &n1->n_child[n1->n_nchildren++];
+ n->n_type = type;
+ n->n_str = str;
+ n->n_lineno = lineno;
+ n->n_nchildren = 0;
+ n->n_child = NULL;
+ return n;
+}
+
+/* Forward */
+static void freechildren PROTO((node *));
+
+
+void
+freetree(n)
+ node *n;
+{
+ if (n != NULL) {
+ freechildren(n);
+ DEL(n);
+ }
+}
+
+static void
+freechildren(n)
+ node *n;
+{
+ int i;
+ for (i = NCH(n); --i >= 0; )
+ freechildren(CHILD(n, i));
+ if (n->n_child != NULL)
+ DEL(n->n_child);
+ if (STR(n) != NULL)
+ DEL(STR(n));
+}
diff --git a/src/node.h b/src/node.h
new file mode 100644
index 0000000..5b43f8f
--- /dev/null
+++ b/src/node.h
@@ -0,0 +1,58 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Parse tree node interface */
+
+typedef struct _node {
+ int n_type;
+ char *n_str;
+ int n_lineno;
+ int n_nchildren;
+ struct _node *n_child;
+} node;
+
+extern node *newtree PROTO((int type));
+extern node *addchild PROTO((node *n, int type, char *str, int lineno));
+extern void freetree PROTO((node *n));
+
+/* Node access functions */
+#define NCH(n) ((n)->n_nchildren)
+#define CHILD(n, i) (&(n)->n_child[i])
+#define TYPE(n) ((n)->n_type)
+#define STR(n) ((n)->n_str)
+
+/* Assert that the type of a node is what we expect */
+#ifndef DEBUG
+#define REQ(n, type) { /*pass*/ ; }
+#else
+#define REQ(n, type) \
+ { if (TYPE(n) != (type)) { \
+ fprintf(stderr, "FATAL: node type %d, required %d\n", \
+ TYPE(n), type); \
+ abort(); \
+ } }
+#endif
+
+extern void listtree PROTO((node *));
+extern void listnode PROTO((FILE *, node *));
diff --git a/src/object.c b/src/object.c
new file mode 100644
index 0000000..37e2b26
--- /dev/null
+++ b/src/object.c
@@ -0,0 +1,290 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Generic object operations; and implementation of None (NoObject) */
+
+#include "allobjects.h"
+
+#ifdef REF_DEBUG
+long ref_total;
+#endif
+
+/* Object allocation routines used by NEWOBJ and NEWVAROBJ macros.
+ These are used by the individual routines for object creation.
+ Do not call them otherwise, they do not initialize the object! */
+
+object *
+newobject(tp)
+ typeobject *tp;
+{
+ object *op = (object *) malloc(tp->tp_basicsize);
+ if (op == NULL)
+ return err_nomem();
+ NEWREF(op);
+ op->ob_type = tp;
+ return op;
+}
+
+#if 0 /* unused */
+
+varobject *
+newvarobject(tp, size)
+ typeobject *tp;
+ unsigned int size;
+{
+ varobject *op = (varobject *)
+ malloc(tp->tp_basicsize + size * tp->tp_itemsize);
+ if (op == NULL)
+ return err_nomem();
+ NEWREF(op);
+ op->ob_type = tp;
+ op->ob_size = size;
+ return op;
+}
+
+#endif
+
+int StopPrint; /* Flag to indicate printing must be stopped */
+
+static int prlevel;
+
+void
+printobject(op, fp, flags)
+ object *op;
+ FILE *fp;
+ int flags;
+{
+ /* Hacks to make printing a long or recursive object interruptible */
+ /* XXX Interrupts should leave a more permanent error */
+ prlevel++;
+ if (!StopPrint && intrcheck()) {
+ fprintf(fp, "\n[print interrupted]\n");
+ StopPrint = 1;
+ }
+ if (!StopPrint) {
+ if (op == NULL) {
+ fprintf(fp, "<nil>");
+ }
+ else {
+ if (op->ob_refcnt <= 0)
+ fprintf(fp, "(refcnt %d):", op->ob_refcnt);
+ if (op->ob_type->tp_print == NULL) {
+ fprintf(fp, "<%s object at %lx>",
+ op->ob_type->tp_name, (long)op);
+ }
+ else {
+ (*op->ob_type->tp_print)(op, fp, flags);
+ }
+ }
+ }
+ prlevel--;
+ if (prlevel == 0)
+ StopPrint = 0;
+}
+
+object *
+reprobject(v)
+ object *v;
+{
+ object *w = NULL;
+ /* Hacks to make converting a long or recursive object interruptible */
+ prlevel++;
+ if (!StopPrint && intrcheck()) {
+ StopPrint = 1;
+ err_set(KeyboardInterrupt);
+ }
+ if (!StopPrint) {
+ if (v == NULL) {
+ w = newstringobject("<NULL>");
+ }
+ else if (v->ob_type->tp_repr == NULL) {
+ char buf[100];
+ sprintf(buf, "<%.80s object at %lx>",
+ v->ob_type->tp_name, (long)v);
+ w = newstringobject(buf);
+ }
+ else {
+ w = (*v->ob_type->tp_repr)(v);
+ }
+ if (StopPrint) {
+ XDECREF(w);
+ w = NULL;
+ }
+ }
+ prlevel--;
+ if (prlevel == 0)
+ StopPrint = 0;
+ return w;
+}
+
+int
+cmpobject(v, w)
+ object *v, *w;
+{
+ typeobject *tp;
+ if (v == w)
+ return 0;
+ if (v == NULL)
+ return -1;
+ if (w == NULL)
+ return 1;
+ if ((tp = v->ob_type) != w->ob_type)
+ return strcmp(tp->tp_name, w->ob_type->tp_name);
+ if (tp->tp_compare == NULL)
+ return (v < w) ? -1 : 1;
+ return ((*tp->tp_compare)(v, w));
+}
+
+object *
+getattr(v, name)
+ object *v;
+ char *name;
+{
+ if (v->ob_type->tp_getattr == NULL) {
+ err_setstr(TypeError, "attribute-less object");
+ return NULL;
+ }
+ else {
+ return (*v->ob_type->tp_getattr)(v, name);
+ }
+}
+
+int
+setattr(v, name, w)
+ object *v;
+ char *name;
+ object *w;
+{
+ if (v->ob_type->tp_setattr == NULL) {
+ if (v->ob_type->tp_getattr == NULL)
+ err_setstr(TypeError, "attribute-less object");
+ else
+ err_setstr(TypeError, "object has read-only attributes");
+ return -1;
+ }
+ else {
+ return (*v->ob_type->tp_setattr)(v, name, w);
+ }
+}
+
+
+/*
+NoObject is usable as a non-NULL undefined value, used by the macro None.
+There is (and should be!) no way to create other objects of this type,
+so there is exactly one (which is indestructible, by the way).
+*/
+
+static void
+none_print(op, fp, flags)
+ object *op;
+ FILE *fp;
+ int flags;
+{
+ fprintf(fp, "None");
+}
+
+static object *
+none_repr(op)
+ object *op;
+{
+ return newstringobject("None");
+}
+
+static typeobject Notype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "None",
+ 0,
+ 0,
+ 0, /*tp_dealloc*/ /*never called*/
+ none_print, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ none_repr, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
+
+object NoObject = {
+ OB_HEAD_INIT(&Notype)
+};
+
+
+#ifdef TRACE_REFS
+
+static object refchain = {&refchain, &refchain};
+
+NEWREF(op)
+ object *op;
+{
+ ref_total++;
+ op->ob_refcnt = 1;
+ op->_ob_next = refchain._ob_next;
+ op->_ob_prev = &refchain;
+ refchain._ob_next->_ob_prev = op;
+ refchain._ob_next = op;
+}
+
+UNREF(op)
+ register object *op;
+{
+ register object *p;
+ if (op->ob_refcnt < 0) {
+ fprintf(stderr, "UNREF negative refcnt\n");
+ abort();
+ }
+ for (p = refchain._ob_next; p != &refchain; p = p->_ob_next) {
+ if (p == op)
+ break;
+ }
+ if (p == &refchain) { /* Not found */
+ fprintf(stderr, "UNREF unknown object\n");
+ abort();
+ }
+ op->_ob_next->_ob_prev = op->_ob_prev;
+ op->_ob_prev->_ob_next = op->_ob_next;
+}
+
+DELREF(op)
+ object *op;
+{
+ UNREF(op);
+ (*(op)->ob_type->tp_dealloc)(op);
+}
+
+printrefs(fp)
+ FILE *fp;
+{
+ object *op;
+ fprintf(fp, "Remaining objects:\n");
+ for (op = refchain._ob_next; op != &refchain; op = op->_ob_next) {
+ fprintf(fp, "[%d] ", op->ob_refcnt);
+ printobject(op, fp, 0);
+ putc('\n', fp);
+ }
+}
+
+#endif
diff --git a/src/object.h b/src/object.h
new file mode 100644
index 0000000..f0266c4
--- /dev/null
+++ b/src/object.h
@@ -0,0 +1,324 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+#define NDEBUG
+/* Object and type object interface */
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+Objects are structures allocated on the heap. Special rules apply to
+the use of objects to ensure they are properly garbage-collected.
+Objects are never allocated statically or on the stack; they must be
+accessed through special macros and functions only. (Type objects are
+exceptions to the first rule; the standard types are represented by
+statically initialized type objects.)
+
+An object has a 'reference count' that is increased or decreased when a
+pointer to the object is copied or deleted; when the reference count
+reaches zero there are no references to the object left and it can be
+removed from the heap.
+
+An object has a 'type' that determines what it represents and what kind
+of data it contains. An object's type is fixed when it is created.
+Types themselves are represented as objects; an object contains a
+pointer to the corresponding type object. The type itself has a type
+pointer pointing to the object representing the type 'type', which
+contains a pointer to itself!).
+
+Objects do not float around in memory; once allocated an object keeps
+the same size and address. Objects that must hold variable-size data
+can contain pointers to variable-size parts of the object. Not all
+objects of the same type have the same size; but the size cannot change
+after allocation. (These restrictions are made so a reference to an
+object can be simply a pointer -- moving an object would require
+updating all the pointers, and changing an object's size would require
+moving it if there was another object right next to it.)
+
+Objects are always accessed through pointers of the type 'object *'.
+The type 'object' is a structure that only contains the reference count
+and the type pointer. The actual memory allocated for an object
+contains other data that can only be accessed after casting the pointer
+to a pointer to a longer structure type. This longer type must start
+with the reference count and type fields; the macro OB_HEAD should be
+used for this (to accomodate for future changes). The implementation
+of a particular object type can cast the object pointer to the proper
+type and back.
+
+A standard interface exists for objects that contain an array of items
+whose size is determined when the object is allocated.
+
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+*/
+
+#ifndef NDEBUG
+
+/* Turn on heavy reference debugging */
+#define TRACE_REFS
+
+/* Turn on reference counting */
+#define REF_DEBUG
+
+#endif /* NDEBUG */
+
+#ifdef TRACE_REFS
+#define OB_HEAD \
+ struct _object *_ob_next, *_ob_prev; \
+ int ob_refcnt; \
+ struct _typeobject *ob_type;
+#define OB_HEAD_INIT(type) 0, 0, 1, type,
+#else
+#define OB_HEAD \
+ unsigned int ob_refcnt; \
+ struct _typeobject *ob_type;
+#define OB_HEAD_INIT(type) 1, type,
+#endif
+
+#define OB_VARHEAD \
+ OB_HEAD \
+ unsigned int ob_size; /* Number of items in variable part */
+
+typedef struct _object {
+ OB_HEAD
+} object;
+
+typedef struct {
+ OB_VARHEAD
+} varobject;
+
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+Type objects contain a string containing the type name (to help somewhat
+in debugging), the allocation parameters (see newobj() and newvarobj()),
+and methods for accessing objects of the type. Methods are optional,a
+nil pointer meaning that particular kind of access is not available for
+this type. The DECREF() macro uses the tp_dealloc method without
+checking for a nil pointer; it should always be implemented except if
+the implementation can guarantee that the reference count will never
+reach zero (e.g., for type objects).
+
+NB: the methods for certain type groups are now contained in separate
+method blocks.
+*/
+
+typedef struct {
+ object *(*nb_add) FPROTO((object *, object *));
+ object *(*nb_subtract) FPROTO((object *, object *));
+ object *(*nb_multiply) FPROTO((object *, object *));
+ object *(*nb_divide) FPROTO((object *, object *));
+ object *(*nb_remainder) FPROTO((object *, object *));
+ object *(*nb_power) FPROTO((object *, object *));
+ object *(*nb_negative) FPROTO((object *));
+ object *(*nb_positive) FPROTO((object *));
+} number_methods;
+
+typedef struct {
+ int (*sq_length) FPROTO((object *));
+ object *(*sq_concat) FPROTO((object *, object *));
+ object *(*sq_repeat) FPROTO((object *, int));
+ object *(*sq_item) FPROTO((object *, int));
+ object *(*sq_slice) FPROTO((object *, int, int));
+ int (*sq_ass_item) FPROTO((object *, int, object *));
+ int (*sq_ass_slice) FPROTO((object *, int, int, object *));
+} sequence_methods;
+
+typedef struct {
+ int (*mp_length) FPROTO((object *));
+ object *(*mp_subscript) FPROTO((object *, object *));
+ int (*mp_ass_subscript) FPROTO((object *, object *, object *));
+} mapping_methods;
+
+typedef struct _typeobject {
+ OB_VARHEAD
+ char *tp_name; /* For printing */
+ unsigned int tp_basicsize, tp_itemsize; /* For allocation */
+
+ /* Methods to implement standard operations */
+
+ void (*tp_dealloc) FPROTO((object *));
+ void (*tp_print) FPROTO((object *, FILE *, int));
+ object *(*tp_getattr) FPROTO((object *, char *));
+ int (*tp_setattr) FPROTO((object *, char *, object *));
+ int (*tp_compare) FPROTO((object *, object *));
+ object *(*tp_repr) FPROTO((object *));
+
+ /* Method suites for standard classes */
+
+ number_methods *tp_as_number;
+ sequence_methods *tp_as_sequence;
+ mapping_methods *tp_as_mapping;
+} typeobject;
+
+extern typeobject Typetype; /* The type of type objects */
+
+#define is_typeobject(op) ((op)->ob_type == &Typetype)
+
+/* Generic operations on objects */
+extern void printobject PROTO((object *, FILE *, int));
+extern object * reprobject PROTO((object *));
+extern int cmpobject PROTO((object *, object *));
+extern object *getattr PROTO((object *, char *));
+extern int setattr PROTO((object *, char *, object *));
+
+/* Flag bits for printing: */
+#define PRINT_RAW 1 /* No string quotes etc. */
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+The macros INCREF(op) and DECREF(op) are used to increment or decrement
+reference counts. DECREF calls the object's deallocator function; for
+objects that don't contain references to other objects or heap memory
+this can be the standard function free(). Both macros can be used
+whereever a void expression is allowed. The argument shouldn't be a
+NIL pointer. The macro NEWREF(op) is used only to initialize reference
+counts to 1; it is defined here for convenience.
+
+We assume that the reference count field can never overflow; this can
+be proven when the size of the field is the same as the pointer size
+but even with a 16-bit reference count field it is pretty unlikely so
+we ignore the possibility. (If you are paranoid, make it a long.)
+
+Type objects should never be deallocated; the type pointer in an object
+is not considered to be a reference to the type object, to save
+complications in the deallocation function. (This is actually a
+decision that's up to the implementer of each new type so if you want,
+you can count such references to the type object.)
+
+*** WARNING*** The DECREF macro must have a side-effect-free argument
+since it may evaluate its argument multiple times. (The alternative
+would be to mace it a proper function or assign it to a global temporary
+variable first, both of which are slower; and in a multi-threaded
+environment the global variable trick is not safe.)
+*/
+
+#ifdef TRACE_REFS
+#ifndef REF_DEBUG
+#define REF_DEBUG
+#endif
+#endif
+
+#ifndef TRACE_REFS
+#define DELREF(op) (*(op)->ob_type->tp_dealloc)((object *)(op))
+#define UNREF(op) /*empty*/
+#endif
+
+#ifdef REF_DEBUG
+extern long ref_total;
+#ifndef TRACE_REFS
+#define NEWREF(op) (ref_total++, (op)->ob_refcnt = 1)
+#endif
+#define INCREF(op) (ref_total++, (op)->ob_refcnt++)
+#define DECREF(op) \
+ if (--ref_total, --(op)->ob_refcnt > 0) \
+ ; \
+ else \
+ DELREF(op)
+#else
+#define NEWREF(op) ((op)->ob_refcnt = 1)
+#define INCREF(op) ((op)->ob_refcnt++)
+#define DECREF(op) \
+ if (--(op)->ob_refcnt > 0) \
+ ; \
+ else \
+ DELREF(op)
+#endif
+
+/* Macros to use in case the object pointer may be NULL: */
+
+#define XINCREF(op) if ((op) == NULL) ; else INCREF(op)
+#define XDECREF(op) if ((op) == NULL) ; else DECREF(op)
+
+/* Definition of NULL, so you don't have to include <stdio.h> */
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+
+/*
+NoObject is an object of undefined type which can be used in contexts
+where NULL (nil) is not suitable (since NULL often means 'error').
+
+Don't forget to apply INCREF() when returning this value!!!
+*/
+
+extern object NoObject; /* Don't use this directly */
+
+#define None (&NoObject)
+
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+More conventions
+================
+
+Argument Checking
+-----------------
+
+Functions that take objects as arguments normally don't check for nil
+arguments, but they do check the type of the argument, and return an
+error if the function doesn't apply to the type.
+
+Failure Modes
+-------------
+
+Functions may fail for a variety of reasons, including running out of
+memory. This is communicated to the caller in two ways: an error string
+is set (see errors.h), and the function result differs: functions that
+normally return a pointer return NULL for failure, functions returning
+an integer return -1 (which could be a legal return value too!), and
+other functions return 0 for success and -1 for failure.
+Callers should always check for errors before using the result.
+
+Reference Counts
+----------------
+
+It takes a while to get used to the proper usage of reference counts.
+
+Functions that create an object set the reference count to 1; such new
+objects must be stored somewhere or destroyed again with DECREF().
+Functions that 'store' objects such as settupleitem() and dictinsert()
+don't increment the reference count of the object, since the most
+frequent use is to store a fresh object. Functions that 'retrieve'
+objects such as gettupleitem() and dictlookup() also don't increment
+the reference count, since most frequently the object is only looked at
+quickly. Thus, to retrieve an object and store it again, the caller
+must call INCREF() explicitly.
+
+NOTE: functions that 'consume' a reference count like dictinsert() even
+consume the reference if the object wasn't stored, to simplify error
+handling.
+
+It seems attractive to make other functions that take an object as
+argument consume a reference count; however this may quickly get
+confusing (even the current practice is already confusing). Consider
+it carefully, it may safe lots of calls to INCREF() and DECREF() at
+times.
+
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+*/
diff --git a/src/objimpl.h b/src/objimpl.h
new file mode 100644
index 0000000..7d40718
--- /dev/null
+++ b/src/objimpl.h
@@ -0,0 +1,50 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+Additional macros for modules that implement new object types.
+You must first include "object.h".
+
+NEWOBJ(type, typeobj) allocates memory for a new object of the given
+type; here 'type' must be the C structure type used to represent the
+object and 'typeobj' the address of the corresponding type object.
+Reference count and type pointer are filled in; the rest of the bytes of
+the object are *undefined*! The resulting expression type is 'type *'.
+The size of the object is actually determined by the tp_basicsize field
+of the type object.
+
+NEWVAROBJ(type, typeobj, n) is similar but allocates a variable-size
+object with n extra items. The size is computer as tp_basicsize plus
+n * tp_itemsize. This fills in the ob_size field as well.
+*/
+
+extern object *newobject PROTO((typeobject *));
+extern varobject *newvarobject PROTO((typeobject *, unsigned int));
+
+#define NEWOBJ(type, typeobj) ((type *) newobject(typeobj))
+#define NEWVAROBJ(type, typeobj, n) ((type *) newvarobject(typeobj, n))
+
+extern int StopPrint; /* Set when printing is interrupted */
diff --git a/src/opcode.h b/src/opcode.h
new file mode 100644
index 0000000..ad6d712
--- /dev/null
+++ b/src/opcode.h
@@ -0,0 +1,109 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Instruction opcodes for compiled code */
+
+#define STOP_CODE 0
+#define POP_TOP 1
+#define ROT_TWO 2
+#define ROT_THREE 3
+#define DUP_TOP 4
+
+#define UNARY_POSITIVE 10
+#define UNARY_NEGATIVE 11
+#define UNARY_NOT 12
+#define UNARY_CONVERT 13
+#define UNARY_CALL 14
+
+#define BINARY_MULTIPLY 20
+#define BINARY_DIVIDE 21
+#define BINARY_MODULO 22
+#define BINARY_ADD 23
+#define BINARY_SUBTRACT 24
+#define BINARY_SUBSCR 25
+#define BINARY_CALL 26
+
+#define SLICE 30
+/* Also uses 31-33 */
+
+#define STORE_SLICE 40
+/* Also uses 41-43 */
+
+#define DELETE_SLICE 50
+/* Also uses 51-53 */
+
+#define STORE_SUBSCR 60
+#define DELETE_SUBSCR 61
+
+#define PRINT_EXPR 70
+#define PRINT_ITEM 71
+#define PRINT_NEWLINE 72
+
+#define BREAK_LOOP 80
+#define RAISE_EXCEPTION 81
+#define LOAD_LOCALS 82
+#define RETURN_VALUE 83
+#define REQUIRE_ARGS 84
+#define REFUSE_ARGS 85
+#define BUILD_FUNCTION 86
+#define POP_BLOCK 87
+#define END_FINALLY 88
+#define BUILD_CLASS 89
+
+#define HAVE_ARGUMENT 90 /* Opcodes from here have an argument: */
+
+#define STORE_NAME 90 /* Index in name list */
+#define DELETE_NAME 91 /* "" */
+#define UNPACK_TUPLE 92 /* Number of tuple items */
+#define UNPACK_LIST 93 /* Number of list items */
+/* unused: 94 */
+#define STORE_ATTR 95 /* Index in name list */
+#define DELETE_ATTR 96 /* "" */
+
+#define LOAD_CONST 100 /* Index in const list */
+#define LOAD_NAME 101 /* Index in name list */
+#define BUILD_TUPLE 102 /* Number of tuple items */
+#define BUILD_LIST 103 /* Number of list items */
+#define BUILD_MAP 104 /* Always zero for now */
+#define LOAD_ATTR 105 /* Index in name list */
+#define COMPARE_OP 106 /* Comparison operator */
+#define IMPORT_NAME 107 /* Index in name list */
+#define IMPORT_FROM 108 /* Index in name list */
+
+#define JUMP_FORWARD 110 /* Number of bytes to skip */
+#define JUMP_IF_FALSE 111 /* "" */
+#define JUMP_IF_TRUE 112 /* "" */
+#define JUMP_ABSOLUTE 113 /* Target byte offset from beginning of code */
+#define FOR_LOOP 114 /* Number of bytes to skip */
+
+#define SETUP_LOOP 120 /* Target address (absolute) */
+#define SETUP_EXCEPT 121 /* "" */
+#define SETUP_FINALLY 122 /* "" */
+
+#define SET_LINENO 127 /* Current line number */
+
+/* Comparison operator codes (argument to COMPARE_OP) */
+enum cmp_op {LT, LE, EQ, NE, GT, GE, IN, NOT_IN, IS, IS_NOT, EXC_MATCH, BAD};
+
+#define HAS_ARG(op) ((op) >= HAVE_ARGUMENT)
diff --git a/src/panelmodule.c b/src/panelmodule.c
new file mode 100644
index 0000000..9edde6b
--- /dev/null
+++ b/src/panelmodule.c
@@ -0,0 +1,1090 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Panel module.
+ Interface to the NASA Ames "panel library" for the SGI Graphics Library
+ by David Tristram.
+
+ NOTE: the panel library dumps core if you don't create a window before
+ calling pnl.mkpanel(). A call to gl.winopen() suffices.
+ If you don't want a window to be created, call gl.noport() before
+ gl.winopen().
+*/
+
+#include <gl.h>
+#include <device.h>
+#include <panel.h>
+
+#include "allobjects.h"
+#include "import.h"
+#include "modsupport.h"
+#include "cgensupport.h"
+
+
+/* The offsetof() macro calculates the offset of a structure member
+ in its structure. Unfortunately this cannot be written down portably,
+ hence it is standardized by ANSI C. For pre-ANSI C compilers,
+ we give a version here that works usually (but watch out!): */
+
+#ifndef offsetof
+#define offsetof(type, member) ( (int) & ((type*)0) -> member )
+#endif
+
+
+/* Panel objects */
+
+typedef struct {
+ OB_HEAD
+ Panel *ob_panel;
+ object *ob_paneldict;
+} panelobject;
+
+extern typeobject Paneltype; /* Really static, forward */
+
+#define is_panelobject(v) ((v)->ob_type == &Paneltype)
+
+
+/* Actuator objects */
+
+typedef struct {
+ OB_HEAD
+ Actuator *ob_actuator;
+} actuatorobject;
+
+extern typeobject Actuatortype; /* Really static, forward */
+
+#define is_actuatorobject(v) ((v)->ob_type == &Actuatortype)
+
+static object *newactuatorobject(); /* Forward */
+
+
+/* Since we allow different types of members than the functions from
+ structmember.c, the memberlist stuff is replicated here.
+ (Historically, it originated in this file and later became a generic
+ feature.) */
+
+/* An array of memberlist structures defines the name, type and offset
+ of selected members of a C structure. These can be read by
+ panel_getmember() and set by panel_setmember() (except if their
+ READONLY flag is set). The array must be terminated with an entry
+ whose name pointer is NULL. */
+
+struct memberlist {
+ char *name;
+ int type;
+ int offset;
+ int readonly;
+};
+
+/* Types */
+#define T_SHORT 0
+#define T_DEVICE T_SHORT
+#define T_LONG 1
+#define T_INT T_LONG
+#define T_BOOL T_LONG
+#define T_FLOAT 2
+#define T_COORD T_FLOAT
+#define T_STRING 3
+#define T_FUNC 4
+#define T_ACTUATOR 5
+
+/* Readonly flag */
+#define READONLY 1
+#define RO READONLY /* Shorthand */
+
+static object *
+panel_getmember(addr, mlist, name)
+ char *addr;
+ struct memberlist *mlist;
+ char *name;
+{
+ object *v;
+ register struct memberlist *l;
+
+ for (l = mlist; l->name != NULL; l++) {
+ if (strcmp(l->name, name) == 0) {
+ addr += l->offset;
+ switch (l->type) {
+ case T_SHORT:
+ v = newintobject((long) *(short*)addr);
+ break;
+ case T_LONG:
+ v = newintobject(*(long*)addr);
+ break;
+ case T_FLOAT:
+ v = newfloatobject(*(float*)addr);
+ break;
+ case T_STRING:
+ if (*(char**)addr == NULL) {
+ INCREF(None);
+ v = None;
+ }
+ else
+ v = newstringobject(*(char**)addr);
+ break;
+ case T_ACTUATOR:
+ v = newactuatorobject(*(Actuator**)addr);
+ break;
+ default:
+ err_badarg();
+ v = NULL;
+ }
+ return v;
+ }
+ }
+ err_setstr(NameError, name);
+ return NULL;
+}
+
+/* Attempt to set a member. Return: 0 if OK; 1 if not found; -1 if error */
+
+static int
+panel_setmember(addr, mlist, name, v)
+ char *addr;
+ struct memberlist *mlist;
+ char *name;
+ object *v;
+{
+ register struct memberlist *l;
+
+ for (l = mlist; l->name != NULL; l++) {
+ if (strcmp(l->name, name) == 0) {
+ if (l->readonly) {
+ err_setstr(TypeError, "read-only member");
+ return -1;
+ }
+ addr += l->offset;
+ switch (l->type) {
+ case T_SHORT:
+ if (!is_intobject(v)) {
+ err_setstr(TypeError, "int expected");
+ return -1;
+ }
+ *(short*)addr = getintvalue(v);
+ break;
+ case T_LONG:
+ if (!is_intobject(v)) {
+ err_setstr(TypeError, "int expected");
+ return -1;
+ }
+ *(long*)addr = getintvalue(v);
+ break;
+ case T_FLOAT:
+ if (is_intobject(v))
+ *(float*)addr = getintvalue(v);
+ else if (is_floatobject(v))
+ *(float*)addr = getfloatvalue(v);
+ else {
+ err_setstr(TypeError,"float expected");
+ return -1;
+ }
+ break;
+ case T_STRING:
+ /* XXX Should free(*(char**)addr) here
+ but it's dangerous since we don't know
+ if we set the label ourselves */
+ if (v == None)
+ *(char**)addr = NULL;
+ else if (!is_stringobject(v)) {
+ err_setstr(TypeError,
+ "string expected");
+ return -1;
+ }
+ else
+ *(char**)addr =
+ strdup(getstringvalue(v));
+ break;
+ case T_ACTUATOR:
+ if (v == None)
+ *(Actuator**)addr = NULL;
+ else if (!is_actuatorobject(v)) {
+ err_setstr(TypeError,
+ "actuator expected");
+ return -1;
+ }
+ else
+ *(Actuator**)addr =
+ ((actuatorobject *)v)->ob_actuator;
+ break;
+ default:
+ err_setstr(SystemError, "unknown member type");
+ return -1;
+ }
+ return 0; /* Found it */
+ }
+ }
+
+ return 1; /* Not found */
+}
+
+
+/* Panel object methods */
+
+static object *
+panel_addpanel(self, args)
+ panelobject *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ pnl_addpanel(self->ob_panel);
+ INCREF(None);
+ return None;
+}
+
+static object *
+panel_endgroup(self, args)
+ panelobject *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ pnl_endgroup(self->ob_panel);
+ INCREF(None);
+ return None;
+}
+
+static object *
+panel_fixpanel(self, args)
+ panelobject *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ pnl_fixpanel(self->ob_panel);
+ INCREF(None);
+ return None;
+}
+
+static object *
+panel_strwidth(self, args)
+ panelobject *self;
+ object *args;
+{
+ object *v;
+ double width;
+ if (!getstrarg(args, &v))
+ return NULL;
+ width = pnl_strwidth(self->ob_panel, getstringvalue(v));
+ return newfloatobject(width);
+}
+
+static struct methodlist panel_methods[] = {
+ {"addpanel", panel_addpanel},
+ {"endgroup", panel_endgroup},
+ {"fixpanel", panel_fixpanel},
+ {"strwidth", panel_strwidth},
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+newpanelobject()
+{
+ panelobject *p;
+ p = NEWOBJ(panelobject, &Paneltype);
+ if (p == NULL)
+ return NULL;
+ p->ob_panel = pnl_mkpanel();
+ if ((p->ob_paneldict = newdictobject()) == NULL) {
+ DECREF(p);
+ return NULL;
+ }
+ return (object *)p;
+}
+
+static void
+panel_dealloc(p)
+ panelobject *p;
+{
+ pnl_delpanel(p->ob_panel);
+ if (p->ob_paneldict != NULL)
+ DECREF(p->ob_paneldict);
+ DEL(p);
+}
+
+
+/* Table of panel members */
+
+#define PANOFF(member) offsetof(Panel, member)
+
+static struct memberlist panel_memberlist[] = {
+ {"id", T_SHORT, PANOFF(id), READONLY},
+ {"a", T_ACTUATOR, PANOFF(a), READONLY},
+ {"al", T_ACTUATOR, PANOFF(al), READONLY},
+ {"lastgroup", T_ACTUATOR, PANOFF(lastgroup), READONLY},
+
+ {"active", T_BOOL, PANOFF(active)},
+ {"selectable", T_BOOL, PANOFF(selectable)},
+
+ {"x", T_LONG, PANOFF(x)},
+ {"y", T_LONG, PANOFF(y)},
+ {"w", T_LONG, PANOFF(w)},
+ {"h", T_LONG, PANOFF(h)},
+
+ {"minx", T_COORD, PANOFF(minx)},
+ {"maxx", T_COORD, PANOFF(maxx)},
+ {"miny", T_COORD, PANOFF(miny)},
+ {"maxy", T_COORD, PANOFF(maxy)},
+
+ {"cw", T_COORD, PANOFF(cw)},
+ {"ch", T_COORD, PANOFF(ch)},
+
+ {"gid", T_LONG, PANOFF(gid), READONLY},
+ {"usergid", T_LONG, PANOFF(usergid), READONLY},
+
+ {"vobj", T_LONG, PANOFF(vobj), READONLY},
+ {"ppu", T_FLOAT, PANOFF(ppu)},
+
+ {"label", T_STRING, PANOFF(label)},
+
+ /* Panel callbacks are not supported */
+
+ {"visible", T_BOOL, PANOFF(visible)},
+ {"somedirty", T_INT, PANOFF(somedirty)},
+ {"dirtycnt", T_INT, PANOFF(dirtycnt)},
+
+ /* T_PANEL is not supported */
+ /*
+ {"next", T_PANEL, PANOFF(next), READONLY},
+ */
+
+ {NULL, 0, 0} /* Sentinel */
+};
+
+static object *
+panel_getattr(p, name)
+ panelobject *p;
+ char *name;
+{
+ object *v;
+
+ v = dictlookup(p->ob_paneldict, name);
+ if (v != NULL) {
+ INCREF(v);
+ return v;
+ }
+
+ v = findmethod(panel_methods, (object *)p, name);
+ if (v != NULL)
+ return v;
+ err_clear();
+ return panel_getmember((char *)p->ob_panel, panel_memberlist, name);
+}
+
+static int
+panel_setattr(p, name, v)
+ panelobject *p;
+ char *name;
+ object *v;
+{
+ int err;
+
+ /* We don't allow deletion of attributes */
+ if (v == NULL) {
+ err_setstr(TypeError, "read-only panel attribute");
+ return -1;
+ }
+ err = panel_setmember((char *)p->ob_panel, panel_memberlist, name, v);
+ if (err != 1)
+ return err;
+ return dictinsert(p->ob_paneldict, name, v);
+}
+
+static typeobject Paneltype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /*ob_size*/
+ "panel", /*tp_name*/
+ sizeof(panelobject), /*tp_size*/
+ 0, /*tp_itemsize*/
+ /* methods */
+ panel_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ panel_getattr, /*tp_getattr*/
+ panel_setattr, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+};
+
+
+/* Descriptions of actuator-specific data members */
+
+struct memberlist slider_spec[] = {
+ {"mode", T_INT, offsetof(Slider, mode)},
+ {"finefactor", T_FLOAT, offsetof(Slider, finefactor)},
+ {"differentialfactor",
+ T_FLOAT, offsetof(Slider, differentialfactor)},
+ {"valsave", T_FLOAT, offsetof(Slider, valsave), RO},
+ {"wsave", T_COORD, offsetof(Slider, wsave)},
+ {"bh", T_COORD, offsetof(Slider, bh)},
+ {NULL}
+};
+
+#define palette_spec slider_spec
+
+struct memberlist puck_spec[] = {
+ /* Actuators already have members x and y, so the Puck's x and y
+ have different names */
+ {"puck_x", T_FLOAT, offsetof(Puck, x)},
+ {"puck_y", T_FLOAT, offsetof(Puck, y)},
+ {NULL}
+};
+
+struct memberlist dial_spec[] = {
+ {"mode", T_INT, offsetof(Dial, mode)},
+ {"finefactor", T_FLOAT, offsetof(Dial, finefactor)},
+ {"valsave", T_FLOAT, offsetof(Dial, valsave), RO},
+ {"wsave", T_COORD, offsetof(Dial, wsave)},
+ {"winds", T_FLOAT, offsetof(Dial, winds)},
+ {NULL}
+};
+
+struct memberlist slideroid_spec[] = {
+ {"mode", T_INT, offsetof(Slideroid, mode)},
+ {"finemode", T_BOOL, offsetof(Slideroid, finemode)},
+ {"resetmode", T_BOOL, offsetof(Slideroid, resetmode)},
+ /* XXX Can't do resettarget (pointer to float) */
+ /* XXX This makes resetval pretty useless... */
+ /*
+ {"resetval", T_FLOAT, offsetof(Slideroid, resetval)},
+ */
+ {"valsave", T_FLOAT, offsetof(Slideroid, valsave), RO},
+ {"wsave", T_COORD, offsetof(Slideroid, wsave)},
+ {NULL}
+};
+
+struct memberlist stripchart_spec[] = {
+ {"firstpt", T_INT, offsetof(Stripchart, firstpt), RO},
+ {"lastpt", T_INT, offsetof(Stripchart, lastpt), RO},
+ {"Bind_Low", T_BOOL, offsetof(Stripchart, Bind_Low)},
+ {"Bind_High", T_BOOL, offsetof(Stripchart, Bind_High)},
+ /* XXX Can't do y (array of floats) */
+ {"lowlabel", T_ACTUATOR, offsetof(Stripchart, lowlabel), RO},
+ {"highlabel", T_ACTUATOR, offsetof(Stripchart, highlabel), RO},
+ {NULL}
+};
+
+struct memberlist typein_spec[] = {
+ /* Note: these should be readonly after the actuator is added
+ to a panel */
+ {"str", T_STRING, offsetof(Typein, str)},
+ {"len", T_INT, offsetof(Typein, len)},
+ {NULL}
+};
+
+struct memberlist typeout_spec[] = {
+ {"mode", T_INT, offsetof(Typeout, mode)},
+ /* XXX The buffer is managed by the actuator; but how do we
+ add text? */
+ {"buf", T_STRING, offsetof(Typeout, buf), READONLY},
+ {"delimstr", T_STRING, offsetof(Typeout, delimstr)},
+ {"start", T_INT, offsetof(Typeout, start)},
+ {"dot", T_INT, offsetof(Typeout, dot)},
+ {"mark", T_INT, offsetof(Typeout, mark)},
+ {"col", T_INT, offsetof(Typeout, col)},
+ {"lin", T_INT, offsetof(Typeout, lin)},
+ {"len", T_INT, offsetof(Typeout, len)},
+ {"size", T_INT, offsetof(Typeout, size)},
+ {NULL}
+};
+
+struct memberlist mouse_spec[] = {
+ /* Actuators already have members x and y, so the Mouse's x and y
+ have different names */
+ {"mouse_x", T_FLOAT, offsetof(Mouse, x)},
+ {"mouse_y", T_FLOAT, offsetof(Mouse, y)},
+ {NULL}
+};
+
+#define MULOFF(member) offsetof(Multislider, member)
+
+struct memberlist multislider_spec[] = {
+ {"mode", T_INT, MULOFF(mode)},
+ {"n", T_INT, MULOFF(n)},
+ {"finefactor", T_FLOAT, MULOFF(finefactor)},
+ {"wsave", T_COORD, MULOFF(wsave)},
+ {"sa", T_ACTUATOR, MULOFF(sa)},
+ {"bh", T_COORD, MULOFF(bh)},
+ {"clrx", T_COORD, MULOFF(clrx)},
+ {"clry", T_COORD, MULOFF(clry)},
+ {"clrw", T_COORD, MULOFF(clrw)},
+ {"clrh", T_COORD, MULOFF(clrh)},
+ /* XXX acttype? */
+ {NULL}
+};
+
+/* XXX Still to do:
+ Frame
+ Icon
+ Cycle
+ Scroll
+ Menu
+*/
+
+/* List of known actuator initializer functions */
+
+struct {
+ char *name;
+ void (*func)();
+ struct memberlist *spec;
+} initializerlist[] = {
+ {"analog_bar", pnl_analog_bar},
+ {"analog_meter", pnl_analog_meter},
+ {"button", pnl_button},
+ {"cycle", pnl_cycle},
+ /* Doesn't exist: */
+/* {"dhslider", pnl_dhslider, slider_spec}, */
+ {"dial", pnl_dial, dial_spec},
+ {"down_arrow_button", pnl_down_arrow_button},
+ {"down_double_arrow_button", pnl_down_double_arrow_button},
+ {"dvslider", pnl_dvslider, slider_spec},
+ {"filled_hslider", pnl_filled_hslider, slider_spec},
+ {"filled_slider", pnl_filled_slider, slider_spec},
+ {"filled_vslider", pnl_filled_vslider, slider_spec},
+ {"floating_puck", pnl_floating_puck, puck_spec},
+ {"frame", pnl_frame},
+ {"graphframe", pnl_graphframe},
+ {"hmultislider", pnl_hmultislider, multislider_spec},
+ {"hmultislider_bar", pnl_hmultislider_bar},
+ {"hmultislider_open_bar", pnl_hmultislider_open_bar},
+ {"hpalette", pnl_hpalette, palette_spec},
+ {"hslider", pnl_hslider, slider_spec},
+ {"icon", pnl_icon},
+ {"icon_menu", pnl_icon_menu},
+ {"label", pnl_label},
+ {"left_arrow_button", pnl_left_arrow_button},
+ {"left_double_arrow_button", pnl_left_double_arrow_button},
+ {"menu", pnl_menu},
+ {"menu_item", pnl_menu_item},
+ {"meter", pnl_meter},
+ {"mouse", pnl_mouse, mouse_spec},
+ {"multislider", pnl_multislider, multislider_spec},
+ {"multislider_bar", pnl_multislider_bar},
+ {"multislider_open_bar", pnl_multislider_open_bar},
+ {"palette", pnl_palette, palette_spec},
+ {"puck", pnl_puck, puck_spec},
+ {"radio_button", pnl_radio_button},
+ {"radio_check_button", pnl_radio_check_button},
+ {"right_arrow_button", pnl_right_arrow_button},
+ {"right_double_arrow_button", pnl_right_double_arrow_button},
+ {"rubber_puck", pnl_rubber_puck, puck_spec},
+ {"scale_chart", pnl_scale_chart, stripchart_spec},
+ {"scroll", pnl_scroll},
+ {"signal", pnl_signal},
+ {"slider", pnl_slider, slider_spec},
+ {"slideroid", pnl_slideroid, slideroid_spec},
+ {"strip_chart", pnl_strip_chart, stripchart_spec},
+ {"sub_menu", pnl_sub_menu},
+ {"toggle_button", pnl_toggle_button},
+ {"typein", pnl_typein, typein_spec},
+ {"typeout", pnl_typeout, typeout_spec},
+ {"up_arrow_button", pnl_up_arrow_button},
+ {"up_double_arrow_button", pnl_up_double_arrow_button},
+ {"viewframe", pnl_viewframe},
+ {"vmultislider", pnl_vmultislider, multislider_spec},
+ {"vmultislider_bar", pnl_vmultislider_bar},
+ {"vmultislider_open_bar", pnl_vmultislider_open_bar},
+ {"vpalette", pnl_vpalette, palette_spec},
+ {"vslider", pnl_vslider, slider_spec},
+ {"wide_button", pnl_wide_button},
+ {NULL, NULL} /* Sentinel */
+};
+
+
+/* Pseudo downfunc etc. */
+
+static Actuator *down_pend, *active_pend, *up_pend;
+
+static void
+downfunc(a)
+ Actuator *a;
+{
+ if (down_pend == NULL)
+ down_pend = a;
+}
+
+static void
+activefunc(a)
+ Actuator *a;
+{
+ if (active_pend == NULL)
+ active_pend = a;
+}
+
+static void
+upfunc(a)
+ Actuator *a;
+{
+ if (up_pend == NULL)
+ up_pend = a;
+}
+
+
+/* Lay-out for the user data */
+
+struct userdata {
+ object *dict; /* Dictionary object for additional attributes */
+ struct memberlist *spec; /* Actuator-specific members */
+};
+
+
+/* Create a new actuator; the actuator type is given as a string */
+
+static Actuator *
+makeactuator(name)
+ char *name;
+{
+ Actuator *act;
+ void (*initializer)() = NULL;
+ int i;
+ struct userdata *u;
+ for (i = 0; initializerlist[i].name != NULL; i++) {
+ if (strcmp(initializerlist[i].name, name) == 0) {
+ initializer = initializerlist[i].func;
+ break;
+ }
+ }
+ if (initializerlist[i].name == NULL) {
+ err_badarg();
+ return NULL;
+ }
+ u = NEW(struct userdata, 1);
+ if (u == NULL) {
+ err_nomem();
+ return NULL;
+ }
+ u->dict = NULL;
+ u->spec = initializerlist[i].spec;
+ act = pnl_mkact(initializer);
+ act->u = (char *)u;
+ act->downfunc = downfunc;
+ act->activefunc = activefunc;
+ act->upfunc = upfunc;
+ return act;
+}
+
+
+/* Actuator objects methods */
+
+static object *
+actuator_addact(self, args)
+ actuatorobject *self;
+ object *args;
+{
+ Panel *p;
+ if (!is_panelobject(args)) {
+ err_badarg();
+ return NULL;
+ }
+ p = ((panelobject *)args) -> ob_panel;
+ pnl_addact(self->ob_actuator, p);
+ INCREF(None);
+ return None;
+}
+
+static object *
+actuator_addsubact(self, args)
+ actuatorobject *self;
+ object *args;
+{
+ Actuator *a;
+ if (!is_actuatorobject(args)) {
+ err_badarg();
+ return NULL;
+ }
+ a = ((actuatorobject *)args) -> ob_actuator;
+ pnl_addsubact(self->ob_actuator, a);
+ INCREF(None);
+ return None;
+}
+
+static object *
+actuator_delact(self, args)
+ actuatorobject *self;
+ object *args;
+{
+ Panel *p;
+ if (!getnoarg(args))
+ return NULL;
+ pnl_delact(self->ob_actuator);
+ INCREF(None);
+ return None;
+}
+
+static object *
+actuator_fixact(self, args)
+ actuatorobject *self;
+ object *args;
+{
+ Panel *p;
+ if (!getnoarg(args))
+ return NULL;
+ pnl_fixact(self->ob_actuator);
+ INCREF(None);
+ return None;
+}
+
+static object *
+actuator_tprint(self, args)
+ actuatorobject *self;
+ object *args;
+{
+ object *str;
+ if (self->ob_actuator->type != PNL_TYPEOUT) {
+ err_setstr(TypeError, "tprint for non-typeout panel");
+ return NULL;
+ }
+ if (!getstrarg(args, &str))
+ return NULL;
+ tprint(self->ob_actuator, getstringvalue(str));
+ /* XXX Can't turn tprint's errors into exceptions, sorry */
+ INCREF(None);
+ return None;
+}
+
+static struct methodlist actuator_methods[] = {
+ {"addact", actuator_addact},
+ {"addsubact", actuator_addsubact},
+ {"delact", actuator_delact},
+ {"fixact", actuator_fixact},
+ {"tprint", actuator_tprint},
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+newactuatorobject(act)
+ Actuator *act;
+{
+ actuatorobject *a;
+ if (act == NULL) {
+ INCREF(None);
+ return None;
+ }
+ a = NEWOBJ(actuatorobject, &Actuatortype);
+ if (a == NULL)
+ return NULL;
+ a->ob_actuator = act;
+ return (object *)a;
+}
+
+static void
+actuator_dealloc(a)
+ actuatorobject *a;
+{
+ /* Do NOT delete the actuator; most actuator objects are created
+ to hold a temporary reference to an actuator, like one gotten
+ from pnl_dopanel(). */
+
+ DEL(a);
+}
+
+
+/* Table of actuator members */
+
+#define ACTOFF(member) offsetof(Actuator, member)
+
+struct memberlist act_memberlist[] = {
+ {"id", T_SHORT, ACTOFF(id), READONLY},
+
+ /* T_PANEL is not defined */
+ /*
+ {"p", T_PANEL, ACTOFF(p), READONLY},
+ */
+
+ {"pa", T_ACTUATOR, ACTOFF(pa), READONLY},
+ {"ca", T_ACTUATOR, ACTOFF(ca), READONLY},
+ {"al", T_ACTUATOR, ACTOFF(al), READONLY},
+ {"na", T_INT, ACTOFF(na), READONLY},
+ {"type", T_INT, ACTOFF(type), READONLY},
+ {"active", T_BOOL, ACTOFF(active)},
+
+ {"x", T_COORD, ACTOFF(x)},
+ {"y", T_COORD, ACTOFF(y)},
+ {"w", T_COORD, ACTOFF(w)},
+ {"h", T_COORD, ACTOFF(h)},
+
+ {"lx", T_COORD, ACTOFF(lx)},
+ {"ly", T_COORD, ACTOFF(ly)},
+ {"lw", T_COORD, ACTOFF(lw)},
+ {"lh", T_COORD, ACTOFF(lh)},
+ {"ld", T_COORD, ACTOFF(ld)},
+
+ {"val", T_FLOAT, ACTOFF(val)},
+ {"extval", T_FLOAT, ACTOFF(extval)},
+ {"initval", T_FLOAT, ACTOFF(initval)},
+ {"maxval", T_FLOAT, ACTOFF(maxval)},
+ {"minval", T_FLOAT, ACTOFF(minval)},
+ {"scalefactor", T_FLOAT, ACTOFF(scalefactor)},
+
+ {"label", T_STRING, ACTOFF(label)},
+ {"key", T_DEVICE, ACTOFF(key)},
+ {"labeltype", T_INT, ACTOFF(labeltype)},
+
+ /* Internal callbacks are not supported;
+ user callbacks are treated special! */
+
+ {"dirtycnt", T_INT, ACTOFF(dirtycnt)},
+
+ /* members u and data are accessed differently */
+
+ {"automatic", T_BOOL, ACTOFF(automatic)},
+ {"selectable", T_BOOL, ACTOFF(selectable)},
+ {"visible", T_BOOL, ACTOFF(visible)},
+ {"beveled", T_BOOL, ACTOFF(beveled)},
+
+ {"group", T_ACTUATOR, ACTOFF(group), READONLY},
+ {"next", T_ACTUATOR, ACTOFF(next), READONLY},
+
+ {NULL, 0, 0} /* Sentinel */
+};
+
+
+/* Potential name conflicts between attributes are solved as follows.
+ - Actuator-specific attributes always override generic attributes.
+ - When reading, the dictionary has overrides everything else;
+ when writing, everything else overrides the dictionary.
+ - When reading, methods are tried last.
+*/
+
+static object *
+actuator_getattr(a, name)
+ actuatorobject *a;
+ char *name;
+{
+ Actuator *act = a->ob_actuator;
+ struct userdata *u = (struct userdata *) act->u;
+ object *v;
+
+ if (u != NULL) {
+ /* 1. Try the dictionary */
+ if (u->dict != NULL) {
+ v = dictlookup(u->dict, name);
+ if (v != NULL) {
+ INCREF(v);
+ return v;
+ }
+ }
+
+ /* 2. Try actuator-specific attributes */
+ if (u->spec != NULL) {
+ v = panel_getmember(act->data, u->spec, name);
+ if (v != NULL)
+ return v;
+ err_clear();
+ }
+ }
+
+ /* 3. Try generic actuator attributes */
+ v = panel_getmember((char *)act, act_memberlist, name);
+ if (v != NULL)
+ return v;
+
+ /* 4. Try methods */
+ err_clear();
+ return findmethod(actuator_methods, (object *)a, name);
+}
+
+static int
+actuator_setattr(a, name, v)
+ actuatorobject *a;
+ char *name;
+ object *v;
+{
+ Actuator *act = a->ob_actuator;
+ struct userdata *u = (struct userdata *) act->u;
+ int err;
+
+ /* 0. We don't allow deletion of attributes */
+ if (v == NULL) {
+ err_setstr(TypeError, "read-only actuator attribute");
+ return -1;
+ }
+
+ /* 1. Try actuator-specific attributes */
+ if (u != NULL && u->spec != NULL) {
+ err = panel_setmember(act->data, u->spec, name, v);
+ if (err != 1)
+ return err;
+ }
+
+ /* 2. Try generic actuator attributes */
+ err = panel_setmember((char *)act, act_memberlist, name, v);
+ if (err != 1)
+ return err;
+
+ /* 3. Try the dictionary */
+ if (u != NULL) {
+ if (u->dict == NULL && (u->dict = newdictobject()) == NULL)
+ return NULL;
+ return dictinsert(u->dict, name, v);
+ }
+
+ err_setstr(NameError, name);
+ return -1;
+}
+
+static int
+actuator_compare(v, w)
+ actuatorobject *v, *w;
+{
+ long i = (long)v->ob_actuator;
+ long j = (long)w->ob_actuator;
+ return (i < j) ? -1 : (i > j) ? 1 : 0;
+}
+
+static typeobject Actuatortype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /*ob_size*/
+ "actuator", /*tp_name*/
+ sizeof(actuatorobject), /*tp_size*/
+ 0, /*tp_itemsize*/
+ /* methods */
+ actuator_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ actuator_getattr, /*tp_getattr*/
+ actuator_setattr, /*tp_setattr*/
+ actuator_compare, /*tp_compare*/
+ 0, /*tp_repr*/
+};
+
+
+/* The panel module itself */
+
+static object *
+module_mkpanel(self, args)
+ object *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ return newpanelobject();
+}
+
+static object *
+module_mkact(self, args)
+ object *self;
+ object *args;
+{
+ object *v;
+ Actuator *a;
+ if (!getstrarg(args, &v))
+ return NULL;
+ a = makeactuator(getstringvalue(v));
+ if (a == NULL)
+ return NULL;
+ return newactuatorobject(a);
+}
+
+static object *
+module_dopanel(self, args)
+ object *self;
+ object *args;
+{
+ Actuator *a;
+ object *v, *w;
+ if (!getnoarg(args))
+ return NULL;
+ a = pnl_dopanel();
+ v = newtupleobject(4);
+ if (v == NULL)
+ return NULL;
+ settupleitem(v, 0, newactuatorobject(a));
+ settupleitem(v, 1, newactuatorobject(down_pend));
+ settupleitem(v, 2, newactuatorobject(active_pend));
+ settupleitem(v, 3, newactuatorobject(up_pend));
+ down_pend = active_pend = up_pend = NULL;
+ return v;
+}
+
+static object *
+module_drawpanel(self, args)
+ object *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ pnl_drawpanel();
+ INCREF(None);
+ return None;
+}
+
+static object *
+module_needredraw(self, args)
+ object *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ pnl_needredraw();
+ INCREF(None);
+ return None;
+}
+
+static object *
+module_userredraw(self, args)
+ object *self;
+ object *args;
+{
+ short wid;
+ if (!getnoarg(args))
+ return NULL;
+ wid = pnl_userredraw();
+ return newintobject((long)wid);
+}
+
+static object *
+module_block(self, args)
+ object *self;
+ object *args;
+{
+ int flag;
+ if (!getintarg(args, &flag))
+ return NULL;
+ pnl_block = flag;
+ INCREF(None);
+ return None;
+}
+
+static struct methodlist module_methods[] = {
+ {"block", module_block},
+ {"dopanel", module_dopanel},
+ {"drawpanel", module_drawpanel},
+ {"mkpanel", module_mkpanel},
+ {"mkact", module_mkact},
+ {"needredraw", module_needredraw},
+ {"userredraw", module_userredraw},
+ {NULL, NULL} /* sentinel */
+};
+
+void
+initpanel()
+{
+ /* Setting pnl_block to 1 would greatly reduce the CPU usage
+ of an idle application. Unfortunately it also breaks our
+ little hacks to get callback functions in Python called.
+ So we clear pnl_block here. You can set/clear pnl_block
+ from Python using pnl.block(flag). It works if you have
+ no upfuncs. */
+ pnl_block = 0;
+ initmodule("pnl", module_methods);
+}
diff --git a/src/parser.c b/src/parser.c
new file mode 100644
index 0000000..8ee7e2c
--- /dev/null
+++ b/src/parser.c
@@ -0,0 +1,423 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Parser implementation */
+
+/* For a description, see the comments at end of this file */
+
+/* XXX To do: error recovery */
+
+#include "pgenheaders.h"
+#include "assert.h"
+#include "token.h"
+#include "grammar.h"
+#include "node.h"
+#include "parser.h"
+#include "errcode.h"
+
+
+#ifdef DEBUG
+extern int debugging;
+#define D(x) if (!debugging); else x
+#else
+#define D(x)
+#endif
+
+
+/* STACK DATA TYPE */
+
+static void s_reset PROTO((stack *));
+
+static void
+s_reset(s)
+ stack *s;
+{
+ s->s_top = &s->s_base[MAXSTACK];
+}
+
+#define s_empty(s) ((s)->s_top == &(s)->s_base[MAXSTACK])
+
+static int s_push PROTO((stack *, dfa *, node *));
+
+static int
+s_push(s, d, parent)
+ register stack *s;
+ dfa *d;
+ node *parent;
+{
+ register stackentry *top;
+ if (s->s_top == s->s_base) {
+ fprintf(stderr, "s_push: parser stack overflow\n");
+ return -1;
+ }
+ top = --s->s_top;
+ top->s_dfa = d;
+ top->s_parent = parent;
+ top->s_state = 0;
+ return 0;
+}
+
+#ifdef DEBUG
+
+static void s_pop PROTO((stack *));
+
+static void
+s_pop(s)
+ register stack *s;
+{
+ if (s_empty(s)) {
+ fprintf(stderr, "s_pop: parser stack underflow -- FATAL\n");
+ abort();
+ }
+ s->s_top++;
+}
+
+#else /* !DEBUG */
+
+#define s_pop(s) (s)->s_top++
+
+#endif
+
+
+/* PARSER CREATION */
+
+parser_state *
+newparser(g, start)
+ grammar *g;
+ int start;
+{
+ parser_state *ps;
+
+ if (!g->g_accel)
+ addaccelerators(g);
+ ps = NEW(parser_state, 1);
+ if (ps == NULL)
+ return NULL;
+ ps->p_grammar = g;
+ ps->p_tree = newtree(start);
+ if (ps->p_tree == NULL) {
+ DEL(ps);
+ return NULL;
+ }
+ s_reset(&ps->p_stack);
+ (void) s_push(&ps->p_stack, finddfa(g, start), ps->p_tree);
+ return ps;
+}
+
+void
+delparser(ps)
+ parser_state *ps;
+{
+ /* NB If you want to save the parse tree,
+ you must set p_tree to NULL before calling delparser! */
+ freetree(ps->p_tree);
+ DEL(ps);
+}
+
+
+/* PARSER STACK OPERATIONS */
+
+static int shift PROTO((stack *, int, char *, int, int));
+
+static int
+shift(s, type, str, newstate, lineno)
+ register stack *s;
+ int type;
+ char *str;
+ int newstate;
+ int lineno;
+{
+ assert(!s_empty(s));
+ if (addchild(s->s_top->s_parent, type, str, lineno) == NULL) {
+ fprintf(stderr, "shift: no mem in addchild\n");
+ return -1;
+ }
+ s->s_top->s_state = newstate;
+ return 0;
+}
+
+static int push PROTO((stack *, int, dfa *, int, int));
+
+static int
+push(s, type, d, newstate, lineno)
+ register stack *s;
+ int type;
+ dfa *d;
+ int newstate;
+ int lineno;
+{
+ register node *n;
+ n = s->s_top->s_parent;
+ assert(!s_empty(s));
+ if (addchild(n, type, (char *)NULL, lineno) == NULL) {
+ fprintf(stderr, "push: no mem in addchild\n");
+ return -1;
+ }
+ s->s_top->s_state = newstate;
+ return s_push(s, d, CHILD(n, NCH(n)-1));
+}
+
+
+/* PARSER PROPER */
+
+static int classify PROTO((grammar *, int, char *));
+
+static int
+classify(g, type, str)
+ grammar *g;
+ register int type;
+ char *str;
+{
+ register int n = g->g_ll.ll_nlabels;
+
+ if (type == NAME) {
+ register char *s = str;
+ register label *l = g->g_ll.ll_label;
+ register int i;
+ for (i = n; i > 0; i--, l++) {
+ if (l->lb_type == NAME && l->lb_str != NULL &&
+ l->lb_str[0] == s[0] &&
+ strcmp(l->lb_str, s) == 0) {
+ D(printf("It's a keyword\n"));
+ return n - i;
+ }
+ }
+ }
+
+ {
+ register label *l = g->g_ll.ll_label;
+ register int i;
+ for (i = n; i > 0; i--, l++) {
+ if (l->lb_type == type && l->lb_str == NULL) {
+ D(printf("It's a token we know\n"));
+ return n - i;
+ }
+ }
+ }
+
+ D(printf("Illegal token\n"));
+ return -1;
+}
+
+int
+addtoken(ps, type, str, lineno)
+ register parser_state *ps;
+ register int type;
+ char *str;
+ int lineno;
+{
+ register int ilabel;
+
+ D(printf("Token %s/'%s' ... ", tok_name[type], str));
+
+ /* Find out which label this token is */
+ ilabel = classify(ps->p_grammar, type, str);
+ if (ilabel < 0)
+ return E_SYNTAX;
+
+ /* Loop until the token is shifted or an error occurred */
+ for (;;) {
+ /* Fetch the current dfa and state */
+ register dfa *d = ps->p_stack.s_top->s_dfa;
+ register state *s = &d->d_state[ps->p_stack.s_top->s_state];
+
+ D(printf(" DFA '%s', state %d:",
+ d->d_name, ps->p_stack.s_top->s_state));
+
+ /* Check accelerator */
+ if (s->s_lower <= ilabel && ilabel < s->s_upper) {
+ register int x = s->s_accel[ilabel - s->s_lower];
+ if (x != -1) {
+ if (x & (1<<7)) {
+ /* Push non-terminal */
+ int nt = (x >> 8) + NT_OFFSET;
+ int arrow = x & ((1<<7)-1);
+ dfa *d1 = finddfa(ps->p_grammar, nt);
+ if (push(&ps->p_stack, nt, d1,
+ arrow, lineno) < 0) {
+ D(printf(" MemError: push.\n"));
+ return E_NOMEM;
+ }
+ D(printf(" Push ...\n"));
+ continue;
+ }
+
+ /* Shift the token */
+ if (shift(&ps->p_stack, type, str,
+ x, lineno) < 0) {
+ D(printf(" MemError: shift.\n"));
+ return E_NOMEM;
+ }
+ D(printf(" Shift.\n"));
+ /* Pop while we are in an accept-only state */
+ while (s = &d->d_state
+ [ps->p_stack.s_top->s_state],
+ s->s_accept && s->s_narcs == 1) {
+ D(printf(" Direct pop.\n"));
+ s_pop(&ps->p_stack);
+ if (s_empty(&ps->p_stack)) {
+ D(printf(" ACCEPT.\n"));
+ return E_DONE;
+ }
+ d = ps->p_stack.s_top->s_dfa;
+ }
+ return E_OK;
+ }
+ }
+
+ if (s->s_accept) {
+ /* Pop this dfa and try again */
+ s_pop(&ps->p_stack);
+ D(printf(" Pop ...\n"));
+ if (s_empty(&ps->p_stack)) {
+ D(printf(" Error: bottom of stack.\n"));
+ return E_SYNTAX;
+ }
+ continue;
+ }
+
+ /* Stuck, report syntax error */
+ D(printf(" Error.\n"));
+ return E_SYNTAX;
+ }
+}
+
+
+#ifdef DEBUG
+
+/* DEBUG OUTPUT */
+
+void
+dumptree(g, n)
+ grammar *g;
+ node *n;
+{
+ int i;
+
+ if (n == NULL)
+ printf("NIL");
+ else {
+ label l;
+ l.lb_type = TYPE(n);
+ l.lb_str = TYPE(str);
+ printf("%s", labelrepr(&l));
+ if (ISNONTERMINAL(TYPE(n))) {
+ printf("(");
+ for (i = 0; i < NCH(n); i++) {
+ if (i > 0)
+ printf(",");
+ dumptree(g, CHILD(n, i));
+ }
+ printf(")");
+ }
+ }
+}
+
+void
+showtree(g, n)
+ grammar *g;
+ node *n;
+{
+ int i;
+
+ if (n == NULL)
+ return;
+ if (ISNONTERMINAL(TYPE(n))) {
+ for (i = 0; i < NCH(n); i++)
+ showtree(g, CHILD(n, i));
+ }
+ else if (ISTERMINAL(TYPE(n))) {
+ printf("%s", tok_name[TYPE(n)]);
+ if (TYPE(n) == NUMBER || TYPE(n) == NAME)
+ printf("(%s)", STR(n));
+ printf(" ");
+ }
+ else
+ printf("? ");
+}
+
+void
+printtree(ps)
+ parser_state *ps;
+{
+ if (debugging) {
+ printf("Parse tree:\n");
+ dumptree(ps->p_grammar, ps->p_tree);
+ printf("\n");
+ printf("Tokens:\n");
+ showtree(ps->p_grammar, ps->p_tree);
+ printf("\n");
+ }
+ printf("Listing:\n");
+ listtree(ps->p_tree);
+ printf("\n");
+}
+
+#endif /* DEBUG */
+
+/*
+
+Description
+-----------
+
+The parser's interface is different than usual: the function addtoken()
+must be called for each token in the input. This makes it possible to
+turn it into an incremental parsing system later. The parsing system
+constructs a parse tree as it goes.
+
+A parsing rule is represented as a Deterministic Finite-state Automaton
+(DFA). A node in a DFA represents a state of the parser; an arc represents
+a transition. Transitions are either labeled with terminal symbols or
+with non-terminals. When the parser decides to follow an arc labeled
+with a non-terminal, it is invoked recursively with the DFA representing
+the parsing rule for that as its initial state; when that DFA accepts,
+the parser that invoked it continues. The parse tree constructed by the
+recursively called parser is inserted as a child in the current parse tree.
+
+The DFA's can be constructed automatically from a more conventional
+language description. An extended LL(1) grammar (ELL(1)) is suitable.
+Certain restrictions make the parser's life easier: rules that can produce
+the empty string should be outlawed (there are other ways to put loops
+or optional parts in the language). To avoid the need to construct
+FIRST sets, we can require that all but the last alternative of a rule
+(really: arc going out of a DFA's state) must begin with a terminal
+symbol.
+
+As an example, consider this grammar:
+
+expr: term (OP term)*
+term: CONSTANT | '(' expr ')'
+
+The DFA corresponding to the rule for expr is:
+
+------->.---term-->.------->
+ ^ |
+ | |
+ \----OP----/
+
+The parse tree generated for the input a+b is:
+
+(expr: (term: (NAME: a)), (OP: +), (term: (NAME: b)))
+
+*/
diff --git a/src/parser.h b/src/parser.h
new file mode 100644
index 0000000..3e8090a
--- /dev/null
+++ b/src/parser.h
@@ -0,0 +1,50 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Parser interface */
+
+#define MAXSTACK 100
+
+typedef struct _stackentry {
+ int s_state; /* State in current DFA */
+ dfa *s_dfa; /* Current DFA */
+ struct _node *s_parent; /* Where to add next node */
+} stackentry;
+
+typedef struct _stack {
+ stackentry *s_top; /* Top entry */
+ stackentry s_base[MAXSTACK];/* Array of stack entries */
+ /* NB The stack grows down */
+} stack;
+
+typedef struct {
+ struct _stack p_stack; /* Stack of parser states */
+ struct _grammar *p_grammar; /* Grammar to use */
+ struct _node *p_tree; /* Top of parse tree */
+} parser_state;
+
+parser_state *newparser PROTO((struct _grammar *g, int start));
+void delparser PROTO((parser_state *ps));
+int addtoken PROTO((parser_state *ps, int type, char *str, int lineno));
+void addaccelerators PROTO((grammar *g));
diff --git a/src/parsetok.c b/src/parsetok.c
new file mode 100644
index 0000000..e19a979
--- /dev/null
+++ b/src/parsetok.c
@@ -0,0 +1,158 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Parser-tokenizer link implementation */
+
+#include "pgenheaders.h"
+#include "tokenizer.h"
+#include "node.h"
+#include "grammar.h"
+#include "parser.h"
+#include "parsetok.h"
+#include "errcode.h"
+
+
+/* Forward */
+static int parsetok PROTO((struct tok_state *, grammar *, int, node **));
+
+
+/* Parse input coming from a string. Return error code, print some errors. */
+
+int
+parsestring(s, g, start, n_ret)
+ char *s;
+ grammar *g;
+ int start;
+ node **n_ret;
+{
+ struct tok_state *tok = tok_setups(s);
+ int ret;
+
+ if (tok == NULL) {
+ fprintf(stderr, "no mem for tok_setups\n");
+ return E_NOMEM;
+ }
+ ret = parsetok(tok, g, start, n_ret);
+ if (ret == E_TOKEN || ret == E_SYNTAX) {
+ fprintf(stderr, "String parsing error at line %d\n",
+ tok->lineno);
+ }
+ tok_free(tok);
+ return ret;
+}
+
+
+/* Parse input coming from a file. Return error code, print some errors. */
+
+int
+parsefile(fp, filename, g, start, ps1, ps2, n_ret)
+ FILE *fp;
+ char *filename;
+ grammar *g;
+ int start;
+ char *ps1, *ps2;
+ node **n_ret;
+{
+ struct tok_state *tok = tok_setupf(fp, ps1, ps2);
+ int ret;
+
+ if (tok == NULL) {
+ fprintf(stderr, "no mem for tok_setupf\n");
+ return E_NOMEM;
+ }
+ ret = parsetok(tok, g, start, n_ret);
+ if (ret == E_TOKEN || ret == E_SYNTAX) {
+ char *p;
+ fprintf(stderr, "Parsing error: file %s, line %d:\n",
+ filename, tok->lineno);
+ *tok->inp = '\0';
+ if (tok->inp > tok->buf && tok->inp[-1] == '\n')
+ tok->inp[-1] = '\0';
+ fprintf(stderr, "%s\n", tok->buf);
+ for (p = tok->buf; p < tok->cur; p++) {
+ if (*p == '\t')
+ putc('\t', stderr);
+ else
+ putc(' ', stderr);
+ }
+ fprintf(stderr, "^\n");
+ }
+ tok_free(tok);
+ return ret;
+}
+
+
+/* Parse input coming from the given tokenizer structure.
+ Return error code. */
+
+static int
+parsetok(tok, g, start, n_ret)
+ struct tok_state *tok;
+ grammar *g;
+ int start;
+ node **n_ret;
+{
+ parser_state *ps;
+ int ret;
+
+ if ((ps = newparser(g, start)) == NULL) {
+ fprintf(stderr, "no mem for new parser\n");
+ return E_NOMEM;
+ }
+
+ for (;;) {
+ char *a, *b;
+ int type;
+ int len;
+ char *str;
+
+ type = tok_get(tok, &a, &b);
+ if (type == ERRORTOKEN) {
+ ret = tok->done;
+ break;
+ }
+ len = b - a;
+ str = NEW(char, len + 1);
+ if (str == NULL) {
+ fprintf(stderr, "no mem for next token\n");
+ ret = E_NOMEM;
+ break;
+ }
+ strncpy(str, a, len);
+ str[len] = '\0';
+ ret = addtoken(ps, (int)type, str, tok->lineno);
+ if (ret != E_OK) {
+ if (ret == E_DONE) {
+ *n_ret = ps->p_tree;
+ ps->p_tree = NULL;
+ }
+ else if (tok->lineno <= 1 && tok->done == E_EOF)
+ ret = E_EOF;
+ break;
+ }
+ }
+
+ delparser(ps);
+ return ret;
+}
diff --git a/src/parsetok.h b/src/parsetok.h
new file mode 100644
index 0000000..e05fdb5
--- /dev/null
+++ b/src/parsetok.h
@@ -0,0 +1,29 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Parser-tokenizer link interface */
+
+extern int parsestring PROTO((char *, grammar *, int start, node **n_ret));
+extern int parsefile PROTO((FILE *, char *, grammar *, int start,
+ char *ps1, char *ps2, node **n_ret));
diff --git a/src/patchlevel.h b/src/patchlevel.h
new file mode 100644
index 0000000..d00491f
--- /dev/null
+++ b/src/patchlevel.h
@@ -0,0 +1 @@
+1
diff --git a/src/pgen.c b/src/pgen.c
new file mode 100644
index 0000000..6d3ecaf
--- /dev/null
+++ b/src/pgen.c
@@ -0,0 +1,751 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Parser generator */
+/* XXX This file is not yet fully PROTOized */
+
+/* For a description, see the comments at end of this file */
+
+#include "pgenheaders.h"
+#include "assert.h"
+#include "token.h"
+#include "node.h"
+#include "grammar.h"
+#include "metagrammar.h"
+#include "pgen.h"
+
+extern int debugging;
+
+
+/* PART ONE -- CONSTRUCT NFA -- Cf. Algorithm 3.2 from [Aho&Ullman 77] */
+
+typedef struct _nfaarc {
+ int ar_label;
+ int ar_arrow;
+} nfaarc;
+
+typedef struct _nfastate {
+ int st_narcs;
+ nfaarc *st_arc;
+} nfastate;
+
+typedef struct _nfa {
+ int nf_type;
+ char *nf_name;
+ int nf_nstates;
+ nfastate *nf_state;
+ int nf_start, nf_finish;
+} nfa;
+
+static int
+addnfastate(nf)
+ nfa *nf;
+{
+ nfastate *st;
+
+ RESIZE(nf->nf_state, nfastate, nf->nf_nstates + 1);
+ if (nf->nf_state == NULL)
+ fatal("out of mem");
+ st = &nf->nf_state[nf->nf_nstates++];
+ st->st_narcs = 0;
+ st->st_arc = NULL;
+ return st - nf->nf_state;
+}
+
+static void
+addnfaarc(nf, from, to, lbl)
+ nfa *nf;
+ int from, to, lbl;
+{
+ nfastate *st;
+ nfaarc *ar;
+
+ st = &nf->nf_state[from];
+ RESIZE(st->st_arc, nfaarc, st->st_narcs + 1);
+ if (st->st_arc == NULL)
+ fatal("out of mem");
+ ar = &st->st_arc[st->st_narcs++];
+ ar->ar_label = lbl;
+ ar->ar_arrow = to;
+}
+
+static nfa *
+newnfa(name)
+ char *name;
+{
+ nfa *nf;
+ static type = NT_OFFSET; /* All types will be disjunct */
+
+ nf = NEW(nfa, 1);
+ if (nf == NULL)
+ fatal("no mem for new nfa");
+ nf->nf_type = type++;
+ nf->nf_name = name; /* XXX strdup(name) ??? */
+ nf->nf_nstates = 0;
+ nf->nf_state = NULL;
+ nf->nf_start = nf->nf_finish = -1;
+ return nf;
+}
+
+typedef struct _nfagrammar {
+ int gr_nnfas;
+ nfa **gr_nfa;
+ labellist gr_ll;
+} nfagrammar;
+
+static nfagrammar *
+newnfagrammar()
+{
+ nfagrammar *gr;
+
+ gr = NEW(nfagrammar, 1);
+ if (gr == NULL)
+ fatal("no mem for new nfa grammar");
+ gr->gr_nnfas = 0;
+ gr->gr_nfa = NULL;
+ gr->gr_ll.ll_nlabels = 0;
+ gr->gr_ll.ll_label = NULL;
+ addlabel(&gr->gr_ll, ENDMARKER, "EMPTY");
+ return gr;
+}
+
+static nfa *
+addnfa(gr, name)
+ nfagrammar *gr;
+ char *name;
+{
+ nfa *nf;
+
+ nf = newnfa(name);
+ RESIZE(gr->gr_nfa, nfa *, gr->gr_nnfas + 1);
+ if (gr->gr_nfa == NULL)
+ fatal("out of mem");
+ gr->gr_nfa[gr->gr_nnfas++] = nf;
+ addlabel(&gr->gr_ll, NAME, nf->nf_name);
+ return nf;
+}
+
+#ifdef DEBUG
+
+static char REQNFMT[] = "metacompile: less than %d children\n";
+
+#define REQN(i, count) \
+ if (i < count) { \
+ fprintf(stderr, REQNFMT, count); \
+ abort(); \
+ } else
+
+#else
+#define REQN(i, count) /* empty */
+#endif
+
+static nfagrammar *
+metacompile(n)
+ node *n;
+{
+ nfagrammar *gr;
+ int i;
+
+ printf("Compiling (meta-) parse tree into NFA grammar\n");
+ gr = newnfagrammar();
+ REQ(n, MSTART);
+ i = n->n_nchildren - 1; /* Last child is ENDMARKER */
+ n = n->n_child;
+ for (; --i >= 0; n++) {
+ if (n->n_type != NEWLINE)
+ compile_rule(gr, n);
+ }
+ return gr;
+}
+
+static
+compile_rule(gr, n)
+ nfagrammar *gr;
+ node *n;
+{
+ nfa *nf;
+
+ REQ(n, RULE);
+ REQN(n->n_nchildren, 4);
+ n = n->n_child;
+ REQ(n, NAME);
+ nf = addnfa(gr, n->n_str);
+ n++;
+ REQ(n, COLON);
+ n++;
+ REQ(n, RHS);
+ compile_rhs(&gr->gr_ll, nf, n, &nf->nf_start, &nf->nf_finish);
+ n++;
+ REQ(n, NEWLINE);
+}
+
+static
+compile_rhs(ll, nf, n, pa, pb)
+ labellist *ll;
+ nfa *nf;
+ node *n;
+ int *pa, *pb;
+{
+ int i;
+ int a, b;
+
+ REQ(n, RHS);
+ i = n->n_nchildren;
+ REQN(i, 1);
+ n = n->n_child;
+ REQ(n, ALT);
+ compile_alt(ll, nf, n, pa, pb);
+ if (--i <= 0)
+ return;
+ n++;
+ a = *pa;
+ b = *pb;
+ *pa = addnfastate(nf);
+ *pb = addnfastate(nf);
+ addnfaarc(nf, *pa, a, EMPTY);
+ addnfaarc(nf, b, *pb, EMPTY);
+ for (; --i >= 0; n++) {
+ REQ(n, VBAR);
+ REQN(i, 1);
+ --i;
+ n++;
+ REQ(n, ALT);
+ compile_alt(ll, nf, n, &a, &b);
+ addnfaarc(nf, *pa, a, EMPTY);
+ addnfaarc(nf, b, *pb, EMPTY);
+ }
+}
+
+static
+compile_alt(ll, nf, n, pa, pb)
+ labellist *ll;
+ nfa *nf;
+ node *n;
+ int *pa, *pb;
+{
+ int i;
+ int a, b;
+
+ REQ(n, ALT);
+ i = n->n_nchildren;
+ REQN(i, 1);
+ n = n->n_child;
+ REQ(n, ITEM);
+ compile_item(ll, nf, n, pa, pb);
+ --i;
+ n++;
+ for (; --i >= 0; n++) {
+ if (n->n_type == COMMA) { /* XXX Temporary */
+ REQN(i, 1);
+ --i;
+ n++;
+ }
+ REQ(n, ITEM);
+ compile_item(ll, nf, n, &a, &b);
+ addnfaarc(nf, *pb, a, EMPTY);
+ *pb = b;
+ }
+}
+
+static
+compile_item(ll, nf, n, pa, pb)
+ labellist *ll;
+ nfa *nf;
+ node *n;
+ int *pa, *pb;
+{
+ int i;
+ int a, b;
+
+ REQ(n, ITEM);
+ i = n->n_nchildren;
+ REQN(i, 1);
+ n = n->n_child;
+ if (n->n_type == LSQB) {
+ REQN(i, 3);
+ n++;
+ REQ(n, RHS);
+ *pa = addnfastate(nf);
+ *pb = addnfastate(nf);
+ addnfaarc(nf, *pa, *pb, EMPTY);
+ compile_rhs(ll, nf, n, &a, &b);
+ addnfaarc(nf, *pa, a, EMPTY);
+ addnfaarc(nf, b, *pb, EMPTY);
+ REQN(i, 1);
+ n++;
+ REQ(n, RSQB);
+ }
+ else {
+ compile_atom(ll, nf, n, pa, pb);
+ if (--i <= 0)
+ return;
+ n++;
+ addnfaarc(nf, *pb, *pa, EMPTY);
+ if (n->n_type == STAR)
+ *pb = *pa;
+ else
+ REQ(n, PLUS);
+ }
+}
+
+static
+compile_atom(ll, nf, n, pa, pb)
+ labellist *ll;
+ nfa *nf;
+ node *n;
+ int *pa, *pb;
+{
+ int i;
+
+ REQ(n, ATOM);
+ i = n->n_nchildren;
+ REQN(i, 1);
+ n = n->n_child;
+ if (n->n_type == LPAR) {
+ REQN(i, 3);
+ n++;
+ REQ(n, RHS);
+ compile_rhs(ll, nf, n, pa, pb);
+ n++;
+ REQ(n, RPAR);
+ }
+ else if (n->n_type == NAME || n->n_type == STRING) {
+ *pa = addnfastate(nf);
+ *pb = addnfastate(nf);
+ addnfaarc(nf, *pa, *pb, addlabel(ll, n->n_type, n->n_str));
+ }
+ else
+ REQ(n, NAME);
+}
+
+static void
+dumpstate(ll, nf, istate)
+ labellist *ll;
+ nfa *nf;
+ int istate;
+{
+ nfastate *st;
+ int i;
+ nfaarc *ar;
+
+ printf("%c%2d%c",
+ istate == nf->nf_start ? '*' : ' ',
+ istate,
+ istate == nf->nf_finish ? '.' : ' ');
+ st = &nf->nf_state[istate];
+ ar = st->st_arc;
+ for (i = 0; i < st->st_narcs; i++) {
+ if (i > 0)
+ printf("\n ");
+ printf("-> %2d %s", ar->ar_arrow,
+ labelrepr(&ll->ll_label[ar->ar_label]));
+ ar++;
+ }
+ printf("\n");
+}
+
+static void
+dumpnfa(ll, nf)
+ labellist *ll;
+ nfa *nf;
+{
+ int i;
+
+ printf("NFA '%s' has %d states; start %d, finish %d\n",
+ nf->nf_name, nf->nf_nstates, nf->nf_start, nf->nf_finish);
+ for (i = 0; i < nf->nf_nstates; i++)
+ dumpstate(ll, nf, i);
+}
+
+
+/* PART TWO -- CONSTRUCT DFA -- Algorithm 3.1 from [Aho&Ullman 77] */
+
+static int
+addclosure(ss, nf, istate)
+ bitset ss;
+ nfa *nf;
+ int istate;
+{
+ if (addbit(ss, istate)) {
+ nfastate *st = &nf->nf_state[istate];
+ nfaarc *ar = st->st_arc;
+ int i;
+
+ for (i = st->st_narcs; --i >= 0; ) {
+ if (ar->ar_label == EMPTY)
+ addclosure(ss, nf, ar->ar_arrow);
+ ar++;
+ }
+ }
+}
+
+typedef struct _ss_arc {
+ bitset sa_bitset;
+ int sa_arrow;
+ int sa_label;
+} ss_arc;
+
+typedef struct _ss_state {
+ bitset ss_ss;
+ int ss_narcs;
+ ss_arc *ss_arc;
+ int ss_deleted;
+ int ss_finish;
+ int ss_rename;
+} ss_state;
+
+typedef struct _ss_dfa {
+ int sd_nstates;
+ ss_state *sd_state;
+} ss_dfa;
+
+static
+makedfa(gr, nf, d)
+ nfagrammar *gr;
+ nfa *nf;
+ dfa *d;
+{
+ int nbits = nf->nf_nstates;
+ bitset ss;
+ int xx_nstates;
+ ss_state *xx_state, *yy;
+ ss_arc *zz;
+ int istate, jstate, iarc, jarc, ibit;
+ nfastate *st;
+ nfaarc *ar;
+
+ ss = newbitset(nbits);
+ addclosure(ss, nf, nf->nf_start);
+ xx_state = NEW(ss_state, 1);
+ if (xx_state == NULL)
+ fatal("no mem for xx_state in makedfa");
+ xx_nstates = 1;
+ yy = &xx_state[0];
+ yy->ss_ss = ss;
+ yy->ss_narcs = 0;
+ yy->ss_arc = NULL;
+ yy->ss_deleted = 0;
+ yy->ss_finish = testbit(ss, nf->nf_finish);
+ if (yy->ss_finish)
+ printf("Error: nonterminal '%s' may produce empty.\n",
+ nf->nf_name);
+
+ /* This algorithm is from a book written before
+ the invention of structured programming... */
+
+ /* For each unmarked state... */
+ for (istate = 0; istate < xx_nstates; ++istate) {
+ yy = &xx_state[istate];
+ ss = yy->ss_ss;
+ /* For all its states... */
+ for (ibit = 0; ibit < nf->nf_nstates; ++ibit) {
+ if (!testbit(ss, ibit))
+ continue;
+ st = &nf->nf_state[ibit];
+ /* For all non-empty arcs from this state... */
+ for (iarc = 0; iarc < st->st_narcs; iarc++) {
+ ar = &st->st_arc[iarc];
+ if (ar->ar_label == EMPTY)
+ continue;
+ /* Look up in list of arcs from this state */
+ for (jarc = 0; jarc < yy->ss_narcs; ++jarc) {
+ zz = &yy->ss_arc[jarc];
+ if (ar->ar_label == zz->sa_label)
+ goto found;
+ }
+ /* Add new arc for this state */
+ RESIZE(yy->ss_arc, ss_arc, yy->ss_narcs + 1);
+ if (yy->ss_arc == NULL)
+ fatal("out of mem");
+ zz = &yy->ss_arc[yy->ss_narcs++];
+ zz->sa_label = ar->ar_label;
+ zz->sa_bitset = newbitset(nbits);
+ zz->sa_arrow = -1;
+ found: ;
+ /* Add destination */
+ addclosure(zz->sa_bitset, nf, ar->ar_arrow);
+ }
+ }
+ /* Now look up all the arrow states */
+ for (jarc = 0; jarc < xx_state[istate].ss_narcs; jarc++) {
+ zz = &xx_state[istate].ss_arc[jarc];
+ for (jstate = 0; jstate < xx_nstates; jstate++) {
+ if (samebitset(zz->sa_bitset,
+ xx_state[jstate].ss_ss, nbits)) {
+ zz->sa_arrow = jstate;
+ goto done;
+ }
+ }
+ RESIZE(xx_state, ss_state, xx_nstates + 1);
+ if (xx_state == NULL)
+ fatal("out of mem");
+ zz->sa_arrow = xx_nstates;
+ yy = &xx_state[xx_nstates++];
+ yy->ss_ss = zz->sa_bitset;
+ yy->ss_narcs = 0;
+ yy->ss_arc = NULL;
+ yy->ss_deleted = 0;
+ yy->ss_finish = testbit(yy->ss_ss, nf->nf_finish);
+ done: ;
+ }
+ }
+
+ if (debugging)
+ printssdfa(xx_nstates, xx_state, nbits, &gr->gr_ll,
+ "before minimizing");
+
+ simplify(xx_nstates, xx_state);
+
+ if (debugging)
+ printssdfa(xx_nstates, xx_state, nbits, &gr->gr_ll,
+ "after minimizing");
+
+ convert(d, xx_nstates, xx_state);
+
+ /* XXX cleanup */
+}
+
+static
+printssdfa(xx_nstates, xx_state, nbits, ll, msg)
+ int xx_nstates;
+ ss_state *xx_state;
+ int nbits;
+ labellist *ll;
+ char *msg;
+{
+ int i, ibit, iarc;
+ ss_state *yy;
+ ss_arc *zz;
+
+ printf("Subset DFA %s\n", msg);
+ for (i = 0; i < xx_nstates; i++) {
+ yy = &xx_state[i];
+ if (yy->ss_deleted)
+ continue;
+ printf(" Subset %d", i);
+ if (yy->ss_finish)
+ printf(" (finish)");
+ printf(" { ");
+ for (ibit = 0; ibit < nbits; ibit++) {
+ if (testbit(yy->ss_ss, ibit))
+ printf("%d ", ibit);
+ }
+ printf("}\n");
+ for (iarc = 0; iarc < yy->ss_narcs; iarc++) {
+ zz = &yy->ss_arc[iarc];
+ printf(" Arc to state %d, label %s\n",
+ zz->sa_arrow,
+ labelrepr(&ll->ll_label[zz->sa_label]));
+ }
+ }
+}
+
+
+/* PART THREE -- SIMPLIFY DFA */
+
+/* Simplify the DFA by repeatedly eliminating states that are
+ equivalent to another oner. This is NOT Algorithm 3.3 from
+ [Aho&Ullman 77]. It does not always finds the minimal DFA,
+ but it does usually make a much smaller one... (For an example
+ of sub-optimal behaviour, try S: x a b+ | y a b+.)
+*/
+
+static int
+samestate(s1, s2)
+ ss_state *s1, *s2;
+{
+ int i;
+
+ if (s1->ss_narcs != s2->ss_narcs || s1->ss_finish != s2->ss_finish)
+ return 0;
+ for (i = 0; i < s1->ss_narcs; i++) {
+ if (s1->ss_arc[i].sa_arrow != s2->ss_arc[i].sa_arrow ||
+ s1->ss_arc[i].sa_label != s2->ss_arc[i].sa_label)
+ return 0;
+ }
+ return 1;
+}
+
+static void
+renamestates(xx_nstates, xx_state, from, to)
+ int xx_nstates;
+ ss_state *xx_state;
+ int from, to;
+{
+ int i, j;
+
+ if (debugging)
+ printf("Rename state %d to %d.\n", from, to);
+ for (i = 0; i < xx_nstates; i++) {
+ if (xx_state[i].ss_deleted)
+ continue;
+ for (j = 0; j < xx_state[i].ss_narcs; j++) {
+ if (xx_state[i].ss_arc[j].sa_arrow == from)
+ xx_state[i].ss_arc[j].sa_arrow = to;
+ }
+ }
+}
+
+static
+simplify(xx_nstates, xx_state)
+ int xx_nstates;
+ ss_state *xx_state;
+{
+ int changes;
+ int i, j, k;
+
+ do {
+ changes = 0;
+ for (i = 1; i < xx_nstates; i++) {
+ if (xx_state[i].ss_deleted)
+ continue;
+ for (j = 0; j < i; j++) {
+ if (xx_state[j].ss_deleted)
+ continue;
+ if (samestate(&xx_state[i], &xx_state[j])) {
+ xx_state[i].ss_deleted++;
+ renamestates(xx_nstates, xx_state, i, j);
+ changes++;
+ break;
+ }
+ }
+ }
+ } while (changes);
+}
+
+
+/* PART FOUR -- GENERATE PARSING TABLES */
+
+/* Convert the DFA into a grammar that can be used by our parser */
+
+static
+convert(d, xx_nstates, xx_state)
+ dfa *d;
+ int xx_nstates;
+ ss_state *xx_state;
+{
+ int i, j;
+ ss_state *yy;
+ ss_arc *zz;
+
+ for (i = 0; i < xx_nstates; i++) {
+ yy = &xx_state[i];
+ if (yy->ss_deleted)
+ continue;
+ yy->ss_rename = addstate(d);
+ }
+
+ for (i = 0; i < xx_nstates; i++) {
+ yy = &xx_state[i];
+ if (yy->ss_deleted)
+ continue;
+ for (j = 0; j < yy->ss_narcs; j++) {
+ zz = &yy->ss_arc[j];
+ addarc(d, yy->ss_rename,
+ xx_state[zz->sa_arrow].ss_rename,
+ zz->sa_label);
+ }
+ if (yy->ss_finish)
+ addarc(d, yy->ss_rename, yy->ss_rename, 0);
+ }
+
+ d->d_initial = 0;
+}
+
+
+/* PART FIVE -- GLUE IT ALL TOGETHER */
+
+static grammar *
+maketables(gr)
+ nfagrammar *gr;
+{
+ int i;
+ nfa *nf;
+ dfa *d;
+ grammar *g;
+
+ if (gr->gr_nnfas == 0)
+ return NULL;
+ g = newgrammar(gr->gr_nfa[0]->nf_type);
+ /* XXX first rule must be start rule */
+ g->g_ll = gr->gr_ll;
+
+ for (i = 0; i < gr->gr_nnfas; i++) {
+ nf = gr->gr_nfa[i];
+ if (debugging) {
+ printf("Dump of NFA for '%s' ...\n", nf->nf_name);
+ dumpnfa(&gr->gr_ll, nf);
+ }
+ printf("Making DFA for '%s' ...\n", nf->nf_name);
+ d = adddfa(g, nf->nf_type, nf->nf_name);
+ makedfa(gr, gr->gr_nfa[i], d);
+ }
+
+ return g;
+}
+
+grammar *
+pgen(n)
+ node *n;
+{
+ nfagrammar *gr;
+ grammar *g;
+
+ gr = metacompile(n);
+ g = maketables(gr);
+ translatelabels(g);
+ addfirstsets(g);
+ return g;
+}
+
+
+/*
+
+Description
+-----------
+
+Input is a grammar in extended BNF (using * for repetition, + for
+at-least-once repetition, [] for optional parts, | for alternatives and
+() for grouping). This has already been parsed and turned into a parse
+tree.
+
+Each rule is considered as a regular expression in its own right.
+It is turned into a Non-deterministic Finite Automaton (NFA), which
+is then turned into a Deterministic Finite Automaton (DFA), which is then
+optimized to reduce the number of states. See [Aho&Ullman 77] chapter 3,
+or similar compiler books (this technique is more often used for lexical
+analyzers).
+
+The DFA's are used by the parser as parsing tables in a special way
+that's probably unique. Before they are usable, the FIRST sets of all
+non-terminals are computed.
+
+Reference
+---------
+
+[Aho&Ullman 77]
+ Aho&Ullman, Principles of Compiler Design, Addison-Wesley 1977
+ (first edition)
+
+*/
diff --git a/src/pgen.h b/src/pgen.h
new file mode 100644
index 0000000..940bf9a
--- /dev/null
+++ b/src/pgen.h
@@ -0,0 +1,30 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Parser generator interface */
+
+extern grammar gram;
+
+extern grammar *meta_grammar PROTO((void));
+extern grammar *pgen PROTO((struct _node *));
diff --git a/src/pgenheaders.h b/src/pgenheaders.h
new file mode 100644
index 0000000..059915a
--- /dev/null
+++ b/src/pgenheaders.h
@@ -0,0 +1,50 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Include files and extern declarations used by most of the parser.
+ This is a precompiled header for THINK C. */
+
+#include <stdio.h>
+#include <string.h>
+
+#ifdef THINK_C
+/* #define THINK_C_3_0 /*** TURN THIS ON FOR THINK C 3.0 ****/
+#define label label_
+#undef label
+#endif
+
+#ifdef THINK_C_3_0
+#include <proto.h>
+#endif
+
+#ifdef THINK_C
+#ifndef THINK_C_3_0
+#include <stdlib.h>
+#endif
+#endif
+
+#include "PROTO.h"
+#include "malloc.h"
+
+extern void fatal PROTO((char *));
diff --git a/src/pgenmain.c b/src/pgenmain.c
new file mode 100644
index 0000000..80f6f2d
--- /dev/null
+++ b/src/pgenmain.c
@@ -0,0 +1,148 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Parser generator main program */
+
+/* This expects a filename containing the grammar as argv[1] (UNIX)
+ or asks the console for such a file name (THINK C).
+ It writes its output on two files in the current directory:
+ - "graminit.c" gets the grammar as a bunch of initialized data
+ - "graminit.h" gets the grammar's non-terminals as #defines.
+ Error messages and status info during the generation process are
+ written to stdout, or sometimes to stderr. */
+
+#include "pgenheaders.h"
+#include "grammar.h"
+#include "node.h"
+#include "parsetok.h"
+#include "pgen.h"
+
+int debugging;
+
+/* Forward */
+grammar *getgrammar PROTO((char *filename));
+#ifdef THINK_C
+int main PROTO((int, char **));
+char *askfile PROTO((void));
+#endif
+
+int
+main(argc, argv)
+ int argc;
+ char **argv;
+{
+ grammar *g;
+ node *n;
+ FILE *fp;
+ char *filename;
+
+#ifdef THINK_C
+ filename = askfile();
+#else
+ if (argc != 2) {
+ fprintf(stderr, "usage: %s grammar\n", argv[0]);
+ exit(2);
+ }
+ filename = argv[1];
+#endif
+ g = getgrammar(filename);
+ fp = fopen("graminit.c", "w");
+ if (fp == NULL) {
+ perror("graminit.c");
+ exit(1);
+ }
+ printf("Writing graminit.c ...\n");
+ printgrammar(g, fp);
+ fclose(fp);
+ fp = fopen("graminit.h", "w");
+ if (fp == NULL) {
+ perror("graminit.h");
+ exit(1);
+ }
+ printf("Writing graminit.h ...\n");
+ printnonterminals(g, fp);
+ fclose(fp);
+ exit(0);
+}
+
+grammar *
+getgrammar(filename)
+ char *filename;
+{
+ FILE *fp;
+ node *n;
+ grammar *g0, *g;
+
+ fp = fopen(filename, "r");
+ if (fp == NULL) {
+ perror(filename);
+ exit(1);
+ }
+ g0 = meta_grammar();
+ n = NULL;
+ parsefile(fp, filename, g0, g0->g_start, (char *)NULL, (char *)NULL, &n);
+ fclose(fp);
+ if (n == NULL) {
+ fprintf(stderr, "Parsing error.\n");
+ exit(1);
+ }
+ g = pgen(n);
+ if (g == NULL) {
+ printf("Bad grammar.\n");
+ exit(1);
+ }
+ return g;
+}
+
+#ifdef THINK_C
+char *
+askfile()
+{
+ char buf[256];
+ static char name[256];
+ printf("Input file name: ");
+ if (fgets(buf, sizeof buf, stdin) == NULL) {
+ printf("EOF\n");
+ exit(1);
+ }
+ /* XXX The (unsigned char *) case is needed by THINK C 3.0 */
+ if (sscanf(/*(unsigned char *)*/buf, " %s ", name) != 1) {
+ printf("No file\n");
+ exit(1);
+ }
+ return name;
+}
+#endif
+
+void
+fatal(msg)
+ char *msg;
+{
+ fprintf(stderr, "pgen: FATAL ERROR: %s\n", msg);
+ exit(1);
+}
+
+/* XXX TO DO:
+ - check for duplicate definitions of names (instead of fatal err)
+*/
diff --git a/src/posixmodule.c b/src/posixmodule.c
new file mode 100644
index 0000000..9729376
--- /dev/null
+++ b/src/posixmodule.c
@@ -0,0 +1,427 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* POSIX module implementation */
+
+#include <signal.h>
+#include <string.h>
+#include <setjmp.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <sys/time.h>
+#ifdef SYSV
+#include <dirent.h>
+#define direct dirent
+#else
+#include <sys/dir.h>
+#endif
+
+#include "allobjects.h"
+#include "modsupport.h"
+
+extern char *strerror PROTO((int));
+
+#ifdef AMOEBA
+#define NO_LSTAT
+#endif
+
+
+/* Return a dictionary corresponding to the POSIX environment table */
+
+extern char **environ;
+
+static object *
+convertenviron()
+{
+ object *d;
+ char **e;
+ d = newdictobject();
+ if (d == NULL)
+ return NULL;
+ if (environ == NULL)
+ return d;
+ /* XXX This part ignores errors */
+ for (e = environ; *e != NULL; e++) {
+ object *v;
+ char *p = strchr(*e, '=');
+ if (p == NULL)
+ continue;
+ v = newstringobject(p+1);
+ if (v == NULL)
+ continue;
+ *p = '\0';
+ (void) dictinsert(d, *e, v);
+ *p = '=';
+ DECREF(v);
+ }
+ return d;
+}
+
+
+static object *PosixError; /* Exception posix.error */
+
+/* Set a POSIX-specific error from errno, and return NULL */
+
+static object *
+posix_error()
+{
+ return err_errno(PosixError);
+}
+
+
+/* POSIX generic methods */
+
+static object *
+posix_1str(args, func)
+ object *args;
+ int (*func) FPROTO((const char *));
+{
+ object *path1;
+ if (!getstrarg(args, &path1))
+ return NULL;
+ if ((*func)(getstringvalue(path1)) < 0)
+ return posix_error();
+ INCREF(None);
+ return None;
+}
+
+static object *
+posix_2str(args, func)
+ object *args;
+ int (*func) FPROTO((const char *, const char *));
+{
+ object *path1, *path2;
+ if (!getstrstrarg(args, &path1, &path2))
+ return NULL;
+ if ((*func)(getstringvalue(path1), getstringvalue(path2)) < 0)
+ return posix_error();
+ INCREF(None);
+ return None;
+}
+
+static object *
+posix_strint(args, func)
+ object *args;
+ int (*func) FPROTO((const char *, int));
+{
+ object *path1;
+ int i;
+ if (!getstrintarg(args, &path1, &i))
+ return NULL;
+ if ((*func)(getstringvalue(path1), i) < 0)
+ return posix_error();
+ INCREF(None);
+ return None;
+}
+
+static object *
+posix_do_stat(self, args, statfunc)
+ object *self;
+ object *args;
+ int (*statfunc) FPROTO((const char *, struct stat *));
+{
+ struct stat st;
+ object *path;
+ object *v;
+ if (!getstrarg(args, &path))
+ return NULL;
+ if ((*statfunc)(getstringvalue(path), &st) != 0)
+ return posix_error();
+ v = newtupleobject(10);
+ if (v == NULL)
+ return NULL;
+#define SET(i, st_member) settupleitem(v, i, newintobject((long)st.st_member))
+ SET(0, st_mode);
+ SET(1, st_ino);
+ SET(2, st_dev);
+ SET(3, st_nlink);
+ SET(4, st_uid);
+ SET(5, st_gid);
+ SET(6, st_size);
+ SET(7, st_atime);
+ SET(8, st_mtime);
+ SET(9, st_ctime);
+#undef SET
+ if (err_occurred()) {
+ DECREF(v);
+ return NULL;
+ }
+ return v;
+}
+
+
+/* POSIX methods */
+
+static object *
+posix_chdir(self, args)
+ object *self;
+ object *args;
+{
+ extern int chdir PROTO((const char *));
+ return posix_1str(args, chdir);
+}
+
+static object *
+posix_chmod(self, args)
+ object *self;
+ object *args;
+{
+ extern int chmod PROTO((const char *, mode_t));
+ return posix_strint(args, chmod);
+}
+
+static object *
+posix_getcwd(self, args)
+ object *self;
+ object *args;
+{
+ char buf[1026];
+ extern char *getcwd PROTO((char *, int));
+ if (!getnoarg(args))
+ return NULL;
+ if (getcwd(buf, sizeof buf) == NULL)
+ return posix_error();
+ return newstringobject(buf);
+}
+
+static object *
+posix_link(self, args)
+ object *self;
+ object *args;
+{
+ extern int link PROTO((const char *, const char *));
+ return posix_2str(args, link);
+}
+
+static object *
+posix_listdir(self, args)
+ object *self;
+ object *args;
+{
+ object *name, *d, *v;
+ DIR *dirp;
+ struct direct *ep;
+ if (!getstrarg(args, &name))
+ return NULL;
+ if ((dirp = opendir(getstringvalue(name))) == NULL)
+ return posix_error();
+ if ((d = newlistobject(0)) == NULL) {
+ closedir(dirp);
+ return NULL;
+ }
+ while ((ep = readdir(dirp)) != NULL) {
+ v = newstringobject(ep->d_name);
+ if (v == NULL) {
+ DECREF(d);
+ d = NULL;
+ break;
+ }
+ if (addlistitem(d, v) != 0) {
+ DECREF(v);
+ DECREF(d);
+ d = NULL;
+ break;
+ }
+ DECREF(v);
+ }
+ closedir(dirp);
+ return d;
+}
+
+static object *
+posix_mkdir(self, args)
+ object *self;
+ object *args;
+{
+ extern int mkdir PROTO((const char *, mode_t));
+ return posix_strint(args, mkdir);
+}
+
+static object *
+posix_rename(self, args)
+ object *self;
+ object *args;
+{
+ extern int rename PROTO((const char *, const char *));
+ return posix_2str(args, rename);
+}
+
+static object *
+posix_rmdir(self, args)
+ object *self;
+ object *args;
+{
+ extern int rmdir PROTO((const char *));
+ return posix_1str(args, rmdir);
+}
+
+static object *
+posix_stat(self, args)
+ object *self;
+ object *args;
+{
+ extern int stat PROTO((const char *, struct stat *));
+ return posix_do_stat(self, args, stat);
+}
+
+static object *
+posix_system(self, args)
+ object *self;
+ object *args;
+{
+ object *command;
+ int sts;
+ if (!getstrarg(args, &command))
+ return NULL;
+ sts = system(getstringvalue(command));
+ return newintobject((long)sts);
+}
+
+static object *
+posix_umask(self, args)
+ object *self;
+ object *args;
+{
+ int i;
+ if (!getintarg(args, &i))
+ return NULL;
+ i = umask(i);
+ if (i < 0)
+ return posix_error();
+ return newintobject((long)i);
+}
+
+static object *
+posix_unlink(self, args)
+ object *self;
+ object *args;
+{
+ extern int unlink PROTO((const char *));
+ return posix_1str(args, unlink);
+}
+
+static object *
+posix_utimes(self, args)
+ object *self;
+ object *args;
+{
+ object *path;
+ struct timeval tv[2];
+ if (args == NULL || !is_tupleobject(args) || gettuplesize(args) != 2) {
+ err_badarg();
+ return NULL;
+ }
+ if (!getstrarg(gettupleitem(args, 0), &path) ||
+ !getlonglongargs(gettupleitem(args, 1),
+ &tv[0].tv_sec, &tv[1].tv_sec))
+ return NULL;
+ tv[0].tv_usec = tv[1].tv_usec = 0;
+ if (utimes(getstringvalue(path), tv) < 0)
+ return posix_error();
+ INCREF(None);
+ return None;
+}
+
+
+#ifndef NO_LSTAT
+
+static object *
+posix_lstat(self, args)
+ object *self;
+ object *args;
+{
+ extern int lstat PROTO((const char *, struct stat *));
+ return posix_do_stat(self, args, lstat);
+}
+
+static object *
+posix_readlink(self, args)
+ object *self;
+ object *args;
+{
+ char buf[1024]; /* XXX Should use MAXPATHLEN */
+ object *path;
+ int n;
+ if (!getstrarg(args, &path))
+ return NULL;
+ n = readlink(getstringvalue(path), buf, sizeof buf);
+ if (n < 0)
+ return posix_error();
+ return newsizedstringobject(buf, n);
+}
+
+static object *
+posix_symlink(self, args)
+ object *self;
+ object *args;
+{
+ extern int symlink PROTO((const char *, const char *));
+ return posix_2str(args, symlink);
+}
+
+#endif /* NO_LSTAT */
+
+
+static struct methodlist posix_methods[] = {
+ {"chdir", posix_chdir},
+ {"chmod", posix_chmod},
+ {"getcwd", posix_getcwd},
+ {"link", posix_link},
+ {"listdir", posix_listdir},
+ {"mkdir", posix_mkdir},
+ {"rename", posix_rename},
+ {"rmdir", posix_rmdir},
+ {"stat", posix_stat},
+ {"system", posix_system},
+ {"umask", posix_umask},
+ {"unlink", posix_unlink},
+ {"utimes", posix_utimes},
+#ifndef NO_LSTAT
+ {"lstat", posix_lstat},
+ {"readlink", posix_readlink},
+ {"symlink", posix_symlink},
+#endif
+ {NULL, NULL} /* Sentinel */
+};
+
+
+void
+initposix()
+{
+ object *m, *d, *v;
+
+ m = initmodule("posix", posix_methods);
+ d = getmoduledict(m);
+
+ /* Initialize posix.environ dictionary */
+ v = convertenviron();
+ if (v == NULL || dictinsert(d, "environ", v) != 0)
+ fatal("can't define posix.environ");
+ DECREF(v);
+
+ /* Initialize posix.error exception */
+ PosixError = newstringobject("posix.error");
+ if (PosixError == NULL || dictinsert(d, "error", PosixError) != 0)
+ fatal("can't define posix.error");
+}
diff --git a/src/printgrammar.c b/src/printgrammar.c
new file mode 100644
index 0000000..c48262d
--- /dev/null
+++ b/src/printgrammar.c
@@ -0,0 +1,149 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Print a bunch of C initializers that represent a grammar */
+
+#include "pgenheaders.h"
+#include "grammar.h"
+
+/* Forward */
+static void printarcs PROTO((int, dfa *, FILE *));
+static void printstates PROTO((grammar *, FILE *));
+static void printdfas PROTO((grammar *, FILE *));
+static void printlabels PROTO((grammar *, FILE *));
+
+void
+printgrammar(g, fp)
+ grammar *g;
+ FILE *fp;
+{
+ fprintf(fp, "#include \"pgenheaders.h\"\n");
+ fprintf(fp, "#include \"grammar.h\"\n");
+ printdfas(g, fp);
+ printlabels(g, fp);
+ fprintf(fp, "grammar gram = {\n");
+ fprintf(fp, "\t%d,\n", g->g_ndfas);
+ fprintf(fp, "\tdfas,\n");
+ fprintf(fp, "\t{%d, labels},\n", g->g_ll.ll_nlabels);
+ fprintf(fp, "\t%d\n", g->g_start);
+ fprintf(fp, "};\n");
+}
+
+void
+printnonterminals(g, fp)
+ grammar *g;
+ FILE *fp;
+{
+ dfa *d;
+ int i;
+
+ d = g->g_dfa;
+ for (i = g->g_ndfas; --i >= 0; d++)
+ fprintf(fp, "#define %s %d\n", d->d_name, d->d_type);
+}
+
+static void
+printarcs(i, d, fp)
+ int i;
+ dfa *d;
+ FILE *fp;
+{
+ arc *a;
+ state *s;
+ int j, k;
+
+ s = d->d_state;
+ for (j = 0; j < d->d_nstates; j++, s++) {
+ fprintf(fp, "static arc arcs_%d_%d[%d] = {\n",
+ i, j, s->s_narcs);
+ a = s->s_arc;
+ for (k = 0; k < s->s_narcs; k++, a++)
+ fprintf(fp, "\t{%d, %d},\n", a->a_lbl, a->a_arrow);
+ fprintf(fp, "};\n");
+ }
+}
+
+static void
+printstates(g, fp)
+ grammar *g;
+ FILE *fp;
+{
+ state *s;
+ dfa *d;
+ int i, j;
+
+ d = g->g_dfa;
+ for (i = 0; i < g->g_ndfas; i++, d++) {
+ printarcs(i, d, fp);
+ fprintf(fp, "static state states_%d[%d] = {\n",
+ i, d->d_nstates);
+ s = d->d_state;
+ for (j = 0; j < d->d_nstates; j++, s++)
+ fprintf(fp, "\t{%d, arcs_%d_%d},\n",
+ s->s_narcs, i, j);
+ fprintf(fp, "};\n");
+ }
+}
+
+static void
+printdfas(g, fp)
+ grammar *g;
+ FILE *fp;
+{
+ dfa *d;
+ int i, j;
+
+ printstates(g, fp);
+ fprintf(fp, "static dfa dfas[%d] = {\n", g->g_ndfas);
+ d = g->g_dfa;
+ for (i = 0; i < g->g_ndfas; i++, d++) {
+ fprintf(fp, "\t{%d, \"%s\", %d, %d, states_%d,\n",
+ d->d_type, d->d_name, d->d_initial, d->d_nstates, i);
+ fprintf(fp, "\t \"");
+ for (j = 0; j < NBYTES(g->g_ll.ll_nlabels); j++)
+ fprintf(fp, "\\%03o", d->d_first[j] & 0xff);
+ fprintf(fp, "\"},\n");
+ }
+ fprintf(fp, "};\n");
+}
+
+static void
+printlabels(g, fp)
+ grammar *g;
+ FILE *fp;
+{
+ label *l;
+ int i;
+
+ fprintf(fp, "static label labels[%d] = {\n", g->g_ll.ll_nlabels);
+ l = g->g_ll.ll_label;
+ for (i = g->g_ll.ll_nlabels; --i >= 0; l++) {
+ if (l->lb_str == NULL)
+ fprintf(fp, "\t{%d, 0},\n", l->lb_type);
+ else
+ fprintf(fp, "\t{%d, \"%s\"},\n",
+ l->lb_type, l->lb_str);
+ }
+ fprintf(fp, "};\n");
+}
diff --git a/src/profmain.c b/src/profmain.c
new file mode 100644
index 0000000..eff57bf
--- /dev/null
+++ b/src/profmain.c
@@ -0,0 +1,133 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+#include <stdio.h>
+#include "string.h"
+
+#include "PROTO.h"
+#include "grammar.h"
+#include "node.h"
+#include "parsetok.h"
+#include "graminit.h"
+#include "tokenizer.h"
+#include "errcode.h"
+#include "malloc.h"
+
+extern int _profile;
+
+extern grammar gram; /* From graminit.c */
+
+int debugging = 1;
+
+FILE *getopenfile()
+{
+ char buf[256];
+ char *p;
+ FILE *fp;
+ for (;;) {
+ fprintf(stderr, "File name: ");
+ if (fgets(buf, sizeof buf, stdin) == NULL) {
+ fprintf(stderr, "EOF\n");
+ exit(1);
+ }
+ p = strchr(buf, '\n');
+ if (p != NULL)
+ *p = '\0';
+ if ((fp = fopen(buf, "r")) != NULL)
+ break;
+ fprintf(stderr, "Sorry, try again.\n");
+ }
+ return fp;
+}
+
+main()
+{
+ FILE *fp;
+ _profile = 0;
+ fp = getopenfile();
+#if 0
+ askgo("Start tokenizing");
+ runtokenizer(fp);
+ fseek(fp, 0L, 0);
+#endif
+ if (!gram.g_accel)
+ addaccelerators(&gram);
+ askgo("Start parsing");
+ _profile = 1;
+ runparser(fp);
+ _profile = 0;
+ freopen("prof.out", "w", stdout);
+ DumpProfile();
+ fflush(stdout);
+ exit(0);
+}
+
+static int
+runtokenizer(fp)
+ FILE *fp;
+{
+ struct tok_state *tok;
+ tok = tok_setupf(fp, "Tokenizing", ".");
+ for (;;) {
+ char *a, *b;
+ register char *str;
+ register int len;
+ (void) tok_get(tok, &a, &b);
+ if (tok->done != E_OK)
+ break;
+ len = b - a;
+ str = NEW(char, len + 1);
+ if (str == NULL) {
+ fprintf(stderr, "no mem for next token");
+ break;
+ }
+ strncpy(str, a, len);
+ str[len] = '\0';
+ }
+ fprintf(stderr, "done (%d)\n", tok->done);
+}
+
+static
+runparser(fp, start)
+ FILE *fp;
+{
+ node *n;
+ int ret;
+ ret = parsefile(fp, &gram, module_input, "Parsing", ".", &n);
+ fprintf(stderr, "done (%d)\n", ret);
+#if 0
+ _profile = 0;
+ if (ret == E_DONE)
+ listtree(n);
+#endif
+}
+
+static int
+askgo(prompt)
+ char *prompt;
+{
+ char buf[256];
+ fprintf(stderr, "%s: hit return when ready: ", prompt);
+ fgets(buf, sizeof buf, stdin);
+}
diff --git a/src/pythonmain.c b/src/pythonmain.c
new file mode 100644
index 0000000..8c86d8c
--- /dev/null
+++ b/src/pythonmain.c
@@ -0,0 +1,440 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Python interpreter main program */
+
+#include "patchlevel.h"
+
+#include "allobjects.h"
+
+#include "grammar.h"
+#include "node.h"
+#include "parsetok.h"
+#include "graminit.h"
+#include "errcode.h"
+#include "sysmodule.h"
+#include "compile.h"
+#include "ceval.h"
+#include "pythonrun.h"
+#include "import.h"
+
+extern char *getpythonpath();
+
+extern grammar gram; /* From graminit.c */
+
+#ifdef DEBUG
+int debugging; /* Needed by parser.c */
+#endif
+
+main(argc, argv)
+ int argc;
+ char **argv;
+{
+ char *filename = NULL;
+ FILE *fp = stdin;
+
+ initargs(&argc, &argv);
+
+ if (argc > 1 && strcmp(argv[1], "-") != 0)
+ filename = argv[1];
+
+ if (filename != NULL) {
+ if ((fp = fopen(filename, "r")) == NULL) {
+ fprintf(stderr, "python: can't open file '%s'\n",
+ filename);
+ exit(2);
+ }
+ }
+
+ initall();
+
+ setpythonpath(getpythonpath());
+ setpythonargv(argc-1, argv+1);
+
+ goaway(run(fp, filename == NULL ? "<stdin>" : filename));
+ /*NOTREACHED*/
+}
+
+/* Initialize all */
+
+void
+initall()
+{
+ static int inited;
+
+ if (inited)
+ return;
+ inited = 1;
+
+ initimport();
+
+ /* Modules 'builtin' and 'sys' are initialized here,
+ they are needed by random bits of the interpreter.
+ All other modules are optional and should be initialized
+ by the initcalls() of a specific configuration. */
+
+ initbuiltin(); /* Also initializes builtin exceptions */
+ initsys();
+
+ initcalls(); /* Configuration-dependent initializations */
+
+ initintr(); /* For intrcheck() */
+}
+
+/* Parse input from a file and execute it */
+
+int
+run(fp, filename)
+ FILE *fp;
+ char *filename;
+{
+ if (filename == NULL)
+ filename = "???";
+ if (isatty(fileno(fp)))
+ return run_tty_loop(fp, filename);
+ else
+ return run_script(fp, filename);
+}
+
+int
+run_tty_loop(fp, filename)
+ FILE *fp;
+ char *filename;
+{
+ object *v;
+ int ret;
+ v = sysget("ps1");
+ if (v == NULL) {
+ sysset("ps1", v = newstringobject(">>> "));
+ XDECREF(v);
+ }
+ v = sysget("ps2");
+ if (v == NULL) {
+ sysset("ps2", v = newstringobject("... "));
+ XDECREF(v);
+ }
+ for (;;) {
+ ret = run_tty_1(fp, filename);
+#ifdef REF_DEBUG
+ fprintf(stderr, "[%ld refs]\n", ref_total);
+#endif
+ if (ret == E_EOF)
+ return 0;
+ /*
+ if (ret == E_NOMEM)
+ return -1;
+ */
+ }
+}
+
+int
+run_tty_1(fp, filename)
+ FILE *fp;
+ char *filename;
+{
+ object *m, *d, *v, *w;
+ node *n;
+ char *ps1, *ps2;
+ int err;
+ v = sysget("ps1");
+ w = sysget("ps2");
+ if (v != NULL && is_stringobject(v)) {
+ INCREF(v);
+ ps1 = getstringvalue(v);
+ }
+ else {
+ v = NULL;
+ ps1 = "";
+ }
+ if (w != NULL && is_stringobject(w)) {
+ INCREF(w);
+ ps2 = getstringvalue(w);
+ }
+ else {
+ w = NULL;
+ ps2 = "";
+ }
+ err = parsefile(fp, filename, &gram, single_input, ps1, ps2, &n);
+ XDECREF(v);
+ XDECREF(w);
+ if (err == E_EOF)
+ return E_EOF;
+ if (err != E_DONE) {
+ err_input(err);
+ print_error();
+ return err;
+ }
+ m = add_module("__main__");
+ if (m == NULL)
+ return -1;
+ d = getmoduledict(m);
+ v = run_node(n, filename, d, d);
+ flushline();
+ if (v == NULL) {
+ print_error();
+ return -1;
+ }
+ DECREF(v);
+ return 0;
+}
+
+int
+run_script(fp, filename)
+ FILE *fp;
+ char *filename;
+{
+ object *m, *d, *v;
+ m = add_module("__main__");
+ if (m == NULL)
+ return -1;
+ d = getmoduledict(m);
+ v = run_file(fp, filename, file_input, d, d);
+ flushline();
+ if (v == NULL) {
+ print_error();
+ return -1;
+ }
+ DECREF(v);
+ return 0;
+}
+
+void
+print_error()
+{
+ object *exception, *v;
+ err_get(&exception, &v);
+ fprintf(stderr, "Unhandled exception: ");
+ printobject(exception, stderr, PRINT_RAW);
+ if (v != NULL && v != None) {
+ fprintf(stderr, ": ");
+ printobject(v, stderr, PRINT_RAW);
+ }
+ fprintf(stderr, "\n");
+ XDECREF(exception);
+ XDECREF(v);
+ printtraceback(stderr);
+}
+
+object *
+run_string(str, start, globals, locals)
+ char *str;
+ int start;
+ /*dict*/object *globals, *locals;
+{
+ node *n;
+ int err;
+ err = parse_string(str, start, &n);
+ return run_err_node(err, n, "<string>", globals, locals);
+}
+
+object *
+run_file(fp, filename, start, globals, locals)
+ FILE *fp;
+ char *filename;
+ int start;
+ /*dict*/object *globals, *locals;
+{
+ node *n;
+ int err;
+ err = parse_file(fp, filename, start, &n);
+ return run_err_node(err, n, filename, globals, locals);
+}
+
+object *
+run_err_node(err, n, filename, globals, locals)
+ int err;
+ node *n;
+ char *filename;
+ /*dict*/object *globals, *locals;
+{
+ if (err != E_DONE) {
+ err_input(err);
+ return NULL;
+ }
+ return run_node(n, filename, globals, locals);
+}
+
+object *
+run_node(n, filename, globals, locals)
+ node *n;
+ char *filename;
+ /*dict*/object *globals, *locals;
+{
+ if (globals == NULL) {
+ globals = getglobals();
+ if (locals == NULL)
+ locals = getlocals();
+ }
+ else {
+ if (locals == NULL)
+ locals = globals;
+ }
+ return eval_node(n, filename, globals, locals);
+}
+
+object *
+eval_node(n, filename, globals, locals)
+ node *n;
+ char *filename;
+ object *globals;
+ object *locals;
+{
+ codeobject *co;
+ object *v;
+ co = compile(n, filename);
+ freetree(n);
+ if (co == NULL)
+ return NULL;
+ v = eval_code(co, globals, locals, (object *)NULL);
+ DECREF(co);
+ return v;
+}
+
+/* Simplified interface to parsefile */
+
+int
+parse_file(fp, filename, start, n_ret)
+ FILE *fp;
+ char *filename;
+ int start;
+ node **n_ret;
+{
+ return parsefile(fp, filename, &gram, start,
+ (char *)0, (char *)0, n_ret);
+}
+
+/* Simplified interface to parsestring */
+
+int
+parse_string(str, start, n_ret)
+ char *str;
+ int start;
+ node **n_ret;
+{
+ int err = parsestring(str, &gram, start, n_ret);
+ /* Don't confuse early end of string with early end of input */
+ if (err == E_EOF)
+ err = E_SYNTAX;
+ return err;
+}
+
+/* Print fatal error message and abort */
+
+void
+fatal(msg)
+ char *msg;
+{
+ fprintf(stderr, "Fatal error: %s\n", msg);
+ abort();
+}
+
+/* Clean up and exit */
+
+void
+goaway(sts)
+ int sts;
+{
+ flushline();
+
+ /* XXX Call doneimport() before donecalls(), since donecalls()
+ calls wdone(), and doneimport() may close windows */
+ doneimport();
+ donecalls();
+
+ err_clear();
+
+#ifdef REF_DEBUG
+ fprintf(stderr, "[%ld refs]\n", ref_total);
+#endif
+
+#ifdef THINK_C_3_0
+ if (sts == 0)
+ Click_On(0);
+#endif
+
+#ifdef TRACE_REFS
+ if (askyesno("Print left references?")) {
+#ifdef THINK_C_3_0
+ Click_On(1);
+#endif
+ printrefs(stderr);
+ }
+#endif /* TRACE_REFS */
+
+ exit(sts);
+ /*NOTREACHED*/
+}
+
+static
+finaloutput()
+{
+#ifdef TRACE_REFS
+ if (!askyesno("Print left references?"))
+ return;
+#ifdef THINK_C_3_0
+ Click_On(1);
+#endif
+ printrefs(stderr);
+#endif /* TRACE_REFS */
+}
+
+/* Ask a yes/no question */
+
+static int
+askyesno(prompt)
+ char *prompt;
+{
+ char buf[256];
+
+ printf("%s [ny] ", prompt);
+ if (fgets(buf, sizeof buf, stdin) == NULL)
+ return 0;
+ return buf[0] == 'y' || buf[0] == 'Y';
+}
+
+#ifdef THINK_C_3_0
+
+/* Check for file descriptor connected to interactive device.
+ Pretend that stdin is always interactive, other files never. */
+
+int
+isatty(fd)
+ int fd;
+{
+ return fd == fileno(stdin);
+}
+
+#endif
+
+/* XXX WISH LIST
+
+ - possible new types:
+ - iterator (for range, keys, ...)
+ - improve interpreter error handling, e.g., true tracebacks
+ - save precompiled modules on file?
+ - fork threads, locking
+ - allow syntax extensions
+*/
+
+/* "Floccinaucinihilipilification" */
diff --git a/src/pythonrun.h b/src/pythonrun.h
new file mode 100644
index 0000000..30c8667
--- /dev/null
+++ b/src/pythonrun.h
@@ -0,0 +1,47 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Interfaces to parse and execute pieces of python code */
+
+void initall PROTO((void));
+
+int run PROTO((FILE *, char *));
+
+int run_script PROTO((FILE *, char *));
+int run_tty_1 PROTO((FILE *, char *));
+int run_tty_loop PROTO((FILE *, char *));
+
+int parse_string PROTO((char *, int, struct _node **));
+int parse_file PROTO((FILE *, char *, int, struct _node **));
+
+object *eval_node PROTO((struct _node *, char *, object *, object *));
+
+object *run_string PROTO((char *, int, object *, object *));
+object *run_file PROTO((FILE *, char *, int, object *, object *));
+object *run_err_node PROTO((int, struct _node *, char *, object *, object *));
+object *run_node PROTO((struct _node *, char *, object *, object *));
+
+void print_error PROTO((void));
+
+void goaway PROTO((int));
diff --git a/src/regexp.c b/src/regexp.c
new file mode 100644
index 0000000..50ce9b6
--- /dev/null
+++ b/src/regexp.c
@@ -0,0 +1,1394 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/*
+ * regcomp and regexec -- regsub and regerror are elsewhere
+ *
+ * Copyright (c) 1986 by University of Toronto.
+ * Written by Henry Spencer. Not derived from licensed software.
+#ifdef MULTILINE
+ * Changed by Guido van Rossum, CWI, Amsterdam
+ * for multi-line support.
+#endif
+ *
+ * Permission is granted to anyone to use this software for any
+ * purpose on any computer system, and to redistribute it freely,
+ * subject to the following restrictions:
+ *
+ * 1. The author is not responsible for the consequences of use of
+ * this software, no matter how awful, even if they arise
+ * from defects in it.
+ *
+ * 2. The origin of this software must not be misrepresented, either
+ * by explicit claim or by omission.
+ *
+ * 3. Altered versions must be plainly marked as such, and must not
+ * be misrepresented as being the original software.
+ *
+ * Beware that some of this code is subtly aware of the way operator
+ * precedence is structured in regular expressions. Serious changes in
+ * regular-expression syntax might require a total rethink.
+ */
+#include <stdio.h>
+#include "PROTO.h"
+#include "malloc.h"
+#undef ANY /* Conflicting identifier defined in malloc.h */
+#include <string.h> /* XXX Remove if not found */
+#include "regexp.h"
+#include "regmagic.h"
+
+#ifdef MULTILINE
+/*
+ * Defining MULTILINE turns on the following changes in the semantics:
+ * 1. The '.' operator matches all characters except a newline.
+ * 2. The '^' operator matches at the beginning of the string or after
+ * a newline. (Anchored matches are retried after each newline.)
+ * 3. The '$' operator matches at the end of the string or before
+ * a newline.
+ * 4. A '\' followed by an 'n' matches a newline. (This is an
+ * unfortunate exception to the rule that '\' followed by a
+ * character matches that character...)
+ *
+ * Also, there is a new function reglexec(prog, string, offset)
+ * which searches for a match starting at 'string+offset';
+ * it differs from regexec(prog, string+offset) in assuming
+ * that the line begins at 'string'.
+ */
+#endif
+
+/*
+ * The "internal use only" fields in regexp.h are present to pass info from
+ * compile to execute that permits the execute phase to run lots faster on
+ * simple cases. They are:
+ *
+ * regstart char that must begin a match; '\0' if none obvious
+ * reganch is the match anchored (at beginning-of-line only)?
+ * regmust string (pointer into program) that match must include, or NULL
+ * regmlen length of regmust string
+ *
+ * Regstart and reganch permit very fast decisions on suitable starting points
+ * for a match, cutting down the work a lot. Regmust permits fast rejection
+ * of lines that cannot possibly match. The regmust tests are costly enough
+ * that regcomp() supplies a regmust only if the r.e. contains something
+ * potentially expensive (at present, the only such thing detected is * or +
+ * at the start of the r.e., which can involve a lot of backup). Regmlen is
+ * supplied because the test in regexec() needs it and regcomp() is computing
+ * it anyway.
+ */
+
+/*
+ * Structure for regexp "program". This is essentially a linear encoding
+ * of a nondeterministic finite-state machine (aka syntax charts or
+ * "railroad normal form" in parsing technology). Each node is an opcode
+ * plus a "next" pointer, possibly plus an operand. "Next" pointers of
+ * all nodes except BRANCH implement concatenation; a "next" pointer with
+ * a BRANCH on both ends of it is connecting two alternatives. (Here we
+ * have one of the subtle syntax dependencies: an individual BRANCH (as
+ * opposed to a collection of them) is never concatenated with anything
+ * because of operator precedence.) The operand of some types of node is
+ * a literal string; for others, it is a node leading into a sub-FSM. In
+ * particular, the operand of a BRANCH node is the first node of the branch.
+ * (NB this is *not* a tree structure: the tail of the branch connects
+ * to the thing following the set of BRANCHes.) The opcodes are:
+ */
+
+/* definition number opnd? meaning */
+#define END 0 /* no End of program. */
+#define BOL 1 /* no Match "" at beginning of line. */
+#define EOL 2 /* no Match "" at end of line. */
+#define ANY 3 /* no Match any one character. */
+#define ANYOF 4 /* str Match any character in this string. */
+#define ANYBUT 5 /* str Match any character not in this string. */
+#define BRANCH 6 /* node Match this alternative, or the next... */
+#define BACK 7 /* no Match "", "next" ptr points backward. */
+#define EXACTLY 8 /* str Match this string. */
+#define NOTHING 9 /* no Match empty string. */
+#define STAR 10 /* node Match this (simple) thing 0 or more times. */
+#define PLUS 11 /* node Match this (simple) thing 1 or more times. */
+#define OPEN 20 /* no Mark this point in input as start of #n. */
+ /* OPEN+1 is number 1, etc. */
+#define CLOSE 30 /* no Analogous to OPEN. */
+
+/*
+ * Opcode notes:
+ *
+ * BRANCH The set of branches constituting a single choice are hooked
+ * together with their "next" pointers, since precedence prevents
+ * anything being concatenated to any individual branch. The
+ * "next" pointer of the last BRANCH in a choice points to the
+ * thing following the whole choice. This is also where the
+ * final "next" pointer of each individual branch points; each
+ * branch starts with the operand node of a BRANCH node.
+ *
+ * BACK Normal "next" pointers all implicitly point forward; BACK
+ * exists to make loop structures possible.
+ *
+ * STAR,PLUS '?', and complex '*' and '+', are implemented as circular
+ * BRANCH structures using BACK. Simple cases (one character
+ * per match) are implemented with STAR and PLUS for speed
+ * and to minimize recursive plunges.
+ *
+ * OPEN,CLOSE ...are numbered at compile time.
+ */
+
+/*
+ * A node is one char of opcode followed by two chars of "next" pointer.
+ * "Next" pointers are stored as two 8-bit pieces, high order first. The
+ * value is a positive offset from the opcode of the node containing it.
+ * An operand, if any, simply follows the node. (Note that much of the
+ * code generation knows about this implicit relationship.)
+ *
+ * Using two bytes for the "next" pointer is vast overkill for most things,
+ * but allows patterns to get big without disasters.
+ */
+#define OP(p) (*(p))
+#define NEXT(p) (((*((p)+1)&0377)<<8) + (*((p)+2)&0377))
+#define OPERAND(p) ((p) + 3)
+
+/*
+ * See regmagic.h for one further detail of program structure.
+ */
+
+
+/*
+ * Utility definitions.
+ */
+#ifndef CHARBITS
+#define UCHARAT(p) ((int)*(unsigned char *)(p))
+#else
+#define UCHARAT(p) ((int)*(p)&CHARBITS)
+#endif
+
+#define FAIL(m) { regerror(m); return(NULL); }
+#define ISMULT(c) ((c) == '*' || (c) == '+' || (c) == '?')
+#define META "^$.[()|?+*\\"
+
+/*
+ * Flags to be passed up and down.
+ */
+#define HASWIDTH 01 /* Known never to match null string. */
+#define SIMPLE 02 /* Simple enough to be STAR/PLUS operand. */
+#define SPSTART 04 /* Starts with * or +. */
+#define WORST 0 /* Worst case. */
+
+/*
+ * Global work variables for regcomp().
+ */
+static char *regparse; /* Input-scan pointer. */
+static int regnpar; /* () count. */
+static char regdummy;
+static char *regcode; /* Code-emit pointer; &regdummy = don't. */
+static long regsize; /* Code size. */
+#ifdef MULTILINE
+static int regnl; /* '\n' detected. */
+#endif
+
+/*
+ * Forward declarations for regcomp()'s friends.
+ */
+#ifndef STATIC
+#define STATIC static
+#endif
+STATIC char *reg();
+STATIC char *regbranch();
+STATIC char *regpiece();
+STATIC char *regatom();
+STATIC char *regnode();
+STATIC char *regnext();
+STATIC void regc();
+STATIC void reginsert();
+STATIC void regtail();
+STATIC void regoptail();
+#ifdef STRCSPN
+STATIC int strcspn();
+#endif
+
+/*
+ - regcomp - compile a regular expression into internal code
+ *
+ * We can't allocate space until we know how big the compiled form will be,
+ * but we can't compile it (and thus know how big it is) until we've got a
+ * place to put the code. So we cheat: we compile it twice, once with code
+ * generation turned off and size counting turned on, and once "for real".
+ * This also means that we don't allocate space until we are sure that the
+ * thing really will compile successfully, and we never have to move the
+ * code and thus invalidate pointers into it. (Note that it has to be in
+ * one piece because free() must be able to free it all.)
+ *
+ * Beware that the optimization-preparation code in here knows about some
+ * of the structure of the compiled regexp.
+ */
+regexp *
+regcomp(exp)
+char *exp;
+{
+ register regexp *r;
+ register char *scan;
+ register char *longest;
+ register int len;
+ int flags;
+
+ if (exp == NULL)
+ FAIL("NULL argument");
+
+ /* First pass: determine size, legality. */
+ regparse = exp;
+ regnpar = 1;
+ regsize = 0L;
+ regcode = &regdummy;
+#ifdef MULTILINE
+ regnl = 0;
+#endif
+ regc(MAGIC);
+ if (reg(0, &flags) == NULL)
+ return(NULL);
+
+ /* Small enough for pointer-storage convention? */
+ if (regsize >= 32767L) /* Probably could be 65535L. */
+ FAIL("regexp too big");
+
+ /* Allocate space. */
+ r = (regexp *)malloc(sizeof(regexp) + (unsigned)regsize);
+ if (r == NULL)
+ FAIL("out of space");
+
+ /* Second pass: emit code. */
+ regparse = exp;
+ regnpar = 1;
+ regcode = r->program;
+ regc(MAGIC);
+ if (reg(0, &flags) == NULL)
+ return(NULL);
+
+ /* Dig out information for optimizations. */
+ r->regstart = '\0'; /* Worst-case defaults. */
+ r->reganch = 0;
+ r->regmust = NULL;
+ r->regmlen = 0;
+ scan = r->program+1; /* First BRANCH. */
+ if (OP(regnext(scan)) == END) { /* Only one top-level choice. */
+ scan = OPERAND(scan);
+
+ /* Starting-point info. */
+ if (OP(scan) == EXACTLY)
+ r->regstart = *OPERAND(scan);
+ else if (OP(scan) == BOL)
+ r->reganch++;
+
+ /*
+ * If there's something expensive in the r.e., find the
+ * longest literal string that must appear and make it the
+ * regmust. Resolve ties in favor of later strings, since
+ * the regstart check works with the beginning of the r.e.
+ * and avoiding duplication strengthens checking. Not a
+ * strong reason, but sufficient in the absence of others.
+ */
+#ifdef MULTILINE
+ if ((flags&SPSTART) && !regnl) {
+#else
+ if (flags&SPSTART) {
+#endif
+ longest = NULL;
+ len = 0;
+ for (; scan != NULL; scan = regnext(scan))
+ if (OP(scan) == EXACTLY && strlen(OPERAND(scan)) >= len) {
+ longest = OPERAND(scan);
+ len = strlen(OPERAND(scan));
+ }
+ r->regmust = longest;
+ r->regmlen = len;
+ }
+ }
+
+ return(r);
+}
+
+/*
+ - reg - regular expression, i.e. main body or parenthesized thing
+ *
+ * Caller must absorb opening parenthesis.
+ *
+ * Combining parenthesis handling with the base level of regular expression
+ * is a trifle forced, but the need to tie the tails of the branches to what
+ * follows makes it hard to avoid.
+ */
+static char *
+reg(paren, flagp)
+int paren; /* Parenthesized? */
+int *flagp;
+{
+ register char *ret;
+ register char *br;
+ register char *ender;
+ register int parno;
+ int flags;
+
+ *flagp = HASWIDTH; /* Tentatively. */
+
+ /* Make an OPEN node, if parenthesized. */
+ if (paren) {
+ if (regnpar >= NSUBEXP)
+ FAIL("too many ()");
+ parno = regnpar;
+ regnpar++;
+ ret = regnode(OPEN+parno);
+ } else
+ ret = NULL;
+
+ /* Pick up the branches, linking them together. */
+ br = regbranch(&flags);
+ if (br == NULL)
+ return(NULL);
+ if (ret != NULL)
+ regtail(ret, br); /* OPEN -> first. */
+ else
+ ret = br;
+ if (!(flags&HASWIDTH))
+ *flagp &= ~HASWIDTH;
+ *flagp |= flags&SPSTART;
+ while (*regparse == '|') {
+ regparse++;
+ br = regbranch(&flags);
+ if (br == NULL)
+ return(NULL);
+ regtail(ret, br); /* BRANCH -> BRANCH. */
+ if (!(flags&HASWIDTH))
+ *flagp &= ~HASWIDTH;
+ *flagp |= flags&SPSTART;
+ }
+
+ /* Make a closing node, and hook it on the end. */
+ ender = regnode((paren) ? CLOSE+parno : END);
+ regtail(ret, ender);
+
+ /* Hook the tails of the branches to the closing node. */
+ for (br = ret; br != NULL; br = regnext(br))
+ regoptail(br, ender);
+
+ /* Check for proper termination. */
+ if (paren && *regparse++ != ')') {
+ FAIL("unmatched ()");
+ } else if (!paren && *regparse != '\0') {
+ if (*regparse == ')') {
+ FAIL("unmatched ()");
+ } else
+ FAIL("junk on end"); /* "Can't happen". */
+ /* NOTREACHED */
+ }
+
+ return(ret);
+}
+
+/*
+ - regbranch - one alternative of an | operator
+ *
+ * Implements the concatenation operator.
+ */
+static char *
+regbranch(flagp)
+int *flagp;
+{
+ register char *ret;
+ register char *chain;
+ register char *latest;
+ int flags;
+
+ *flagp = WORST; /* Tentatively. */
+
+ ret = regnode(BRANCH);
+ chain = NULL;
+ while (*regparse != '\0' && *regparse != '|' && *regparse != ')') {
+ latest = regpiece(&flags);
+ if (latest == NULL)
+ return(NULL);
+ *flagp |= flags&HASWIDTH;
+ if (chain == NULL) /* First piece. */
+ *flagp |= flags&SPSTART;
+ else
+ regtail(chain, latest);
+ chain = latest;
+ }
+ if (chain == NULL) /* Loop ran zero times. */
+ (void) regnode(NOTHING);
+
+ return(ret);
+}
+
+/*
+ - regpiece - something followed by possible [*+?]
+ *
+ * Note that the branching code sequences used for ? and the general cases
+ * of * and + are somewhat optimized: they use the same NOTHING node as
+ * both the endmarker for their branch list and the body of the last branch.
+ * It might seem that this node could be dispensed with entirely, but the
+ * endmarker role is not redundant.
+ */
+static char *
+regpiece(flagp)
+int *flagp;
+{
+ register char *ret;
+ register char op;
+ register char *next;
+ int flags;
+
+ ret = regatom(&flags);
+ if (ret == NULL)
+ return(NULL);
+
+ op = *regparse;
+ if (!ISMULT(op)) {
+ *flagp = flags;
+ return(ret);
+ }
+
+ if (!(flags&HASWIDTH) && op != '?')
+ FAIL("*+ operand could be empty");
+ *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);
+
+ if (op == '*' && (flags&SIMPLE))
+ reginsert(STAR, ret);
+ else if (op == '*') {
+ /* Emit x* as (x&|), where & means "self". */
+ reginsert(BRANCH, ret); /* Either x */
+ regoptail(ret, regnode(BACK)); /* and loop */
+ regoptail(ret, ret); /* back */
+ regtail(ret, regnode(BRANCH)); /* or */
+ regtail(ret, regnode(NOTHING)); /* null. */
+ } else if (op == '+' && (flags&SIMPLE))
+ reginsert(PLUS, ret);
+ else if (op == '+') {
+ /* Emit x+ as x(&|), where & means "self". */
+ next = regnode(BRANCH); /* Either */
+ regtail(ret, next);
+ regtail(regnode(BACK), ret); /* loop back */
+ regtail(next, regnode(BRANCH)); /* or */
+ regtail(ret, regnode(NOTHING)); /* null. */
+ } else if (op == '?') {
+ /* Emit x? as (x|) */
+ reginsert(BRANCH, ret); /* Either x */
+ regtail(ret, regnode(BRANCH)); /* or */
+ next = regnode(NOTHING); /* null. */
+ regtail(ret, next);
+ regoptail(ret, next);
+ }
+ regparse++;
+ if (ISMULT(*regparse))
+ FAIL("nested *?+");
+
+ return(ret);
+}
+
+/*
+ - regatom - the lowest level
+ *
+ * Optimization: gobbles an entire sequence of ordinary characters so that
+ * it can turn them into a single node, which is smaller to store and
+ * faster to run. Backslashed characters are exceptions, each becoming a
+ * separate node; the code is simpler that way and it's not worth fixing.
+ */
+static char *
+regatom(flagp)
+int *flagp;
+{
+ register char *ret;
+ int flags;
+
+ *flagp = WORST; /* Tentatively. */
+
+ switch (*regparse++) {
+ case '^':
+ ret = regnode(BOL);
+ break;
+ case '$':
+ ret = regnode(EOL);
+ break;
+ case '.':
+ ret = regnode(ANY);
+ *flagp |= HASWIDTH|SIMPLE;
+ break;
+ case '[': {
+ register int class;
+ register int classend;
+
+ if (*regparse == '^') { /* Complement of range. */
+ ret = regnode(ANYBUT);
+ regparse++;
+ } else
+ ret = regnode(ANYOF);
+ if (*regparse == ']' || *regparse == '-')
+ regc(*regparse++);
+ while (*regparse != '\0' && *regparse != ']') {
+ if (*regparse == '-') {
+ regparse++;
+ if (*regparse == ']' || *regparse == '\0')
+ regc('-');
+ else {
+ class = UCHARAT(regparse-2)+1;
+ classend = UCHARAT(regparse);
+ if (class > classend+1)
+ FAIL("invalid [] range");
+ for (; class <= classend; class++)
+ regc(class);
+ regparse++;
+ }
+ } else
+ regc(*regparse++);
+ }
+ regc('\0');
+ if (*regparse != ']')
+ FAIL("unmatched []");
+ regparse++;
+ *flagp |= HASWIDTH|SIMPLE;
+ }
+ break;
+ case '(':
+ ret = reg(1, &flags);
+ if (ret == NULL)
+ return(NULL);
+ *flagp |= flags&(HASWIDTH|SPSTART);
+ break;
+ case '\0':
+ case '|':
+ case ')':
+ FAIL("internal urp"); /* Supposed to be caught earlier. */
+ break;
+ case '?':
+ case '+':
+ case '*':
+ FAIL("?+* follows nothing");
+ break;
+ case '\\':
+ if (*regparse == '\0')
+ FAIL("trailing \\");
+ ret = regnode(EXACTLY);
+#ifdef MULTILINE
+ if (*regparse == 'n') {
+ regc('\n');
+ regparse++;
+ regnl++;
+ }
+ else
+#endif
+ regc(*regparse++);
+ regc('\0');
+ *flagp |= HASWIDTH|SIMPLE;
+ break;
+ default: {
+ register int len;
+ register char ender;
+
+ regparse--;
+ len = strcspn(regparse, META);
+ if (len <= 0)
+ FAIL("internal disaster");
+ ender = *(regparse+len);
+ if (len > 1 && ISMULT(ender))
+ len--; /* Back off clear of ?+* operand. */
+ *flagp |= HASWIDTH;
+ if (len == 1)
+ *flagp |= SIMPLE;
+ ret = regnode(EXACTLY);
+ while (len > 0) {
+#ifdef MULTILINE
+ if (*regparse == '\n')
+ regnl++;
+#endif
+ regc(*regparse++);
+ len--;
+ }
+ regc('\0');
+ }
+ break;
+ }
+
+ return(ret);
+}
+
+/*
+ - regnode - emit a node
+ */
+static char * /* Location. */
+regnode(op)
+char op;
+{
+ register char *ret;
+ register char *ptr;
+
+ ret = regcode;
+ if (ret == &regdummy) {
+ regsize += 3;
+ return(ret);
+ }
+
+ ptr = ret;
+ *ptr++ = op;
+ *ptr++ = '\0'; /* Null "next" pointer. */
+ *ptr++ = '\0';
+ regcode = ptr;
+
+ return(ret);
+}
+
+/*
+ - regc - emit (if appropriate) a byte of code
+ */
+static void
+regc(b)
+char b;
+{
+ if (regcode != &regdummy)
+ *regcode++ = b;
+ else
+ regsize++;
+}
+
+/*
+ - reginsert - insert an operator in front of already-emitted operand
+ *
+ * Means relocating the operand.
+ */
+static void
+reginsert(op, opnd)
+char op;
+char *opnd;
+{
+ register char *src;
+ register char *dst;
+ register char *place;
+
+ if (regcode == &regdummy) {
+ regsize += 3;
+ return;
+ }
+
+ src = regcode;
+ regcode += 3;
+ dst = regcode;
+ while (src > opnd)
+ *--dst = *--src;
+
+ place = opnd; /* Op node, where operand used to be. */
+ *place++ = op;
+ *place++ = '\0';
+ *place++ = '\0';
+}
+
+/*
+ - regtail - set the next-pointer at the end of a node chain
+ */
+static void
+regtail(p, val)
+char *p;
+char *val;
+{
+ register char *scan;
+ register char *temp;
+ register int offset;
+
+ if (p == &regdummy)
+ return;
+
+ /* Find last node. */
+ scan = p;
+ for (;;) {
+ temp = regnext(scan);
+ if (temp == NULL)
+ break;
+ scan = temp;
+ }
+
+ if (OP(scan) == BACK)
+ offset = scan - val;
+ else
+ offset = val - scan;
+ *(scan+1) = (offset>>8)&0377;
+ *(scan+2) = offset&0377;
+}
+
+/*
+ - regoptail - regtail on operand of first argument; nop if operandless
+ */
+static void
+regoptail(p, val)
+char *p;
+char *val;
+{
+ /* "Operandless" and "op != BRANCH" are synonymous in practice. */
+ if (p == NULL || p == &regdummy || OP(p) != BRANCH)
+ return;
+ regtail(OPERAND(p), val);
+}
+
+/*
+ * regexec and friends
+ */
+
+/*
+ * Global work variables for regexec().
+ */
+static char *reginput; /* String-input pointer. */
+static char *regbol; /* Beginning of input, for ^ check. */
+static char **regstartp; /* Pointer to startp array. */
+static char **regendp; /* Ditto for endp. */
+
+/*
+ * Forwards.
+ */
+STATIC int regtry();
+STATIC int regmatch();
+STATIC int regrepeat();
+
+#ifdef DEBUG
+int regnarrate = 0;
+void regdump();
+STATIC char *regprop();
+#endif
+
+/*
+ - regexec - match a regexp against a string
+ */
+int
+regexec(prog, string)
+register regexp *prog;
+register char *string;
+{
+ register char *s;
+ extern char *strchr();
+
+ /* Be paranoid... */
+ if (prog == NULL || string == NULL) {
+ regerror("NULL parameter");
+ return(0);
+ }
+
+#ifdef MULTILINE
+ /* Check for \n in string, and if so, call the more general routine. */
+ if (strchr(string, '\n') != NULL)
+ return reglexec(prog, string, 0);
+#endif
+
+ /* Check validity of program. */
+ if (UCHARAT(prog->program) != MAGIC) {
+ regerror("corrupted program");
+ return(0);
+ }
+
+ /* If there is a "must appear" string, look for it. */
+ if (prog->regmust != NULL) {
+ s = string;
+ while ((s = strchr(s, prog->regmust[0])) != NULL) {
+ if (strncmp(s, prog->regmust, prog->regmlen) == 0)
+ break; /* Found it. */
+ s++;
+ }
+ if (s == NULL) /* Not present. */
+ return(0);
+ }
+
+ /* Mark beginning of line for ^ . */
+ regbol = string;
+
+ /* Simplest case: anchored match need be tried only once. */
+ if (prog->reganch)
+ return(regtry(prog, string));
+
+ /* Messy cases: unanchored match. */
+ s = string;
+ if (prog->regstart != '\0')
+ /* We know what char it must start with. */
+ while ((s = strchr(s, prog->regstart)) != NULL) {
+ if (regtry(prog, s))
+ return(1);
+ s++;
+ }
+ else
+ /* We don't -- general case. */
+ do {
+ if (regtry(prog, s))
+ return(1);
+ } while (*s++ != '\0');
+
+ /* Failure. */
+ return(0);
+}
+
+#ifdef MULTILINE
+/*
+ - reglexec - match a regexp against a long string buffer, starting at offset
+ */
+int
+reglexec(prog, string, offset)
+register regexp *prog;
+register char *string;
+{
+ register char *s;
+ extern char *strchr();
+
+ /* Be paranoid... */
+ if (prog == NULL || string == NULL) {
+ regerror("NULL parameter");
+ return(0);
+ }
+
+ /* Check validity of program. */
+ if (UCHARAT(prog->program) != MAGIC) {
+ regerror("corrupted program");
+ return(0);
+ }
+
+ /* (Don't look for "must appear" string -- string can be long.) */
+
+ /* Mark beginning of line for ^ . */
+ regbol = string;
+
+ /* Apply offset.
+ Assume 0 <= offset <= strlen(string), but don't check,
+ as string can be long. */
+ s= string + offset;
+
+ /* Anchored match need be tried only at line starts. */
+ if (prog->reganch) {
+ while (!regtry(prog, s)) {
+ s = strchr(s, '\n');
+ if (s == NULL)
+ return(0);
+ s++;
+ }
+ return(1);
+ }
+
+ /* Messy cases: unanchored match. */
+ if (prog->regstart != '\0')
+ /* We know what char it must start with. */
+ while ((s = strchr(s, prog->regstart)) != NULL) {
+ if (regtry(prog, s))
+ return(1);
+ s++;
+ }
+ else
+ /* We don't -- general case. */
+ do {
+ if (regtry(prog, s))
+ return(1);
+ } while (*s++ != '\0');
+
+ /* Failure. */
+ return(0);
+}
+#endif
+
+/*
+ - regtry - try match at specific point
+ */
+static int /* 0 failure, 1 success */
+regtry(prog, string)
+regexp *prog;
+char *string;
+{
+ register int i;
+ register char **sp;
+ register char **ep;
+
+ reginput = string;
+ regstartp = prog->startp;
+ regendp = prog->endp;
+
+ sp = prog->startp;
+ ep = prog->endp;
+ for (i = NSUBEXP; i > 0; i--) {
+ *sp++ = NULL;
+ *ep++ = NULL;
+ }
+ if (regmatch(prog->program + 1)) {
+ prog->startp[0] = string;
+ prog->endp[0] = reginput;
+ return(1);
+ } else
+ return(0);
+}
+
+/*
+ - regmatch - main matching routine
+ *
+ * Conceptually the strategy is simple: check to see whether the current
+ * node matches, call self recursively to see whether the rest matches,
+ * and then act accordingly. In practice we make some effort to avoid
+ * recursion, in particular by going through "ordinary" nodes (that don't
+ * need to know whether the rest of the match failed) by a loop instead of
+ * by recursion.
+ */
+static int /* 0 failure, 1 success */
+regmatch(prog)
+char *prog;
+{
+ register char *scan; /* Current node. */
+ char *next; /* Next node. */
+ extern char *strchr();
+
+ scan = prog;
+#ifdef DEBUG
+ if (scan != NULL && regnarrate)
+ fprintf(stderr, "%s(\n", regprop(scan));
+#endif
+ while (scan != NULL) {
+#ifdef DEBUG
+ if (regnarrate)
+ fprintf(stderr, "%s...\n", regprop(scan));
+#endif
+ next = regnext(scan);
+
+ switch (OP(scan)) {
+ case BOL:
+#ifdef MULTILINE
+ if (!(reginput == regbol ||
+ reginput > regbol && *(reginput-1) == '\n'))
+#else
+ if (reginput != regbol)
+#endif
+ return(0);
+ break;
+ case EOL:
+#ifdef MULTILINE
+ if (*reginput != '\0' && *reginput != '\n')
+#else
+ if (*reginput != '\0')
+#endif
+ return(0);
+ break;
+ case ANY:
+#ifdef MULTILINE
+ if (*reginput == '\0' || *reginput == '\n')
+#else
+ if (*reginput == '\0')
+#endif
+ return(0);
+ reginput++;
+ break;
+ case EXACTLY: {
+ register int len;
+ register char *opnd;
+
+ opnd = OPERAND(scan);
+ /* Inline the first character, for speed. */
+ if (*opnd != *reginput)
+ return(0);
+ len = strlen(opnd);
+ if (len > 1 && strncmp(opnd, reginput, len) != 0)
+ return(0);
+ reginput += len;
+ }
+ break;
+ case ANYOF:
+ if (*reginput == '\0' || strchr(OPERAND(scan), *reginput) == NULL)
+ return(0);
+ reginput++;
+ break;
+ case ANYBUT:
+#ifdef MULTILINE
+ if (*reginput == '\0' || *reginput == '\n' ||
+ strchr(OPERAND(scan), *reginput) != NULL)
+#else
+ if (*reginput == '\0' || strchr(OPERAND(scan), *reginput) != NULL)
+#endif
+ return(0);
+ reginput++;
+ break;
+ case NOTHING:
+ break;
+ case BACK:
+ break;
+ case OPEN+1:
+ case OPEN+2:
+ case OPEN+3:
+ case OPEN+4:
+ case OPEN+5:
+ case OPEN+6:
+ case OPEN+7:
+ case OPEN+8:
+ case OPEN+9: {
+ register int no;
+ register char *save;
+
+ no = OP(scan) - OPEN;
+ save = reginput;
+
+ if (regmatch(next)) {
+ /*
+ * Don't set startp if some later
+ * invocation of the same parentheses
+ * already has.
+ */
+ if (regstartp[no] == NULL)
+ regstartp[no] = save;
+ return(1);
+ } else
+ return(0);
+ }
+ break;
+ case CLOSE+1:
+ case CLOSE+2:
+ case CLOSE+3:
+ case CLOSE+4:
+ case CLOSE+5:
+ case CLOSE+6:
+ case CLOSE+7:
+ case CLOSE+8:
+ case CLOSE+9: {
+ register int no;
+ register char *save;
+
+ no = OP(scan) - CLOSE;
+ save = reginput;
+
+ if (regmatch(next)) {
+ /*
+ * Don't set endp if some later
+ * invocation of the same parentheses
+ * already has.
+ */
+ if (regendp[no] == NULL)
+ regendp[no] = save;
+ return(1);
+ } else
+ return(0);
+ }
+ break;
+ case BRANCH: {
+ register char *save;
+
+ if (OP(next) != BRANCH) /* No choice. */
+ next = OPERAND(scan); /* Avoid recursion. */
+ else {
+ do {
+ save = reginput;
+ if (regmatch(OPERAND(scan)))
+ return(1);
+ reginput = save;
+ scan = regnext(scan);
+ } while (scan != NULL && OP(scan) == BRANCH);
+ return(0);
+ /* NOTREACHED */
+ }
+ }
+ break;
+ case STAR:
+ case PLUS: {
+ register char nextch;
+ register int no;
+ register char *save;
+ register int min;
+
+ /*
+ * Lookahead to avoid useless match attempts
+ * when we know what character comes next.
+ */
+ nextch = '\0';
+ if (OP(next) == EXACTLY)
+ nextch = *OPERAND(next);
+ min = (OP(scan) == STAR) ? 0 : 1;
+ save = reginput;
+ no = regrepeat(OPERAND(scan));
+ while (no >= min) {
+ /* If it could work, try it. */
+ if (nextch == '\0' || *reginput == nextch)
+ if (regmatch(next))
+ return(1);
+ /* Couldn't or didn't -- back up. */
+ no--;
+ reginput = save + no;
+ }
+ return(0);
+ }
+ break;
+ case END:
+ return(1); /* Success! */
+ break;
+ default:
+ regerror("memory corruption");
+ return(0);
+ break;
+ }
+
+ scan = next;
+ }
+
+ /*
+ * We get here only if there's trouble -- normally "case END" is
+ * the terminating point.
+ */
+ regerror("corrupted pointers");
+ return(0);
+}
+
+/*
+ - regrepeat - repeatedly match something simple, report how many
+ */
+static int
+regrepeat(p)
+char *p;
+{
+ register int count = 0;
+ register char *scan;
+ register char *opnd;
+#ifdef MULTILINE
+ register char *eol;
+#endif
+
+ scan = reginput;
+ opnd = OPERAND(p);
+ switch (OP(p)) {
+ case ANY:
+#ifdef MULTILINE
+ if ((eol = strchr(scan, '\n')) != NULL) {
+ count += eol - scan;
+ scan = eol;
+ break;
+ }
+#endif
+ count = strlen(scan);
+ scan += count;
+ break;
+ case EXACTLY:
+ while (*opnd == *scan) {
+ count++;
+ scan++;
+ }
+ break;
+ case ANYOF:
+ while (*scan != '\0' && strchr(opnd, *scan) != NULL) {
+ count++;
+ scan++;
+ }
+ break;
+ case ANYBUT:
+#ifdef MULTILINE
+ while (*scan != '\0' && *scan != '\n' &&
+ strchr(opnd, *scan) == NULL) {
+#else
+ while (*scan != '\0' && strchr(opnd, *scan) == NULL) {
+#endif
+ count++;
+ scan++;
+ }
+ break;
+ default: /* Oh dear. Called inappropriately. */
+ regerror("internal foulup");
+ count = 0; /* Best compromise. */
+ break;
+ }
+ reginput = scan;
+
+ return(count);
+}
+
+/*
+ - regnext - dig the "next" pointer out of a node
+ */
+static char *
+regnext(p)
+register char *p;
+{
+ register int offset;
+
+ if (p == &regdummy)
+ return(NULL);
+
+ offset = NEXT(p);
+ if (offset == 0)
+ return(NULL);
+
+ if (OP(p) == BACK)
+ return(p-offset);
+ else
+ return(p+offset);
+}
+
+#ifdef DEBUG
+
+STATIC char *regprop();
+
+/*
+ - regdump - dump a regexp onto stdout in vaguely comprehensible form
+ */
+void
+regdump(r)
+regexp *r;
+{
+ register char *s;
+ register char op = EXACTLY; /* Arbitrary non-END op. */
+ register char *next;
+ extern char *strchr();
+
+
+ s = r->program + 1;
+ while (op != END) { /* While that wasn't END last time... */
+ op = OP(s);
+ printf("%2d%s", (int)(s-r->program), regprop(s)); /* Where, what. */
+ next = regnext(s);
+ if (next == NULL) /* Next ptr. */
+ printf("(0)");
+ else
+ printf("(%d)", (int)((s-r->program)+(next-s)));
+ s += 3;
+ if (op == ANYOF || op == ANYBUT || op == EXACTLY) {
+ /* Literal string, where present. */
+ while (*s != '\0') {
+#ifdef MULTILINE
+ if (*s == '\n')
+ printf("\\n");
+ else
+#endif
+ putchar(*s);
+ s++;
+ }
+ s++;
+ }
+ putchar('\n');
+ }
+
+ /* Header fields of interest. */
+ if (r->regstart != '\0')
+ printf("start `%c' ", r->regstart);
+ if (r->reganch)
+ printf("anchored ");
+ if (r->regmust != NULL)
+ printf("must have \"%s\"", r->regmust);
+ printf("\n");
+}
+
+/*
+ - regprop - printable representation of opcode
+ */
+static char *
+regprop(op)
+char *op;
+{
+ register char *p;
+ static char buf[50];
+
+ (void) strcpy(buf, ":");
+
+ switch (OP(op)) {
+ case BOL:
+ p = "BOL";
+ break;
+ case EOL:
+ p = "EOL";
+ break;
+ case ANY:
+ p = "ANY";
+ break;
+ case ANYOF:
+ p = "ANYOF";
+ break;
+ case ANYBUT:
+ p = "ANYBUT";
+ break;
+ case BRANCH:
+ p = "BRANCH";
+ break;
+ case EXACTLY:
+ p = "EXACTLY";
+ break;
+ case NOTHING:
+ p = "NOTHING";
+ break;
+ case BACK:
+ p = "BACK";
+ break;
+ case END:
+ p = "END";
+ break;
+ case OPEN+1:
+ case OPEN+2:
+ case OPEN+3:
+ case OPEN+4:
+ case OPEN+5:
+ case OPEN+6:
+ case OPEN+7:
+ case OPEN+8:
+ case OPEN+9:
+ sprintf(buf+strlen(buf), "OPEN%d", (int)(OP(op)-OPEN));
+ p = NULL;
+ break;
+ case CLOSE+1:
+ case CLOSE+2:
+ case CLOSE+3:
+ case CLOSE+4:
+ case CLOSE+5:
+ case CLOSE+6:
+ case CLOSE+7:
+ case CLOSE+8:
+ case CLOSE+9:
+ sprintf(buf+strlen(buf), "CLOSE%d", (int)(OP(op)-CLOSE));
+ p = NULL;
+ break;
+ case STAR:
+ p = "STAR";
+ break;
+ case PLUS:
+ p = "PLUS";
+ break;
+ default:
+ regerror("corrupted opcode");
+ break;
+ }
+ if (p != NULL)
+ (void) strcat(buf, p);
+ return(buf);
+}
+#endif
+
+/*
+ * The following is provided for those people who do not have strcspn() in
+ * their C libraries. They should get off their butts and do something
+ * about it; at least one public-domain implementation of those (highly
+ * useful) string routines has been published on Usenet.
+ */
+#ifdef STRCSPN
+/*
+ * strcspn - find length of initial segment of s1 consisting entirely
+ * of characters not from s2
+ */
+
+static int
+strcspn(s1, s2)
+char *s1;
+char *s2;
+{
+ register char *scan1;
+ register char *scan2;
+ register int count;
+
+ count = 0;
+ for (scan1 = s1; *scan1 != '\0'; scan1++) {
+ for (scan2 = s2; *scan2 != '\0';) /* ++ moved down. */
+ if (*scan1 == *scan2++)
+ return(count);
+ count++;
+ }
+ return(count);
+}
+#endif
diff --git a/src/regexp.h b/src/regexp.h
new file mode 100644
index 0000000..cbb1856
--- /dev/null
+++ b/src/regexp.h
@@ -0,0 +1,51 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/*
+ * Definitions etc. for regexp(3) routines.
+ *
+ * Caveat: this is V8 regexp(3) [actually, a reimplementation thereof],
+ * not the System V one.
+ */
+
+#define MULTILINE
+
+#define NSUBEXP 10
+typedef struct regexp {
+ char *startp[NSUBEXP];
+ char *endp[NSUBEXP];
+ char regstart; /* Internal use only. */
+ char reganch; /* Internal use only. */
+ char *regmust; /* Internal use only. */
+ int regmlen; /* Internal use only. */
+ char program[1]; /* Unwarranted chumminess with compiler. */
+} regexp;
+
+extern regexp *regcomp();
+extern int regexec();
+#ifdef MULTILINE
+extern int reglexec();
+#endif
+extern void regsub();
+extern void regerror();
diff --git a/src/regexpmodule.c b/src/regexpmodule.c
new file mode 100644
index 0000000..7c87217
--- /dev/null
+++ b/src/regexpmodule.c
@@ -0,0 +1,191 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Regular expression objects */
+/* This needs V8 or Henry Spencer's regexp! */
+
+#include "allobjects.h"
+#include "modsupport.h"
+
+#include "regexp.h"
+
+static object *RegexpError; /* Exception */
+
+typedef struct {
+ OB_HEAD
+ object *re_string; /* The string (for printing) */
+ regexp *re_prog; /* The compiled regular expression */
+} regexpobject;
+
+extern typeobject Regexptype; /* Really static, forward */
+
+static regexpobject *
+newregexpobject(string, prog)
+ object *string;
+ regexp *prog;
+{
+ regexpobject *re;
+ re = NEWOBJ(regexpobject, &Regexptype);
+ if (re != NULL) {
+ XINCREF(string);
+ re->re_string = string;
+ re->re_prog = prog;
+ }
+ return re;
+}
+
+/* Regexp methods */
+
+static void
+regexp_dealloc(re)
+ regexpobject *re;
+{
+ XDECREF(re->re_string);
+ XDEL(re->re_prog);
+ DEL(re);
+}
+
+static object *
+makeresult(prog, buffer)
+ regexp *prog;
+ char *buffer;
+{
+ int n;
+ object *v;
+ /* Count substrings found, including \0, the main one */
+ for (n = 0; n < 10 && prog->startp[n] != NULL; n++)
+ ;
+ v = newtupleobject(n);
+ if (v != NULL) {
+ int i;
+ for (i = 0; i < n; i++) {
+ object *w, *u;
+ long start, end;
+ start = prog->startp[i] - buffer;
+ end = prog->endp[i] - buffer;
+ if ( (w = newtupleobject(2)) == NULL ||
+ (u = newintobject(start)) == NULL ||
+ settupleitem(w, 0, u) != 0 ||
+ (u = newintobject(end)) == NULL ||
+ settupleitem(w, 1, u) != 0) {
+ XDECREF(w);
+ DECREF(v);
+ return NULL;
+ }
+ settupleitem(v, i, w);
+ }
+ }
+ return v;
+}
+
+static object *
+regexp_exec(re, args)
+ regexpobject *re;
+ object *args;
+{
+ object *v;
+ char *buffer;
+ int offset;
+ if (args != NULL && is_stringobject(args)) {
+ v = args;
+ offset = 0;
+ }
+ else if (!getstrintarg(args, &v, &offset))
+ return NULL;
+ buffer = getstringvalue(v);
+#ifndef MULTILINE
+#define reglexec(prog, str, offset) regexec((prog), (str)+(offset))
+#endif
+ if (!reglexec(re->re_prog, buffer, offset))
+ return newtupleobject(0);
+ return makeresult(re->re_prog, buffer);
+}
+
+static struct methodlist regexp_methods[] = {
+ "exec", regexp_exec,
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+regexp_getattr(re, name)
+ regexpobject *re;
+ char *name;
+{
+ return findmethod(regexp_methods, (object *)re, name);
+}
+
+static typeobject Regexptype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /*ob_size*/
+ "regexp", /*tp_name*/
+ sizeof(regexpobject), /*tp_size*/
+ 0, /*tp_itemsize*/
+ /* methods */
+ regexp_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ regexp_getattr, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+};
+
+void
+regerror(str)
+ char *str;
+{
+ err_setstr(RegexpError, str);
+}
+
+static object *
+regexp_compile(self, args)
+ object *self;
+ object *args;
+{
+ object *string;
+ regexp *prog;
+ if (!getstrarg(args, &string))
+ return NULL;
+ prog = regcomp(getstringvalue(string));
+ if (prog == NULL)
+ return NULL; /* regerror() has called err_seterr() */
+ return (object *)newregexpobject(string, prog);
+}
+
+static struct methodlist regexp_global_methods[] = {
+ {"compile", regexp_compile},
+ {NULL, NULL} /* sentinel */
+};
+
+initregexp()
+{
+ object *m, *d;
+
+ m = initmodule("regexp", regexp_global_methods);
+ d = getmoduledict(m);
+
+ /* Initialize regexp.error exception */
+ RegexpError = newstringobject("regexp.error");
+ if (RegexpError == NULL || dictinsert(d, "error", RegexpError) != 0)
+ fatal("can't define regexp.error");
+}
diff --git a/src/regmagic.h b/src/regmagic.h
new file mode 100644
index 0000000..d9da879
--- /dev/null
+++ b/src/regmagic.h
@@ -0,0 +1,29 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/*
+ * The first byte of the regexp internal "program" is actually this magic
+ * number; the start node begins in the second byte.
+ */
+#define MAGIC 0234
diff --git a/src/regsub.c b/src/regsub.c
new file mode 100644
index 0000000..d589f26
--- /dev/null
+++ b/src/regsub.c
@@ -0,0 +1,115 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/*
+ * regsub
+ *
+ * Copyright (c) 1986 by University of Toronto.
+ * Written by Henry Spencer. Not derived from licensed software.
+#ifdef MULTILINE
+ * Changed by Guido van Rossum, CWI, Amsterdam
+ * for multi-line support.
+#endif
+ *
+ * Permission is granted to anyone to use this software for any
+ * purpose on any computer system, and to redistribute it freely,
+ * subject to the following restrictions:
+ *
+ * 1. The author is not responsible for the consequences of use of
+ * this software, no matter how awful, even if they arise
+ * from defects in it.
+ *
+ * 2. The origin of this software must not be misrepresented, either
+ * by explicit claim or by omission.
+ *
+ * 3. Altered versions must be plainly marked as such, and must not
+ * be misrepresented as being the original software.
+ */
+#include <stdio.h>
+#include "regexp.h"
+#include "regmagic.h"
+
+#ifndef CHARBITS
+#define UCHARAT(p) ((int)*(unsigned char *)(p))
+#else
+#define UCHARAT(p) ((int)*(p)&CHARBITS)
+#endif
+
+/*
+ - regsub - perform substitutions after a regexp match
+ */
+void
+regsub(prog, source, dest)
+regexp *prog;
+char *source;
+char *dest;
+{
+ register char *src;
+ register char *dst;
+ register char c;
+ register int no;
+ register int len;
+ extern char *strncpy();
+
+ if (prog == NULL || source == NULL || dest == NULL) {
+ regerror("NULL parm to regsub");
+ return;
+ }
+ if (UCHARAT(prog->program) != MAGIC) {
+ regerror("damaged regexp fed to regsub");
+ return;
+ }
+
+ src = source;
+ dst = dest;
+ while ((c = *src++) != '\0') {
+ if (c == '&')
+ no = 0;
+ else if (c == '\\' && '0' <= *src && *src <= '9')
+ no = *src++ - '0';
+ else
+ no = -1;
+
+ if (no < 0) { /* Ordinary character. */
+ if (c == '\\' && (*src == '\\' || *src == '&'))
+ c = *src++;
+#ifdef MULTILINE
+ else if (c == '\\' && *src == 'n') {
+ c = '\n';
+ src++;
+ }
+#endif
+ *dst++ = c;
+ } else if (prog->startp[no] != NULL && prog->endp[no] != NULL) {
+ len = prog->endp[no] - prog->startp[no];
+ (void) strncpy(dst, prog->startp[no], len);
+ dst += len;
+ if (len != 0 && *(dst-1) == '\0') { /* strncpy hit NUL. */
+ regerror("damaged match string");
+ return;
+ }
+ }
+ }
+ *dst++ = '\0';
+}
diff --git a/src/rltokenizer.c b/src/rltokenizer.c
new file mode 100644
index 0000000..6069148
--- /dev/null
+++ b/src/rltokenizer.c
@@ -0,0 +1,26 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+#define USE_READLINE
+#include "tokenizer.c"
diff --git a/src/sc_errors.c b/src/sc_errors.c
new file mode 100644
index 0000000..be815a1
--- /dev/null
+++ b/src/sc_errors.c
@@ -0,0 +1,145 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+
+#include <stdio.h>
+
+#include "PROTO.h"
+#include "object.h"
+#include "errors.h"
+#include "sc_errors.h"
+#include "stringobject.h"
+#include "tupleobject.h"
+
+object *
+err_scerr(sc_errno)
+ int sc_errno;
+{
+ switch(sc_errno) {
+
+ case NoBufSize:
+ err_setstr(StubcodeError, "Stubcode didn't start with BufSize");
+ break;
+
+ case TwoBufSize:
+ err_setstr(StubcodeError, "Stubcode can't have more then one BufSize");
+ break;
+
+ case ElementIsNull:
+ err_setstr(StubcodeError, "Trying to access an NIL object");
+ break;
+
+ case StackOverflow:
+ err_setstr(StubcodeError, "Stack overflow");
+ return NULL;
+
+ case StackUnderflow:
+ err_setstr(StubcodeError, "Stack underflow");
+ return NULL;
+
+ case NoEndLoop:
+ err_setstr(StubcodeError, "LoopXXX with no EndLoop");
+ return NULL;
+
+ case BufferOverflow:
+ err_setstr(StubcodeError, "Buffer overflow");
+ return NULL;
+
+ }
+ return NULL;
+}
+
+err_scerrset(sc_errno, value, instr)
+ int sc_errno;
+ object *value;
+ char *instr;
+{
+ object *str, *str1, *t;
+
+ if ((t = newtupleobject(3)) == NULL) {
+ return -1;
+ }
+ if ((str = newstringobject(instr)) == NULL) {
+ return -1;
+ }
+ if (settupleitem(t, 2, str) != 0) {
+ return -1;
+ }
+ INCREF(value);
+ if (settupleitem(t, 1, value) != 0) {
+ DECREF(t);
+ return -1;
+ }
+ switch(sc_errno) {
+
+ case TypeFailure:
+ if ((str1 = newstringobject("Unexpected type")) == NULL) {
+ DECREF(t);
+ return -1;
+ }
+ break;
+
+ case RangeError:
+ if ((str1 = newstringobject("Value out of range")) == NULL) {
+ DECREF(t);
+ return -1;
+ }
+ break;
+
+ case SizeError:
+ if ((str1 = newstringobject("Value doesn't have the right size")) == NULL) {
+ DECREF(t);
+ return -1;
+ }
+ break;
+
+ case FlagError:
+ if ((str1 = newstringobject("Illegal flag value")) == NULL) {
+ DECREF(t);
+ return -1;
+ }
+ break;
+
+ case TransError:
+ if ((str1 = newstringobject("hdr.h_status != 0")) == NULL) {
+ DECREF(t);
+ return -1;
+ }
+ break;
+
+ default:
+ if ((str1 = newstringobject("sc_errno not found")) == NULL) {
+ DECREF(t);
+ return -1;
+ }
+ break;
+ }
+ if (settupleitem(t, 0, str1) != 0) {
+ DECREF(t);
+ return -1;
+ }
+ err_setval(StubcodeError, t);
+ DECREF(t);
+ return -1;
+}
diff --git a/src/sc_errors.h b/src/sc_errors.h
new file mode 100644
index 0000000..d9fcd01
--- /dev/null
+++ b/src/sc_errors.h
@@ -0,0 +1,41 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+
+#define NoBufSize 1
+#define TwoBufSize 2
+#define StackOverflow 3
+#define StackUnderflow 4
+#define TypeFailure 5
+#define RangeError 6
+#define SizeError 7
+#define BufferOverflow 8
+#define NoEndLoop 9
+#define FlagError 10
+#define ElementIsNull 11
+#define TransError 12
+
+extern object *err_scerr PROTO((int sc_errno));
+extern err_scerrset PROTO((int sc_errno, object *value, char *instr));
+extern object *StubcodeError;
diff --git a/src/sc_global.h b/src/sc_global.h
new file mode 100644
index 0000000..ec03b15
--- /dev/null
+++ b/src/sc_global.h
@@ -0,0 +1,137 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+
+/*
+** This file contains the data used in Ail, Python and sc2txt.
+**
+** If you want to add an instuction to the instructions just define
+** it here and add the instruction in the function sc_interpreter in
+** the file sc_interpreter.c in the switch. You also have to make a
+** new function with the name x{instruction_name} in the file
+** sc_interpreter.
+*/
+
+/*
+** When you want to change the types of the opcode or the operand
+** you maybe need to adjust the options to mypf. And the defines :
+** SwapOpcode, SwapOperand.
+*/
+
+typedef unsigned char TscOpcode;
+typedef long TscOperand;
+
+#define SC_MAGIC 0x19901991
+
+#define SwapOpcode(x) x = x
+#define SwapOperand(l) ((l))=(((((l))>>24)&0xFF)|((((l))>>8)&0xFF00)|((((l))<<8)&0xFF0000)|((((l))<<24)&0xFF000000))
+
+#define STKSIZE 256
+
+#define OPERAND 0x80
+#define FLAGS 0x40
+
+/*
+** The headerfields. The value of the flag is the index of the fields
+** array from the file mhdr.c plus one
+*/
+
+#define H_EXTRA 0x00000001
+#define H_SIZE 0x00000002
+#define H_OFFSET 0x00000003
+#define H_PORT 0x00000004
+#define H_PRIV 0x00000005
+#define PSEUDOFIELD 0x00000006
+#define ALL_FIELDS 0x000000ff
+
+/*
+** The specefiers for the integers
+*/
+
+#define NOSIGN 0x00000100
+#define INT32 0x00000200
+#define ALLTYPES 0xffffff00
+
+/*
+** The opcode with no operand
+*/
+
+#define ListS 0x00
+#define PutVS 0x01
+#define GetVS 0x02
+#define StringS 0x03
+#define Equal 0x04
+#define NoArgs 0x05
+
+/*
+ * Between 0x10 and 0x3f there is space for predefined marshal
+ * and unmarshal functions or macros that do not have an operand
+ */
+
+#define MarshTC 0x10
+#define UnMarshTC 0x11
+
+/*
+** The opcode with a number as operand
+*/
+
+#define BufSize 0x80
+#define Trans 0x81
+#define TTupleS 0x82
+#define Unpack 0x83
+#define PutFS 0x84
+#define TStringSeq 0x85
+#define TStringSlt 0x86
+#define TListSeq 0x87
+#define TListSlt 0x88
+#define LoopPut 0x89
+#define EndLoop 0x8a
+#define Dup 0x8b
+#define Pop 0x8c
+#define Align 0x8d
+#define Pack 0x8e
+#define LoopGet 0x8f
+#define GetFS 0x90
+#define PushI 0x91
+
+/*
+** Between 0xa0 and 0xbf there is space for predefined marshal
+** and unmarshal functions or macros with a numberas operand
+*/
+
+
+/*
+** The opcodes with flags as operand
+*/
+
+#define AilWord 0xc0
+#define PutI 0xc1
+#define PutC 0xc2
+#define GetI 0xc3
+#define GetC 0xc4
+
+/*
+** Between 0xe0 and 0xff there is space for predefined marshal
+** and unmarshal functions or macros with flags as operand
+*/
diff --git a/src/sc_interpr.c b/src/sc_interpr.c
new file mode 100644
index 0000000..10eb1b2
--- /dev/null
+++ b/src/sc_interpr.c
@@ -0,0 +1,1352 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+#if 0
+#define STACK_TRACE
+#define SCDEBUG
+#endif
+#include <stdio.h>
+
+#include <ailamoeba.h>
+
+#include "PROTO.h"
+#include "sc_global.h"
+#include "object.h"
+#include "objimpl.h"
+#include "stringobject.h"
+#include "errors.h"
+#include "sc_errors.h"
+#include "stubcode.h"
+#include "tupleobject.h"
+#include "intobject.h"
+#include "listobject.h"
+
+typedef struct s_loopstruct {
+ struct s_loopstruct *l_next; /* Make a list of it */
+ TscOperand l_label; /* Indentify the loop */
+ int l_index; /* The index of the list */
+ int l_size; /* The size of the list */
+ int l_retaddr; /* Addres to jump back */
+ int l_endaddr; /* Addres to jump to end */
+ object *l_list; /* The list to append to */
+} TsLoop, *TpsLoop;
+
+
+/*
+** This file contains the Stubcode interpreter.
+** All the instructions have there own function. The interpreter
+** reads an instruction from the data and if needed also an operand.
+** After this it calls the function that executes the instruction.
+*/
+
+struct sc_ProcessBlock {
+ object **stack;
+ unsigned char *buffer, *data;
+ int sp, bp, pc, maxbufsize, datsize;
+ header hdr;
+ TpsLoop loops;
+};
+
+extern getcapability();
+
+/*
+ * Clean up the mess the loops make.
+ */
+
+static void
+xCleanUpLoops(sc_pb)
+ struct sc_ProcessBlock *sc_pb;
+{
+ TpsLoop prev, this;
+
+ if (sc_pb->loops == NULL)
+ return;
+ prev = sc_pb->loops;
+ this = sc_pb->loops->l_next;
+ while(this) {
+ free((char *)prev);
+ prev = this;
+ this = this->l_next;
+ }
+ free((char *)prev);
+}
+
+static int
+findendloop(label, sc_pb)
+ TscOperand label;
+ struct sc_ProcessBlock *sc_pb;
+{
+ TscOperand operand;
+ TscOpcode opcode;
+ int walk = sc_pb->pc, found = 0;
+
+ while (!found && (walk < sc_pb->datsize)) {
+ memcpy(&opcode, &sc_pb->data[walk], sizeof(TscOpcode));
+ walk += sizeof(TscOpcode);
+ if (opcode & (FLAGS | OPERAND)) {
+ memcpy(&operand, &sc_pb->data[walk], sizeof(TscOperand));
+ walk += sizeof(TscOperand);
+ }
+ if (opcode == EndLoop)
+ if (operand == label) found = 1;
+ }
+ if (found)
+ return walk;
+ return -1;
+}
+
+static int
+findloop(ret, label, sc_pb)
+ TpsLoop *ret;
+ TscOperand label;
+ struct sc_ProcessBlock *sc_pb;
+{
+ TpsLoop walk;
+
+ for (walk = sc_pb->loops; walk != NULL; walk = walk->l_next) {
+ if (walk->l_label == label) break;
+ }
+ if (walk == NULL) {
+ TpsLoop newloop;
+
+ newloop = (TpsLoop)malloc(sizeof(TsLoop));
+ if (newloop == NULL) {
+ err_nomem();
+ return -1;
+ }
+ newloop->l_label = label;
+ newloop->l_index = 0;
+ newloop->l_retaddr = sc_pb->pc - (sizeof(TscOpcode) + sizeof(TscOperand));
+ /*
+ ** We need a correction because the pc points to
+ ** the instruction after the XXXLoop.
+ */
+ if ((newloop->l_endaddr = findendloop(label, sc_pb)) < 0) {
+ free((char *)newloop);
+ err_scerr(NoEndLoop);
+ return -1;
+ }
+ newloop->l_list = NULL;
+ newloop->l_next = sc_pb->loops;
+ sc_pb->loops = newloop;
+ *ret = newloop;
+ return 1;
+ }
+ *ret = walk;
+ return 0;
+}
+
+#ifdef 0
+
+static void
+removeloop(this, sc_pb)
+ TpsLoop this;
+ struct sc_ProcessBlock *sc_pb;
+{
+ TpsLoop walk, prev = NULL;
+
+ for (walk = sc_pb->loops; walk != NULL; walk = walk->l_next) {
+ if (walk->l_label == this->l_label) {
+ if (prev != NULL) {
+ prev->l_next = walk->l_next;
+ } else {
+ loop = walk->l_next;
+ }
+ free((char *)this);
+ break;
+ }
+ prev = walk;
+ }
+}
+
+#endif
+
+static int
+init(self, sc_pb)
+ object *self;
+ struct sc_ProcessBlock *sc_pb;
+{
+object *string;
+int datasize;
+
+ string = gettupleitem(self, STUBC);
+ if (string == NULL)
+ return -1;
+ sc_pb->data = getstringvalue(string);
+ if (sc_pb->data == NULL)
+ return -1;
+ datasize = (int)getstringsize(string);
+ if (datasize == -1)
+ return -1;
+ sc_pb->stack = (object **)malloc(STKSIZE * sizeof(object *));
+ if (sc_pb->stack == NULL) {
+ err_nomem();
+ return -1;
+ }
+ sc_pb->bp = sc_pb->sp = sc_pb->pc = 0;
+ sc_pb->loops = NULL;
+ return datasize;
+}
+
+static void reinit(sc_pb)
+ struct sc_ProcessBlock *sc_pb;
+{
+ int i;
+
+ sc_pb->bp = 0;
+ for (i = 0; i < sc_pb->sp; i++) {
+ DECREF(sc_pb->stack[i]);
+ }
+ sc_pb->sp = 0;
+}
+
+static void UnInit(self, sc_pb)
+ object *self;
+ struct sc_ProcessBlock *sc_pb;
+{
+ int i;
+
+ free(sc_pb->buffer);
+ reinit(sc_pb);
+ free((char *)sc_pb->stack);
+ xCleanUpLoops(sc_pb);
+}
+
+static object *
+stacktop(sc_pb)
+ struct sc_ProcessBlock *sc_pb;
+{
+
+ if (sc_pb->sp == 0)
+ return err_scerr(StackUnderflow);
+ if (sc_pb->sp == (STKSIZE + 1))
+ return err_scerr(StackOverflow);
+ return sc_pb->stack[sc_pb->sp - 1];
+}
+
+/*
+ * Push an object on the stack.
+ */
+static int
+xPush(element, sc_pb)
+ object *element;
+ struct sc_ProcessBlock *sc_pb;
+{
+
+ if (sc_pb->sp >= STKSIZE) {
+ err_scerr(StackOverflow);
+ return -1;
+ }
+ if (element == NULL) {
+ err_scerr(ElementIsNull);
+ return -1;
+ }
+ INCREF(element);
+#ifdef STACK_TRACE
+ printf("pushed :");
+ printobject(element, stdout, 0);
+ printf("\n");
+#endif
+ sc_pb->stack[sc_pb->sp++] = element;
+ return 0;
+}
+
+/*
+ * Perform the RPC.
+ */
+static int
+xTrans(self,cmd, sc_pb)
+ object *self;
+ TscOperand cmd;
+ struct sc_ProcessBlock *sc_pb;
+{
+ short ret;
+ capability cap;
+ object *capobj;
+
+ if ((capobj = gettupleitem(self, CAP)) == NULL)
+ return -1;
+ if (getcapability(capobj, &cap) == -1)
+ return -1;
+ sc_pb->hdr.h_port = cap.cap_port;
+ sc_pb->hdr.h_priv = cap.cap_priv;
+ sc_pb->hdr.h_command = (command)cmd;
+#ifdef SCDEBUG
+ printf("bp = %d maxbufsize = %d\n",sc_pb->bp, sc_pb->maxbufsize);
+ {
+ int i;
+
+ for (i = 0; i < sc_pb->bp; i++) {
+ printf("%x ", sc_pb->buffer[i]);
+ }
+ }
+ printf("\n");
+#endif
+ ret = trans(&sc_pb->hdr, sc_pb->buffer, (bufsize) sc_pb->bp,
+ &sc_pb->hdr, sc_pb->buffer, (bufsize)sc_pb->maxbufsize);
+#ifdef SCDEBUG
+ printf("after Trans:ret = %d\n",ret);
+ {
+ int i;
+
+ for (i = 0; i < ret; i++) {
+ printf("%x ", sc_pb->buffer[i]);
+ }
+ }
+ printf("\n");
+#endif
+ if (ERR_STATUS(ret)) {
+ amoeba_error(ERR_CONVERT(ret));
+ return -1;
+ }
+ if (sc_pb->hdr.h_status != 0) {
+ object *v;
+
+ if ((v = newintobject(sc_pb->hdr.h_status)) == NULL)
+ return -1;
+ err_scerrset(TransError, v, "Trans");
+ DECREF(v);
+ return -1;
+ }
+ reinit(sc_pb);
+ return 0;
+}
+
+/*
+ * Test the tuple size.
+ */
+static int
+xTTupleS(size, sc_pb)
+ TscOperand size;
+ struct sc_ProcessBlock *sc_pb;
+{
+ object *tuple;
+
+ if ((tuple = stacktop(sc_pb)) == NULL)
+ return -1;
+ if (!is_tupleobject(tuple))
+ return err_scerrset(TypeFailure, tuple, "TTupleS");
+ if (gettuplesize(tuple) != (unsigned int)size)
+ return err_scerrset(SizeError, tuple, "TTupleS");
+ return 0;
+}
+
+/*
+ * Unpack a tuple
+ */
+static int
+xUnpack(size, sc_pb)
+ TscOperand size;
+ struct sc_ProcessBlock *sc_pb;
+{
+ object *tuple, *element;
+ int i;
+
+ if (size < (TscOperand)2) {
+ element = newintobject(size);
+ if (element == NULL)
+ return -1;
+ return err_scerrset(SizeError, element, "Unpack");
+ }
+ if ((tuple = stacktop(sc_pb)) == NULL)
+ return -1;
+ INCREF(tuple);
+ if (xPop((TscOperand) 1, sc_pb) != 0) {
+ DECREF(tuple);
+ return -1;
+ }
+ for (i = 0; i < (int)size; i++) {
+ if ((element = gettupleitem(tuple, i)) == NULL) {
+ DECREF(tuple);
+ return -1;
+ }
+ if (xPush(element, sc_pb) != 0) {
+ DECREF(tuple);
+ return -1;
+ }
+ }
+ DECREF(tuple);
+ return 0;
+}
+
+/*
+ * Marshal the Ailword to a headerfiels.
+ */
+static int
+xAilword(headerfield, sc_pb)
+ TscOperand headerfield;
+ struct sc_ProcessBlock *sc_pb;
+{
+
+ switch(headerfield) {
+
+ case H_EXTRA:
+ sc_pb->hdr.h_extra = (uint16)_ailword;
+ return 0;
+
+ case H_SIZE:
+ sc_pb->hdr.h_size = (bufsize)_ailword;
+ return 0;
+
+ case H_OFFSET:
+ sc_pb->hdr.h_offset = (int32)_ailword;
+ return 0;
+
+ default:
+ {
+ object *v;
+
+ if ((v = newintobject(headerfield)) == NULL)
+ return -1;
+ return err_scerrset(FlagError, v, "Ailword");
+ }
+ }
+}
+
+static int
+xStringS(sc_pb)
+ struct sc_ProcessBlock *sc_pb;
+{
+ object *size, *string;
+ int s;
+
+ if ((string = stacktop(sc_pb)) == NULL)
+ return -1;
+ if (!is_stringobject(string))
+ return err_scerrset(TypeFailure, string, "StringS");
+ if ((s = getstringsize(string)) < 0)
+ return -1;
+ if (xPop((TscOperand) 1, sc_pb) != 0)
+ return -1;
+ if ((size = newintobject(s)) == NULL)
+ return -1;
+ if (xPush(size, sc_pb) != 0) {
+ DECREF(size);
+ return -1;
+ }
+ DECREF(size);
+ return 0;
+}
+
+/*
+ *
+ */
+static int
+xListS(sc_pb)
+ struct sc_ProcessBlock *sc_pb;
+{
+ object *size, *list;
+ int s;
+
+ if ((list = stacktop(sc_pb)) == NULL)
+ return -1;
+ if (!is_listobject(list))
+ return err_scerrset(TypeFailure, list, "ListS");
+ if ((s = getlistsize(list)) < 0)
+ return -1;
+ if (xPop((TscOperand) 1, sc_pb) != 0)
+ return -1;
+ if ((size = newintobject(s)) == NULL)
+ return -1;
+ if (xPush(size, sc_pb) != 0) {
+ DECREF(size);
+ return -1;
+ }
+ DECREF(size);
+ return 0;
+}
+
+/*
+ * Marshal a fixed string to the buffer.
+ */
+static int
+xPutFS(size, sc_pb)
+ TscOperand size;
+ struct sc_ProcessBlock *sc_pb;
+{
+ object *string;
+ char *str;
+
+ if ((string = stacktop(sc_pb)) == NULL) {
+ return -1;
+ }
+ if (!is_stringobject(string))
+ return err_scerrset(TypeFailure, string, "PutFS");
+ if (getstringsize(string) != size)
+ return err_scerrset(SizeError, string, "PutFS");
+ if ((str = getstringvalue(string)) == NULL)
+ return -1;
+ if ((size + sc_pb->bp) > sc_pb->maxbufsize) {
+ err_scerr(BufferOverflow);
+ return -1;
+ }
+ memcpy(&sc_pb->buffer[sc_pb->bp], str, (int)size);
+ sc_pb->bp += size;
+ return xPop((TscOperand) 1, sc_pb);
+}
+
+
+/*
+ * Test the size of a string or list
+ */
+static int
+xTStringSeq(size, sc_pb)
+ TscOperand size;
+ struct sc_ProcessBlock *sc_pb;
+{
+ object *string;
+
+ if ((string = stacktop(sc_pb)) == NULL)
+ return -1;
+ if (!is_stringobject(string))
+ return err_scerrset(TypeFailure, string, "TStringSeq");
+ if (getstringsize(string) != size)
+ return err_scerrset(SizeError, string, "TStringSeq");
+ return 0;
+}
+
+static int
+xTStringSlt(size, sc_pb)
+ TscOperand size;
+ struct sc_ProcessBlock *sc_pb;
+{
+ object *string;
+
+ if ((string = stacktop(sc_pb)) == NULL)
+ return -1;
+ if (!is_stringobject(string))
+ return err_scerrset(TypeFailure, string, "TStringSlt");
+ if (getstringsize(string) > size)
+ return err_scerrset(SizeError, string, "TStringSlt");
+ return 0;
+}
+
+static int
+xTListSeq(size, sc_pb)
+ TscOperand size;
+ struct sc_ProcessBlock *sc_pb;
+{
+ object *list;
+
+ if ((list = stacktop(sc_pb)) == NULL)
+ return -1;
+ if (!is_listobject(list))
+ return err_scerrset(TypeFailure, list, "TListSeq");
+ if (getlistsize(list) != size)
+ return err_scerrset(SizeError, list, "TListSeq");
+ return 0;
+}
+
+static int
+xTListSlt(size, sc_pb)
+ TscOperand size;
+ struct sc_ProcessBlock *sc_pb;
+{
+ object *list;
+
+ if ((list = stacktop(sc_pb)) == NULL)
+ return -1;
+ if (!is_listobject(list))
+ return err_scerrset(TypeFailure, list, "TListSlt");
+ if (getlistsize(list) > size)
+ return err_scerrset(SizeError, list, "TListSlt");
+ return 0;
+}
+
+static int
+xPutVS(sc_pb)
+ struct sc_ProcessBlock *sc_pb;
+{
+ object *string;
+ char *str;
+ int size;
+
+ if ((string = stacktop(sc_pb)) == NULL)
+ return -1;
+ if ((size = getstringsize(string)) < 0)
+ return (size == -1 ? -1 : err_scerrset(SizeError, string, "PutVS"));
+ if ((str = getstringvalue(string)) == NULL)
+ return -1;
+ if (sc_pb->bp + size > sc_pb->maxbufsize) {
+ err_scerr(BufferOverflow);
+ return -1;
+ }
+ memcpy(&sc_pb->buffer[sc_pb->bp], str, size);
+ sc_pb->bp += size;
+ return xPop((TscOperand) 1, sc_pb);
+}
+
+/*
+ * The loop instructions.
+ */
+static int
+xLoopPut(label, sc_pb)
+ TscOperand label;
+ struct sc_ProcessBlock *sc_pb;
+{
+ TpsLoop this;
+ object *list, *element;
+
+ if (findloop(&this, label, sc_pb) < 0)
+ return -1;
+ if ((list = stacktop(sc_pb)) == NULL)
+ return -1;
+ if (!is_listobject(list))
+ return err_scerrset(TypeFailure, list, "LoopPut");
+ if (this->l_index >= getlistsize(list)) {
+ sc_pb->pc = this->l_endaddr;
+ /*
+ ** Pop the list from the stack
+ */
+ return xPop((TscOperand)1, sc_pb);
+ }
+ if ((element = getlistitem(list, this->l_index)) == NULL)
+ return -1;
+ return xPush(element, sc_pb);
+}
+
+static int
+xLoopGet(label, sc_pb)
+ TscOperand label;
+ struct sc_ProcessBlock *sc_pb;
+{
+ TpsLoop this;
+ object *element, *integer;
+ int i;
+
+ if ((i = findloop(&this, label, sc_pb)) < 0)
+ return -1;
+ else if (i == 1) {
+ /*
+ * It is the first time we enter LoopGet label
+ */
+ if ((this->l_list = newlistobject(0)) == NULL)
+ return -1;
+ if ((integer = stacktop(sc_pb)) == NULL)
+ return -1;
+ if (!is_intobject(integer))
+ return err_scerrset(TypeFailure, integer, "LoopGet");
+ this->l_size = getintvalue(integer);
+ if (xPop((TscOperand) 1, sc_pb) != 0)
+ return -1;
+ } else {
+ if ((element = stacktop(sc_pb)) == NULL)
+ return -1;
+ if (addlistitem(this->l_list, element) != 0)
+ return -1;
+ if (xPop((TscOperand) 1, sc_pb) != 0)
+ return -1;
+ }
+ if (this->l_index >= this->l_size) {
+ int ret;
+
+ sc_pb->pc = this->l_endaddr;
+ ret = xPush(this->l_list, sc_pb);
+ DECREF(this->l_list);
+ return ret;
+ }
+ return 0;
+}
+
+static int
+xEndLoop(label, sc_pb)
+ TscOperand label;
+ struct sc_ProcessBlock *sc_pb;
+{
+ TpsLoop this;
+
+ if (findloop(&this, label, sc_pb) < 0)
+ return -1;
+ this ->l_index += 1;
+ sc_pb->pc = this->l_retaddr;
+ return 0;
+}
+
+static int
+xPutI(flags, sc_pb)
+ TscOperand flags;
+ struct sc_ProcessBlock *sc_pb;
+{
+ object *integer;
+
+ if ((integer = stacktop(sc_pb)) == NULL)
+ return -1;
+ if (!is_intobject(integer))
+ return err_scerrset(TypeFailure, integer, "PutI");
+ if (flags & ALL_FIELDS) {
+ long i;
+
+ /*
+ * The integer must be marshalles in the header.
+ * No type casting according to the type flag because
+ * we have to cast to the headerfield types.
+ */
+ i = getintvalue(integer);
+ switch(flags & ALL_FIELDS) {
+
+ case H_EXTRA:
+ sc_pb->hdr.h_extra = (uint16)i;
+ break;
+
+ case H_SIZE:
+ sc_pb->hdr.h_size = (bufsize)i;
+ break;
+
+ case H_OFFSET:
+ sc_pb->hdr.h_offset = (int32)i;
+ break;
+
+ default:
+ if ((integer = newintobject(flags & ALL_FIELDS)) == NULL)
+ return -1;
+ err_scerrset(FlagError, integer, "Ailword");
+ DECREF(integer);
+ return -1;
+ }
+ } else {
+ long i;
+
+ i = getintvalue(integer);
+ switch(flags & ALLTYPES) {
+
+ case 0:
+ {
+ int16 x;
+
+ x = (int16)i;
+ if ((sc_pb->bp + sizeof(int16)) > sc_pb->maxbufsize) {
+ err_scerr(BufferOverflow);
+ return -1;
+ }
+ memcpy(&sc_pb->buffer[sc_pb->bp], &x, sizeof(int16));
+ sc_pb->bp += sizeof(int16);
+ break;
+ }
+
+ case NOSIGN:
+ {
+ uint16 x;
+
+ x = (uint16)i;
+ if ((sc_pb->bp + sizeof(uint16)) > sc_pb->maxbufsize) {
+ err_scerr(BufferOverflow);
+ return -1;
+ }
+ memcpy(&sc_pb->buffer[sc_pb->bp], &x, sizeof(uint16));
+ sc_pb->bp += sizeof(uint16);
+ break;
+ }
+
+ case INT32:
+ {
+ int32 x;
+
+ x = (int32)i;
+ if ((sc_pb->bp + sizeof(int32)) > sc_pb->maxbufsize) {
+ err_scerr(BufferOverflow);
+ return -1;
+ }
+ memcpy(&sc_pb->buffer[sc_pb->bp], &x, sizeof(int32));
+ sc_pb->bp += sizeof(int32);
+ break;
+ }
+
+ case INT32 | NOSIGN:
+ {
+ uint32 x;
+
+ x = (uint32)i;
+ if ((sc_pb->bp + sizeof(uint32)) > sc_pb->maxbufsize) {
+ err_scerr(BufferOverflow);
+ return -1;
+ }
+ memcpy(&sc_pb->buffer[sc_pb->bp], &x, sizeof(uint32));
+ sc_pb->bp += sizeof(uint32);
+ break;
+ }
+ default:
+ {
+ object *x;
+
+ if ((x = newintobject(flags)) == NULL)
+ return -1;
+ err_scerrset(FlagError, x, "PutI");
+ DECREF(x);
+ return -1;
+ }
+ }
+ }
+ return xPop((TscOperand)1, sc_pb);
+}
+
+static int
+xPutC(sc_pb)
+ struct sc_ProcessBlock *sc_pb;
+{
+ capability cap;
+ object *capobj;
+
+ if ((capobj = stacktop(sc_pb)) == NULL)
+ return -1;
+ if (!is_capobj(capobj))
+ return err_scerrset(TypeFailure, capobj, "xPutC");
+ if (getcapability(capobj, &cap) != 0)
+ return -1;
+ if ((sc_pb->bp + CAPSIZE) > sc_pb->maxbufsize) {
+ err_scerr(BufferOverflow);
+ return -1;
+ }
+ memcpy(&sc_pb->buffer[sc_pb->bp], &cap, CAPSIZE);
+ sc_pb->bp += CAPSIZE;
+ return xPop((TscOperand) 1, sc_pb);
+}
+
+static int
+xDup(n, sc_pb)
+ TscOperand n;
+ struct sc_ProcessBlock *sc_pb;
+{
+
+ if ((int)n > sc_pb->sp) {
+ object *i;
+
+ if ((i = newintobject((long)n)) == NULL)
+ return -1;
+ err_scerrset(RangeError, i, "Dup");
+ DECREF(i);
+ return -1;
+ }
+ return xPush(sc_pb->stack[sc_pb->sp - n], sc_pb);
+}
+
+static int
+xPop(n, sc_pb)
+ TscOperand n;
+ struct sc_ProcessBlock *sc_pb;
+{
+ int i;
+
+ if ((sc_pb->sp - (int)n) < 0) {
+ err_scerr(StackUnderflow);
+ return -1;
+ }
+ for (i = 0; i < (int)n; i++) {
+ sc_pb->sp--;
+#ifdef STACK_TRACE
+ printf("popped :");
+ printobject(sc_pb->stack[sc_pb->sp], stdout, 0);
+ printf("\n");
+#endif
+ DECREF(sc_pb->stack[sc_pb->sp]);
+ }
+ return 0;
+}
+
+static int
+xAlign(n, sc_pb)
+ TscOperand n;
+ struct sc_ProcessBlock *sc_pb;
+{
+ int align = sc_pb->bp % (int)n;
+
+#ifdef SCDEBUG
+ printf("Old bp = %d\n", sc_pb->bp);
+#endif
+ sc_pb->bp += (align == 0) ? 0 : ((int)n - align);
+#ifdef SCDEBUG
+ printf("New bp = %d\n", sc_pb->bp);
+#endif
+ return 0;
+}
+
+static int
+xPack(size, sc_pb)
+ TscOperand size;
+ struct sc_ProcessBlock *sc_pb;
+{
+ object *element, *tuple;
+ int i, ret;
+
+ if ((tuple = newtupleobject((int)size)) == NULL)
+ return -1;
+ for (i = 0; i < (int)size; i++) {
+ if ((element = stacktop(sc_pb)) == NULL)
+ return -1;
+ if (settupleitem(tuple, (int)size - i - 1, element) != 0)
+ return -1;
+ INCREF(element);
+ if (xPop((TscOperand) 1, sc_pb) != 0)
+ return -1;
+ }
+ ret = xPush(tuple, sc_pb);
+ DECREF(tuple);
+ return ret;
+}
+
+static int
+xGetVS(sc_pb)
+ struct sc_ProcessBlock *sc_pb;
+{
+ object *string, *integer;
+ int size;
+
+ if ((integer = stacktop(sc_pb)) == NULL)
+ return -1;
+ if (!is_intobject(integer))
+ return err_scerrset(TypeFailure, integer, "GetVS");
+ size = getintvalue(integer);
+ if ((sc_pb->bp + size) > sc_pb->maxbufsize) {
+ err_scerr(BufferOverflow);
+ return -1;
+ }
+ if ((string = newsizedstringobject(&sc_pb->buffer[sc_pb->bp], size)) == NULL)
+ return -1;
+ sc_pb->bp += size;
+ if (xPop((TscOperand) 1, sc_pb) != 0)
+ return -1;
+ if (xPush(string, sc_pb) != 0) {
+ return -1;
+ }
+ DECREF(string);
+ return 0;
+}
+
+static int
+xGetFS(size, sc_pb)
+ TscOperand size;
+ struct sc_ProcessBlock *sc_pb;
+{
+ object *string;
+
+ if ((sc_pb->bp + (int)size) > sc_pb->maxbufsize) {
+ err_scerr(BufferOverflow);
+ return -1;
+ }
+ if ((string = newsizedstringobject(&sc_pb->buffer[sc_pb->bp], (int)size)) == NULL)
+ return -1;
+ sc_pb->bp += (int)size;
+ if(xPush(string, sc_pb) != 0) {
+ return -1;
+ }
+ DECREF(string);
+ return 0;
+}
+
+static int
+xGetI(flags, sc_pb)
+ TscOperand flags;
+ struct sc_ProcessBlock *sc_pb;
+{
+ object *integer;
+ long i;
+
+ if (flags & ALL_FIELDS) {
+
+ switch(flags & ALL_FIELDS) {
+
+ case H_EXTRA:
+ i = (long)sc_pb->hdr.h_extra;
+ break;
+
+ case H_SIZE:
+ i = (long)sc_pb->hdr.h_size;
+ break;
+
+ case H_OFFSET:
+ i = (long)sc_pb->hdr.h_offset;
+ break;
+
+ default:
+ if ((integer = newintobject(flags & ALL_FIELDS)) == NULL)
+ return -1;
+ err_scerrset(FlagError, integer, "Ailword");
+ DECREF(integer);
+ return -1;
+ }
+ } else {
+ switch(flags & ALLTYPES) {
+
+ case 0:
+ {
+ int16 x;
+
+ if ((sc_pb->bp + sizeof(int16)) > sc_pb->maxbufsize) {
+ err_scerr(BufferOverflow);
+ return -1;
+ }
+ memcpy(&x, &sc_pb->buffer[sc_pb->bp], sizeof(int16));
+ sc_pb->bp += sizeof(int16);
+ i = (long)x;
+ break;
+ }
+
+ case NOSIGN:
+ {
+ uint16 x;
+
+ if ((sc_pb->bp + sizeof(uint16)) > sc_pb->maxbufsize) {
+ err_scerr(BufferOverflow);
+ return -1;
+ }
+ memcpy(&x, &sc_pb->buffer[sc_pb->bp], sizeof(uint16));
+ sc_pb->bp += sizeof(uint16);
+ i = (long)x;
+ break;
+ }
+
+ case INT32:
+ {
+ int32 x;
+
+ if ((sc_pb->bp + sizeof(int32)) > sc_pb->maxbufsize) {
+ err_scerr(BufferOverflow);
+ return -1;
+ }
+ memcpy(&x, &sc_pb->buffer[sc_pb->bp], sizeof(int32));
+ sc_pb->bp += sizeof(int32);
+ i = (long)x;
+ break;
+ }
+
+ case INT32 | NOSIGN:
+ {
+ uint32 x;
+
+ if ((sc_pb->bp + sizeof(uint32)) > sc_pb->maxbufsize) {
+ err_scerr(BufferOverflow);
+ return -1;
+ }
+ memcpy(&x, &sc_pb->buffer[sc_pb->bp], sizeof(uint32));
+ sc_pb->bp += sizeof(uint32);
+ i = (long)x;
+ break;
+ }
+ default:
+ {
+ if ((integer = newintobject(flags)) == NULL)
+ return -1;
+ err_scerrset(FlagError, integer, "GetI");
+ DECREF(integer);
+ return -1;
+ }
+ }
+ }
+ if ((integer = newintobject(i)) == NULL)
+ return -1;
+ if (xPush(integer, sc_pb) != 0) {
+ DECREF(integer);
+ return -1;
+ }
+ DECREF(integer);
+ return 0;
+}
+
+static int
+xGetC(flags, sc_pb)
+ TscOperand flags;
+ struct sc_ProcessBlock *sc_pb;
+{
+ extern object *newcapobject();
+ object *capobj;
+ capability cap;
+
+ if ((int)flags != 0) {
+ switch ((int)flags) {
+
+ case PSEUDOFIELD:
+ cap.cap_port = sc_pb->hdr.h_port;
+ cap.cap_priv = sc_pb->hdr.h_priv;
+ break;
+ }
+ } else {
+ if ((CAPSIZE + sc_pb->bp) > sc_pb->maxbufsize) {
+ err_scerr(BufferOverflow);
+ return -1;
+ }
+ memcpy(&cap, &sc_pb->buffer[sc_pb->bp], CAPSIZE);
+ }
+ if ((capobj = newcapobject(&cap)) == NULL)
+ return -1;
+ return xPush(capobj, sc_pb);
+}
+
+static int
+xEqual(sc_pb)
+ struct sc_ProcessBlock *sc_pb;
+{
+ object *int1, *int2;
+
+ if (sc_pb->sp < 2) {
+ err_scerr(StackUnderflow);
+ return -1;
+ }
+ int1 = sc_pb->stack[sc_pb->sp - 1];
+ int2 = sc_pb->stack[sc_pb->sp - 2];
+ if ((int1 == NULL) || (int2 == NULL))
+ return -1;
+ if (!is_intobject(int1))
+ return err_scerrset(TypeFailure, int1, "Equal");
+ if (!is_intobject(int2))
+ return err_scerrset(TypeFailure, int2, "Equal");
+ if (getintvalue(int1) != getintvalue(int2)) {
+ object *tmptuple;
+
+ if ((tmptuple = newtupleobject(2)) == NULL)
+ return -1;
+ INCREF(int1);
+ if (settupleitem(tmptuple, 0, int1) != 0) {
+ DECREF(tmptuple);
+ DECREF(int1);
+ return -1;
+ }
+ if (settupleitem(tmptuple, 1, int2) != 0) {
+ DECREF(tmptuple);
+ DECREF(int2);
+ return -1;
+ }
+ return err_scerrset(SizeError, tmptuple, "Equal");
+ }
+ return 0;
+}
+
+object *
+sc_interpreter(self, args)
+ object *self, *args;
+{
+TscOpcode opcode;
+TscOperand operand;
+int datasize, ret;
+object *returnobject;
+struct sc_ProcessBlock sc_pb;
+
+ if ((datasize = init(self, &sc_pb)) < 0)
+ return NULL;
+ memcpy(&opcode, sc_pb.data, sizeof(TscOpcode));
+ sc_pb.datsize = datasize;
+ sc_pb.pc += sizeof(TscOpcode);
+ if (opcode != BufSize) {
+ free((char *)sc_pb.stack);
+ return err_scerr(NoBufSize);
+ }
+ memcpy(&operand, &sc_pb.data[sc_pb.pc], sizeof(TscOperand));
+ sc_pb.pc += sizeof(TscOperand);
+ sc_pb.buffer = (unsigned char *)malloc(operand);
+ sc_pb.maxbufsize = (int)operand;
+ if (sc_pb.buffer == NULL) {
+ free((char *)sc_pb.stack);
+ return err_nomem();
+ }
+ memcpy(&opcode, &sc_pb.data[sc_pb.pc], sizeof(TscOpcode));
+ if (opcode != NoArgs) {
+ if (xPush(args, &sc_pb) != 0) {
+ UnInit(self, &sc_pb);
+ return NULL;
+ }
+ }
+ while (sc_pb.pc < datasize) {
+ memcpy(&opcode, &sc_pb.data[sc_pb.pc], sizeof(TscOpcode));
+ sc_pb.pc += sizeof(TscOpcode);
+ if (opcode & (OPERAND | FLAGS)) {
+ memcpy(&operand, &sc_pb.data[sc_pb.pc], sizeof(TscOperand));
+ sc_pb.pc += sizeof(TscOperand);
+ }
+#ifdef SCDEBUG
+ xPrintCode(opcode);
+ if ((opcode & FLAGS) && (opcode & OPERAND))
+ xPrintFlags(operand);
+ else if (opcode & OPERAND)
+ xPrintNum(operand);
+ printf("\n");
+ fflush(stdout);
+#endif
+#ifdef STACK_TRACE
+ {
+ register i;
+
+ printf("Stack trace :\n");
+ for(i = 0; i < sc_pb.sp; i++) {
+ printobject(sc_pb.stack[i], stdout, 0);
+ printf("\n");
+ }
+ }
+#endif
+ switch(opcode) {
+
+ case NoArgs:
+ ret = 0;
+ if (args != NULL) {
+ err_scerrset(TypeFailure, args, "NoArgs");
+ ret = -1;
+ }
+ break;
+
+ case BufSize:
+ UnInit(self, &sc_pb);
+ return err_scerr(TwoBufSize);
+
+ case Trans:
+ ret = xTrans(self, operand, &sc_pb);
+ break;
+
+ case TTupleS:
+ ret = xTTupleS(operand, &sc_pb);
+ break;
+
+ case Unpack:
+ ret = xUnpack(operand, &sc_pb);
+ break;
+
+ case AilWord:
+ ret = xAilword(operand, &sc_pb);
+ break;
+
+ case StringS:
+ ret = xStringS(&sc_pb);
+ break;
+
+ case ListS:
+ ret = xListS(&sc_pb);
+ break;
+
+ case PutFS:
+ ret = xPutFS(operand, &sc_pb);
+ break;
+
+ case TStringSeq:
+ ret = xTStringSeq(operand, &sc_pb);
+ break;
+
+ case TStringSlt:
+ ret = xTStringSlt(operand, &sc_pb);
+ break;
+
+ case PutVS:
+ ret = xPutVS(&sc_pb);
+ break;
+
+ case TListSeq:
+ ret = xTListSeq(operand, &sc_pb);
+ break;
+
+ case TListSlt:
+
+ret = xTListSlt(operand, &sc_pb);
+ break;
+
+ case LoopPut:
+ ret = xLoopPut(operand, &sc_pb);
+ break;
+
+ case EndLoop:
+ ret = xEndLoop(operand, &sc_pb);
+ break;
+
+ case PutI:
+ ret = xPutI(operand, &sc_pb);
+ break;
+
+ case PutC:
+ ret = xPutC(&sc_pb);
+ break;
+
+ case Dup:
+ ret = xDup(operand, &sc_pb);
+ break;
+
+ case Pop:
+ ret = xPop(operand, &sc_pb);
+ break;
+
+ case Align:
+ ret = xAlign(operand, &sc_pb);
+ break;
+
+ case Pack:
+ ret = xPack(operand, &sc_pb);
+ break;
+
+ case GetVS:
+ ret = xGetVS(&sc_pb);
+ break;
+
+ case LoopGet:
+ ret = xLoopGet(operand, &sc_pb);
+ break;
+
+ case GetFS:
+ ret = xGetFS(operand, &sc_pb);
+ break;
+
+ case GetI:
+ ret = xGetI(operand, &sc_pb);
+ break;
+
+ case GetC:
+ ret = xGetC(operand, &sc_pb);
+ break;
+
+ case PushI:
+ {
+ object *element;
+
+ element = newintobject((long)operand);
+ if (element == NULL) {
+ UnInit(self, &sc_pb);
+ return NULL;
+ }
+ ret = xPush(element, &sc_pb);
+ if (ret == 0)
+ DECREF(element);
+ }
+ break;
+
+ case Equal:
+ ret = xEqual(&sc_pb);
+ break;
+
+ default:
+ {
+ char errstr[256];
+
+ UnInit(self, &sc_pb);
+ sprintf(errstr, "Unknow stubcode %d", opcode);
+ err_setstr(RuntimeError, errstr);
+ return NULL;
+ }
+ }
+ if (ret != 0) {
+ UnInit(self, &sc_pb);
+ return NULL;
+ }
+ }
+ if (sc_pb.sp > 0) {
+ INCREF(sc_pb.stack[sc_pb.sp - 1]);
+ returnobject = sc_pb.stack[sc_pb.sp - 1];
+ } else {
+ INCREF(None);
+ returnobject = None;
+ }
+ UnInit(self, &sc_pb);
+ return returnobject;
+}
diff --git a/src/scdbg.c b/src/scdbg.c
new file mode 100644
index 0000000..4510896
--- /dev/null
+++ b/src/scdbg.c
@@ -0,0 +1,152 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+
+#include "sc_global.h"
+
+void xPrintNum(Num)
+TscOperand Num;
+{
+
+ printf(" %ld",(long)Num);
+}
+
+void xPrintFlags(Flags)
+TscOperand Flags;
+{
+long x;
+
+ x = (long)Flags;
+ x = x & 0x0000000F;
+ if (x == H_EXTRA) printf(" h_extra");
+ if (x == H_SIZE) printf(" h_size");
+ if (x == H_OFFSET) printf(" h_offset");
+ if (x == H_PORT) printf(" h_port");
+ if (x == H_PRIV) printf(" h_priv");
+ if (x == PSEUDOFIELD) printf(" h_port and h_priv");
+ x = (long)Flags;
+ if (x & NOSIGN) printf(" unsigned");
+ if (x & INT32) printf(" int32");
+}
+
+void xPrintCode(Opcode)
+TscOpcode Opcode;
+{
+
+ switch (Opcode) {
+
+ case BufSize: printf("BufSize");
+ break;
+
+ case Trans: printf("Trans");
+ break;
+
+ case TTupleS: printf("TTupleS");
+ break;
+
+ case Unpack: printf("Unpack");
+ break;
+
+ case AilWord: printf("AilWord");
+ break;
+
+ case ListS: printf("ListS");
+ break;
+
+ case StringS: printf("StringS");
+ break;
+
+ case PutFS: printf("PutFS");
+ break;
+
+ case TStringSeq: printf("TStringSeq");
+ break;
+
+ case TStringSlt: printf("TStringSlt");
+ break;
+
+ case PutVS: printf("PutVS");
+ break;
+
+ case TListSeq: printf("TListSeq");
+ break;
+
+ case TListSlt: printf("TListSlt");
+ break;
+
+ case LoopPut: printf("LoopPut");
+ break;
+
+ case EndLoop: printf("EndLoop");
+ break;
+
+ case PutI: printf("PutI");
+ break;
+
+ case PutC: printf("PutC");
+ break;
+
+ case Dup: printf("Dup");
+ break;
+
+ case Pop: printf("Pop");
+ break;
+
+ case Align: printf("Align");
+ break;
+
+ case Pack: printf("Pack");
+ break;
+
+ case GetVS: printf("GetVS");
+ break;
+
+ case LoopGet: printf("LoopGet");
+ break;
+
+ case GetFS: printf("GetFS");
+ break;
+
+ case GetI: printf("GetI");
+ break;
+
+ case GetC: printf("GetC");
+ break;
+
+ case PushI: printf("PushI");
+ break;
+
+ case MarshTC: printf("MarshTC");
+ break;
+
+ case UnMarshTC: printf("UnMarshTC");
+ break;
+
+ case Equal: printf("Equal");
+ break;
+
+ default: printf("Unknown opcode %04x",(int)Opcode);
+ break;
+ }
+}
diff --git a/src/sigtype.h b/src/sigtype.h
new file mode 100644
index 0000000..5cfd4b3
--- /dev/null
+++ b/src/sigtype.h
@@ -0,0 +1,51 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* The type of signal handlers is somewhat problematic.
+ This file encapsulates my knowledge about it:
+ - on the Mac (THINK C), it's int for 3.0, void for 4.0
+ - on other systems, it's usually void, except it's int on vax Ultrix.
+ Pass -DSIGTYPE=... to cc if you know better. */
+
+#ifndef SIGTYPE
+
+#ifdef THINK_C
+
+#ifdef THINK_C_3_0
+#define SIGTYPE int
+#else
+#define SIGTYPE void
+#endif
+
+#else /* !THINK_C */
+
+#if defined(vax) && !defined(AMOEBA)
+#define SIGTYPE int
+#else
+#define SIGTYPE void
+#endif
+
+#endif /* !THINK_C */
+
+#endif /* !SIGTYPE */
diff --git a/src/stdwinmodule.c b/src/stdwinmodule.c
new file mode 100644
index 0000000..75b1fc8
--- /dev/null
+++ b/src/stdwinmodule.c
@@ -0,0 +1,1697 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Stdwin module */
+
+/* Stdwin itself is a module, not a separate object type.
+ Object types defined here:
+ wp: a window
+ dp: a drawing structure (only one can exist at a time)
+ mp: a menu
+ tp: a textedit block
+*/
+
+/* Rules for translating C stdwin function calls into Python stwin:
+ - All names drop their initial letter 'w'
+ - Functions with a window as first parameter are methods of window objects
+ - There is no equivalent for wclose(); just delete the window object
+ (all references to it!) (XXX maybe this is a bad idea)
+ - w.begindrawing() returns a drawing object
+ - There is no equivalent for wenddrawing(win); just delete the drawing
+ object (all references to it!) (XXX maybe this is a bad idea)
+ - Functions that may only be used inside wbegindrawing / wendddrawing
+ are methods of the drawing object; this includes the text measurement
+ functions (which however have doubles as module functions).
+ - Methods of the drawing object drop an initial 'draw' from their name
+ if they have it, e.g., wdrawline() --> d.line()
+ - The obvious type conversions: int --> intobject; string --> stringobject
+ - A text parameter followed by a length parameter is only a text (string)
+ parameter in Python
+ - A point or other pair of horizontal and vertical coordinates is always
+ a pair of integers in Python
+ - Two points forming a rectangle or endpoints of a line segment are a
+ pair of points in Python
+ - The arguments to d.elarc() are three points.
+ - The functions wgetclip() and wsetclip() are translated into
+ stdwin.getcutbuffer() and stdwin.setcutbuffer(); 'clip' is really
+ a bad word for what these functions do (clipping has a different
+ meaning in the drawing world), while cutbuffer is standard X jargon.
+ XXX This must change again in the light of changes to stdwin!
+ - For textedit, similar rules hold, but they are less strict.
+ XXX more?
+*/
+
+#include "allobjects.h"
+
+#include "modsupport.h"
+
+#include "stdwin.h"
+
+/* Window and menu object types declared here because of forward references */
+
+typedef struct {
+ OB_HEAD
+ object *w_title;
+ WINDOW *w_win;
+ object *w_attr; /* Attributes dictionary */
+} windowobject;
+
+extern typeobject Windowtype; /* Really static, forward */
+
+#define is_windowobject(wp) ((wp)->ob_type == &Windowtype)
+
+typedef struct {
+ OB_HEAD
+ MENU *m_menu;
+ int m_id;
+ object *m_attr; /* Attributes dictionary */
+} menuobject;
+
+extern typeobject Menutype; /* Really static, forward */
+
+#define is_menuobject(mp) ((mp)->ob_type == &Menutype)
+
+
+/* Strongly stdwin-specific argument handlers */
+
+static int
+getmousedetail(v, ep)
+ object *v;
+ EVENT *ep;
+{
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 4)
+ return err_badarg();
+ return getintintarg(gettupleitem(v, 0),
+ &ep->u.where.h, &ep->u.where.v) &&
+ getintarg(gettupleitem(v, 1), &ep->u.where.clicks) &&
+ getintarg(gettupleitem(v, 2), &ep->u.where.button) &&
+ getintarg(gettupleitem(v, 3), &ep->u.where.mask);
+}
+
+static int
+getmenudetail(v, ep)
+ object *v;
+ EVENT *ep;
+{
+ object *mp;
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2)
+ return err_badarg();
+ mp = gettupleitem(v, 0);
+ if (mp == NULL || !is_menuobject(mp))
+ return err_badarg();
+ ep->u.m.id = ((menuobject *)mp) -> m_id;
+ return getintarg(gettupleitem(v, 1), &ep->u.m.item);
+}
+
+static int
+geteventarg(v, ep)
+ object *v;
+ EVENT *ep;
+{
+ object *wp, *detail;
+ int a[4];
+ if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3)
+ return err_badarg();
+ if (!getintarg(gettupleitem(v, 0), &ep->type))
+ return 0;
+ wp = gettupleitem(v, 1);
+ if (wp == None)
+ ep->window = NULL;
+ else if (wp == NULL || !is_windowobject(wp))
+ return err_badarg();
+ else
+ ep->window = ((windowobject *)wp) -> w_win;
+ detail = gettupleitem(v, 2);
+ switch (ep->type) {
+ case WE_CHAR:
+ if (!is_stringobject(detail) || getstringsize(detail) != 1)
+ return err_badarg();
+ ep->u.character = getstringvalue(detail)[0];
+ return 1;
+ case WE_COMMAND:
+ return getintarg(detail, &ep->u.command);
+ case WE_DRAW:
+ if (!getrectarg(detail, a))
+ return 0;
+ ep->u.area.left = a[0];
+ ep->u.area.top = a[1];
+ ep->u.area.right = a[2];
+ ep->u.area.bottom = a[3];
+ return 1;
+ case WE_MOUSE_DOWN:
+ case WE_MOUSE_UP:
+ case WE_MOUSE_MOVE:
+ return getmousedetail(detail, ep);
+ case WE_MENU:
+ return getmenudetail(detail, ep);
+ default:
+ return 1;
+ }
+}
+
+
+/* Return construction tools */
+
+static object *
+makepoint(a, b)
+ int a, b;
+{
+ object *v;
+ object *w;
+ if ((v = newtupleobject(2)) == NULL)
+ return NULL;
+ if ((w = newintobject((long)a)) == NULL ||
+ settupleitem(v, 0, w) != 0 ||
+ (w = newintobject((long)b)) == NULL ||
+ settupleitem(v, 1, w) != 0) {
+ DECREF(v);
+ return NULL;
+ }
+ return v;
+}
+
+static object *
+makerect(a, b, c, d)
+ int a, b, c, d;
+{
+ object *v;
+ object *w;
+ if ((v = newtupleobject(2)) == NULL)
+ return NULL;
+ if ((w = makepoint(a, b)) == NULL ||
+ settupleitem(v, 0, w) != 0 ||
+ (w = makepoint(c, d)) == NULL ||
+ settupleitem(v, 1, w) != 0) {
+ DECREF(v);
+ return NULL;
+ }
+ return v;
+}
+
+static object *
+makemouse(hor, ver, clicks, button, mask)
+ int hor, ver, clicks, button, mask;
+{
+ object *v;
+ object *w;
+ if ((v = newtupleobject(4)) == NULL)
+ return NULL;
+ if ((w = makepoint(hor, ver)) == NULL ||
+ settupleitem(v, 0, w) != 0 ||
+ (w = newintobject((long)clicks)) == NULL ||
+ settupleitem(v, 1, w) != 0 ||
+ (w = newintobject((long)button)) == NULL ||
+ settupleitem(v, 2, w) != 0 ||
+ (w = newintobject((long)mask)) == NULL ||
+ settupleitem(v, 3, w) != 0) {
+ DECREF(v);
+ return NULL;
+ }
+ return v;
+}
+
+static object *
+makemenu(mp, item)
+ object *mp;
+ int item;
+{
+ object *v;
+ object *w;
+ if ((v = newtupleobject(2)) == NULL)
+ return NULL;
+ INCREF(mp);
+ if (settupleitem(v, 0, mp) != 0 ||
+ (w = newintobject((long)item)) == NULL ||
+ settupleitem(v, 1, w) != 0) {
+ DECREF(v);
+ return NULL;
+ }
+ return v;
+}
+
+
+/* Drawing objects */
+
+typedef struct {
+ OB_HEAD
+ windowobject *d_ref;
+} drawingobject;
+
+static drawingobject *Drawing; /* Set to current drawing object, or NULL */
+
+/* Drawing methods */
+
+static void
+drawing_dealloc(dp)
+ drawingobject *dp;
+{
+ wenddrawing(dp->d_ref->w_win);
+ Drawing = NULL;
+ DECREF(dp->d_ref);
+ free((char *)dp);
+}
+
+static object *
+drawing_generic(dp, args, func)
+ drawingobject *dp;
+ object *args;
+ void (*func) FPROTO((int, int, int, int));
+{
+ int a[4];
+ if (!getrectarg(args, a))
+ return NULL;
+ (*func)(a[0], a[1], a[2], a[3]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+drawing_line(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ drawing_generic(dp, args, wdrawline);
+}
+
+static object *
+drawing_xorline(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ drawing_generic(dp, args, wxorline);
+}
+
+static object *
+drawing_circle(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ int a[3];
+ if (!getpointintarg(args, a))
+ return NULL;
+ wdrawcircle(a[0], a[1], a[2]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+drawing_elarc(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ int a[6];
+ if (!get3pointarg(args, a))
+ return NULL;
+ wdrawelarc(a[0], a[1], a[2], a[3], a[4], a[5]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+drawing_box(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ drawing_generic(dp, args, wdrawbox);
+}
+
+static object *
+drawing_erase(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ drawing_generic(dp, args, werase);
+}
+
+static object *
+drawing_paint(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ drawing_generic(dp, args, wpaint);
+}
+
+static object *
+drawing_invert(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ drawing_generic(dp, args, winvert);
+}
+
+static object *
+drawing_cliprect(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ drawing_generic(dp, args, wcliprect);
+}
+
+static object *
+drawing_noclip(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ wnoclip();
+ INCREF(None);
+ return None;
+}
+
+static object *
+drawing_shade(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ int a[5];
+ if (!getrectintarg(args, a))
+ return NULL;
+ wshade(a[0], a[1], a[2], a[3], a[4]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+drawing_text(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ int a[2];
+ object *s;
+ if (!getpointstrarg(args, a, &s))
+ return NULL;
+ wdrawtext(a[0], a[1], getstringvalue(s), (int)getstringsize(s));
+ INCREF(None);
+ return None;
+}
+
+/* The following four are also used as stdwin functions */
+
+static object *
+drawing_lineheight(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ return newintobject((long)wlineheight());
+}
+
+static object *
+drawing_baseline(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ return newintobject((long)wbaseline());
+}
+
+static object *
+drawing_textwidth(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ object *s;
+ if (!getstrarg(args, &s))
+ return NULL;
+ return newintobject(
+ (long)wtextwidth(getstringvalue(s), (int)getstringsize(s)));
+}
+
+static object *
+drawing_textbreak(dp, args)
+ drawingobject *dp;
+ object *args;
+{
+ object *s;
+ int a;
+ if (!getstrintarg(args, &s, &a))
+ return NULL;
+ return newintobject(
+ (long)wtextbreak(getstringvalue(s), (int)getstringsize(s), a));
+}
+
+static struct methodlist drawing_methods[] = {
+ {"box", drawing_box},
+ {"circle", drawing_circle},
+ {"cliprect", drawing_cliprect},
+ {"elarc", drawing_elarc},
+ {"erase", drawing_erase},
+ {"invert", drawing_invert},
+ {"line", drawing_line},
+ {"noclip", drawing_noclip},
+ {"paint", drawing_paint},
+ {"shade", drawing_shade},
+ {"text", drawing_text},
+ {"xorline", drawing_xorline},
+
+ /* Text measuring methods: */
+ {"baseline", drawing_baseline},
+ {"lineheight", drawing_lineheight},
+ {"textbreak", drawing_textbreak},
+ {"textwidth", drawing_textwidth},
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+drawing_getattr(wp, name)
+ drawingobject *wp;
+ char *name;
+{
+ return findmethod(drawing_methods, (object *)wp, name);
+}
+
+static typeobject Drawingtype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /*ob_size*/
+ "drawing", /*tp_name*/
+ sizeof(drawingobject), /*tp_size*/
+ 0, /*tp_itemsize*/
+ /* methods */
+ drawing_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ drawing_getattr, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+};
+
+
+/* Text(edit) objects */
+
+typedef struct {
+ OB_HEAD
+ TEXTEDIT *t_text;
+ windowobject *t_ref;
+ object *t_attr; /* Attributes dictionary */
+} textobject;
+
+extern typeobject Texttype; /* Really static, forward */
+
+static textobject *
+newtextobject(wp, left, top, right, bottom)
+ windowobject *wp;
+ int left, top, right, bottom;
+{
+ textobject *tp;
+ tp = NEWOBJ(textobject, &Texttype);
+ if (tp == NULL)
+ return NULL;
+ tp->t_attr = NULL;
+ INCREF(wp);
+ tp->t_ref = wp;
+ tp->t_text = tecreate(wp->w_win, left, top, right, bottom);
+ if (tp->t_text == NULL) {
+ DECREF(tp);
+ return (textobject *) err_nomem();
+ }
+ return tp;
+}
+
+/* Text(edit) methods */
+
+static void
+text_dealloc(tp)
+ textobject *tp;
+{
+ if (tp->t_text != NULL)
+ tefree(tp->t_text);
+ if (tp->t_attr != NULL)
+ DECREF(tp->t_attr);
+ DECREF(tp->t_ref);
+ DEL(tp);
+}
+
+static object *
+text_arrow(self, args)
+ textobject *self;
+ object *args;
+{
+ int code;
+ if (!getintarg(args, &code))
+ return NULL;
+ tearrow(self->t_text, code);
+ INCREF(None);
+ return None;
+}
+
+static object *
+text_draw(self, args)
+ textobject *self;
+ object *args;
+{
+ register TEXTEDIT *tp = self->t_text;
+ int a[4];
+ int left, top, right, bottom;
+ if (!getrectarg(args, a))
+ return NULL;
+ if (Drawing != NULL) {
+ err_setstr(RuntimeError, "not drawing");
+ return NULL;
+ }
+ /* Clip to text area and ignore if area is empty */
+ left = tegetleft(tp);
+ top = tegettop(tp);
+ right = tegetright(tp);
+ bottom = tegetbottom(tp);
+ if (a[0] < left) a[0] = left;
+ if (a[1] < top) a[1] = top;
+ if (a[2] > right) a[2] = right;
+ if (a[3] > bottom) a[3] = bottom;
+ if (a[0] < a[2] && a[1] < a[3]) {
+ /* Hide/show focus around draw call; these are undocumented,
+ but required here to get the highlighting correct.
+ The call to werase is also required for this reason.
+ Finally, this forces us to require (above) that we are NOT
+ already drawing. */
+ tehidefocus(tp);
+ wbegindrawing(self->t_ref->w_win);
+ werase(a[0], a[1], a[2], a[3]);
+ tedrawnew(tp, a[0], a[1], a[2], a[3]);
+ wenddrawing(self->t_ref->w_win);
+ teshowfocus(tp);
+ }
+ INCREF(None);
+ return None;
+}
+
+static object *
+text_event(self, args)
+ textobject *self;
+ object *args;
+{
+ register TEXTEDIT *tp = self->t_text;
+ EVENT e;
+ if (!geteventarg(args, &e))
+ return NULL;
+ if (e.type == WE_MOUSE_DOWN) {
+ /* Cheat at the margins */
+ int width, height;
+ wgetdocsize(e.window, &width, &height);
+ if (e.u.where.h < 0 && tegetleft(tp) == 0)
+ e.u.where.h = 0;
+ else if (e.u.where.h > width && tegetright(tp) == width)
+ e.u.where.h = width;
+ if (e.u.where.v < 0 && tegettop(tp) == 0)
+ e.u.where.v = 0;
+ else if (e.u.where.v > height && tegetright(tp) == height)
+ e.u.where.v = height;
+ }
+ return newintobject((long) teevent(tp, &e));
+}
+
+static object *
+text_getfocus(self, args)
+ textobject *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ return makepoint(tegetfoc1(self->t_text), tegetfoc2(self->t_text));
+}
+
+static object *
+text_getfocustext(self, args)
+ textobject *self;
+ object *args;
+{
+ int f1, f2;
+ char *text;
+ if (!getnoarg(args))
+ return NULL;
+ f1 = tegetfoc1(self->t_text);
+ f2 = tegetfoc2(self->t_text);
+ text = tegettext(self->t_text);
+ return newsizedstringobject(text + f1, f2-f1);
+}
+
+static object *
+text_getrect(self, args)
+ textobject *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ return makerect(tegetleft(self->t_text),
+ tegettop(self->t_text),
+ tegetright(self->t_text),
+ tegetbottom(self->t_text));
+}
+
+static object *
+text_gettext(self, args)
+ textobject *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ return newsizedstringobject(tegettext(self->t_text),
+ tegetlen(self->t_text));
+}
+
+static object *
+text_move(self, args)
+ textobject *self;
+ object *args;
+{
+ int a[4];
+ if (!getrectarg(args, a))
+ return NULL;
+ temovenew(self->t_text, a[0], a[1], a[2], a[3]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+text_setfocus(self, args)
+ textobject *self;
+ object *args;
+{
+ int a[2];
+ if (!getpointarg(args, a))
+ return NULL;
+ tesetfocus(self->t_text, a[0], a[1]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+text_replace(self, args)
+ textobject *self;
+ object *args;
+{
+ object *text;
+ if (!getstrarg(args, &text))
+ return NULL;
+ tereplace(self->t_text, getstringvalue(text));
+ INCREF(None);
+ return None;
+}
+
+static struct methodlist text_methods[] = {
+ "arrow", text_arrow,
+ "draw", text_draw,
+ "event", text_event,
+ "getfocus", text_getfocus,
+ "getfocustext", text_getfocustext,
+ "getrect", text_getrect,
+ "gettext", text_gettext,
+ "move", text_move,
+ "replace", text_replace,
+ "setfocus", text_setfocus,
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+text_getattr(tp, name)
+ textobject *tp;
+ char *name;
+{
+ if (tp->t_attr != NULL) {
+ object *v = dictlookup(tp->t_attr, name);
+ if (v != NULL) {
+ INCREF(v);
+ return v;
+ }
+ }
+ return findmethod(text_methods, (object *)tp, name);
+}
+
+static int
+text_setattr(tp, name, v)
+ textobject *tp;
+ char *name;
+ object *v;
+{
+ if (tp->t_attr == NULL) {
+ tp->t_attr = newdictobject();
+ if (tp->t_attr == NULL)
+ return -1;
+ }
+ if (v == NULL)
+ return dictremove(tp->t_attr, name);
+ else
+ return dictinsert(tp->t_attr, name, v);
+}
+
+static typeobject Texttype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /*ob_size*/
+ "textedit", /*tp_name*/
+ sizeof(textobject), /*tp_size*/
+ 0, /*tp_itemsize*/
+ /* methods */
+ text_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ text_getattr, /*tp_getattr*/
+ text_setattr, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+};
+
+
+/* Menu objects */
+
+#define IDOFFSET 10 /* Menu IDs we use start here */
+#define MAXNMENU 20 /* Max #menus we allow */
+static menuobject *menulist[MAXNMENU];
+
+static menuobject *
+newmenuobject(title)
+ object *title;
+{
+ int id;
+ MENU *menu;
+ menuobject *mp;
+ for (id = 0; id < MAXNMENU; id++) {
+ if (menulist[id] == NULL)
+ break;
+ }
+ if (id >= MAXNMENU)
+ return (menuobject *) err_nomem();
+ menu = wmenucreate(id + IDOFFSET, getstringvalue(title));
+ if (menu == NULL)
+ return (menuobject *) err_nomem();
+ mp = NEWOBJ(menuobject, &Menutype);
+ if (mp != NULL) {
+ mp->m_menu = menu;
+ mp->m_id = id + IDOFFSET;
+ mp->m_attr = NULL;
+ menulist[id] = mp;
+ }
+ else
+ wmenudelete(menu);
+ return mp;
+}
+
+/* Menu methods */
+
+static void
+menu_dealloc(mp)
+ menuobject *mp;
+{
+
+ int id = mp->m_id - IDOFFSET;
+ if (id >= 0 && id < MAXNMENU && menulist[id] == mp) {
+ menulist[id] = NULL;
+ }
+ wmenudelete(mp->m_menu);
+ if (mp->m_attr != NULL)
+ DECREF(mp->m_attr);
+ DEL(mp);
+}
+
+static object *
+menu_additem(self, args)
+ menuobject *self;
+ object *args;
+{
+ object *text;
+ int shortcut;
+ if (is_tupleobject(args)) {
+ object *v;
+ if (!getstrstrarg(args, &text, &v))
+ return NULL;
+ if (getstringsize(v) != 1) {
+ err_badarg();
+ return NULL;
+ }
+ shortcut = *getstringvalue(v) & 0xff;
+ }
+ else {
+ if (!getstrarg(args, &text))
+ return NULL;
+ shortcut = -1;
+ }
+ wmenuadditem(self->m_menu, getstringvalue(text), shortcut);
+ INCREF(None);
+ return None;
+}
+
+static object *
+menu_setitem(self, args)
+ menuobject *self;
+ object *args;
+{
+ int index;
+ object *text;
+ if (!getintstrarg(args, &index, &text))
+ return NULL;
+ wmenusetitem(self->m_menu, index, getstringvalue(text));
+ INCREF(None);
+ return None;
+}
+
+static object *
+menu_enable(self, args)
+ menuobject *self;
+ object *args;
+{
+ int index;
+ int flag;
+ if (!getintintarg(args, &index, &flag))
+ return NULL;
+ wmenuenable(self->m_menu, index, flag);
+ INCREF(None);
+ return None;
+}
+
+static object *
+menu_check(self, args)
+ menuobject *self;
+ object *args;
+{
+ int index;
+ int flag;
+ if (!getintintarg(args, &index, &flag))
+ return NULL;
+ wmenucheck(self->m_menu, index, flag);
+ INCREF(None);
+ return None;
+}
+
+static struct methodlist menu_methods[] = {
+ "additem", menu_additem,
+ "setitem", menu_setitem,
+ "enable", menu_enable,
+ "check", menu_check,
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+menu_getattr(mp, name)
+ menuobject *mp;
+ char *name;
+{
+ if (mp->m_attr != NULL) {
+ object *v = dictlookup(mp->m_attr, name);
+ if (v != NULL) {
+ INCREF(v);
+ return v;
+ }
+ }
+ return findmethod(menu_methods, (object *)mp, name);
+}
+
+static int
+menu_setattr(mp, name, v)
+ menuobject *mp;
+ char *name;
+ object *v;
+{
+ if (mp->m_attr == NULL) {
+ mp->m_attr = newdictobject();
+ if (mp->m_attr == NULL)
+ return -1;
+ }
+ if (v == NULL)
+ return dictremove(mp->m_attr, name);
+ else
+ return dictinsert(mp->m_attr, name, v);
+}
+
+static typeobject Menutype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /*ob_size*/
+ "menu", /*tp_name*/
+ sizeof(menuobject), /*tp_size*/
+ 0, /*tp_itemsize*/
+ /* methods */
+ menu_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ menu_getattr, /*tp_getattr*/
+ menu_setattr, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+};
+
+
+/* Windows */
+
+#define MAXNWIN 50
+static windowobject *windowlist[MAXNWIN];
+
+/* Window methods */
+
+static void
+window_dealloc(wp)
+ windowobject *wp;
+{
+ if (wp->w_win != NULL) {
+ int tag = wgettag(wp->w_win);
+ if (tag >= 0 && tag < MAXNWIN)
+ windowlist[tag] = NULL;
+ else
+ fprintf(stderr, "XXX help! tag %d in window_dealloc\n",
+ tag);
+ wclose(wp->w_win);
+ }
+ DECREF(wp->w_title);
+ if (wp->w_attr != NULL)
+ DECREF(wp->w_attr);
+ free((char *)wp);
+}
+
+static void
+window_print(wp, fp, flags)
+ windowobject *wp;
+ FILE *fp;
+ int flags;
+{
+ fprintf(fp, "<window titled '%s'>", getstringvalue(wp->w_title));
+}
+
+static object *
+window_begindrawing(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ drawingobject *dp;
+ if (!getnoarg(args))
+ return NULL;
+ if (Drawing != NULL) {
+ err_setstr(RuntimeError, "already drawing");
+ return NULL;
+ }
+ dp = NEWOBJ(drawingobject, &Drawingtype);
+ if (dp == NULL)
+ return NULL;
+ Drawing = dp;
+ INCREF(wp);
+ dp->d_ref = wp;
+ wbegindrawing(wp->w_win);
+ return (object *)dp;
+}
+
+static object *
+window_change(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int a[4];
+ if (!getrectarg(args, a))
+ return NULL;
+ wchange(wp->w_win, a[0], a[1], a[2], a[3]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+window_gettitle(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ INCREF(wp->w_title);
+ return wp->w_title;
+}
+
+static object *
+window_getwinsize(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int width, height;
+ if (!getnoarg(args))
+ return NULL;
+ wgetwinsize(wp->w_win, &width, &height);
+ return makepoint(width, height);
+}
+
+static object *
+window_getdocsize(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int width, height;
+ if (!getnoarg(args))
+ return NULL;
+ wgetdocsize(wp->w_win, &width, &height);
+ return makepoint(width, height);
+}
+
+static object *
+window_getorigin(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int width, height;
+ if (!getnoarg(args))
+ return NULL;
+ wgetorigin(wp->w_win, &width, &height);
+ return makepoint(width, height);
+}
+
+static object *
+window_scroll(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int a[6];
+ if (!getrectpointarg(args, a))
+ return NULL;
+ wscroll(wp->w_win, a[0], a[1], a[2], a[3], a[4], a[5]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+window_setdocsize(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int a[2];
+ if (!getpointarg(args, a))
+ return NULL;
+ wsetdocsize(wp->w_win, a[0], a[1]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+window_setorigin(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int a[2];
+ if (!getpointarg(args, a))
+ return NULL;
+ wsetorigin(wp->w_win, a[0], a[1]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+window_settitle(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ object *title;
+ if (!getstrarg(args, &title))
+ return NULL;
+ DECREF(wp->w_title);
+ INCREF(title);
+ wp->w_title = title;
+ wsettitle(wp->w_win, getstringvalue(title));
+ INCREF(None);
+ return None;
+}
+
+static object *
+window_show(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int a[4];
+ if (!getrectarg(args, a))
+ return NULL;
+ wshow(wp->w_win, a[0], a[1], a[2], a[3]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+window_settimer(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int a;
+ if (!getintarg(args, &a))
+ return NULL;
+ wsettimer(wp->w_win, a);
+ INCREF(None);
+ return None;
+}
+
+static object *
+window_menucreate(self, args)
+ windowobject *self;
+ object *args;
+{
+ menuobject *mp;
+ object *title;
+ if (!getstrarg(args, &title))
+ return NULL;
+ wmenusetdeflocal(1);
+ mp = newmenuobject(title);
+ if (mp == NULL)
+ return NULL;
+ wmenuattach(self->w_win, mp->m_menu);
+ return (object *)mp;
+}
+
+static object *
+window_textcreate(self, args)
+ windowobject *self;
+ object *args;
+{
+ textobject *tp;
+ int a[4];
+ if (!getrectarg(args, a))
+ return NULL;
+ return (object *)
+ newtextobject(self, a[0], a[1], a[2], a[3]);
+}
+
+static object *
+window_setselection(self, args)
+ windowobject *self;
+ object *args;
+{
+ int sel;
+ object *str;
+ int ok;
+ if (!getintstrarg(args, &sel, &str))
+ return NULL;
+ ok = wsetselection(self->w_win, sel,
+ getstringvalue(str), (int)getstringsize(str));
+ return newintobject(ok);
+}
+
+static object *
+window_setwincursor(self, args)
+ windowobject *self;
+ object *args;
+{
+ object *str;
+ CURSOR *c;
+ if (!getstrarg(args, &str))
+ return NULL;
+ c = wfetchcursor(getstringvalue(str));
+ if (c == NULL) {
+ err_setstr(RuntimeError, "no such cursor");
+ return NULL;
+ }
+ wsetwincursor(self->w_win, c);
+ INCREF(None);
+ return None;
+}
+
+static struct methodlist window_methods[] = {
+ {"begindrawing",window_begindrawing},
+ {"change", window_change},
+ {"getdocsize", window_getdocsize},
+ {"getorigin", window_getorigin},
+ {"gettitle", window_gettitle},
+ {"getwinsize", window_getwinsize},
+ {"menucreate", window_menucreate},
+ {"scroll", window_scroll},
+ {"setwincursor",window_setwincursor},
+ {"setdocsize", window_setdocsize},
+ {"setorigin", window_setorigin},
+ {"setselection",window_setselection},
+ {"settimer", window_settimer},
+ {"settitle", window_settitle},
+ {"show", window_show},
+ {"textcreate", window_textcreate},
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+window_getattr(wp, name)
+ windowobject *wp;
+ char *name;
+{
+ if (wp->w_attr != NULL) {
+ object *v = dictlookup(wp->w_attr, name);
+ if (v != NULL) {
+ INCREF(v);
+ return v;
+ }
+ }
+ return findmethod(window_methods, (object *)wp, name);
+}
+
+static int
+window_setattr(wp, name, v)
+ windowobject *wp;
+ char *name;
+ object *v;
+{
+ if (wp->w_attr == NULL) {
+ wp->w_attr = newdictobject();
+ if (wp->w_attr == NULL)
+ return -1;
+ }
+ if (v == NULL)
+ return dictremove(wp->w_attr, name);
+ else
+ return dictinsert(wp->w_attr, name, v);
+}
+
+static typeobject Windowtype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /*ob_size*/
+ "window", /*tp_name*/
+ sizeof(windowobject), /*tp_size*/
+ 0, /*tp_itemsize*/
+ /* methods */
+ window_dealloc, /*tp_dealloc*/
+ window_print, /*tp_print*/
+ window_getattr, /*tp_getattr*/
+ window_setattr, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+};
+
+/* Stdwin methods */
+
+static object *
+stdwin_open(sw, args)
+ object *sw;
+ object *args;
+{
+ int tag;
+ object *title;
+ windowobject *wp;
+ if (!getstrarg(args, &title))
+ return NULL;
+ for (tag = 0; tag < MAXNWIN; tag++) {
+ if (windowlist[tag] == NULL)
+ break;
+ }
+ if (tag >= MAXNWIN)
+ return err_nomem();
+ wp = NEWOBJ(windowobject, &Windowtype);
+ if (wp == NULL)
+ return NULL;
+ INCREF(title);
+ wp->w_title = title;
+ wp->w_win = wopen(getstringvalue(title), (void (*)()) NULL);
+ wp->w_attr = NULL;
+ if (wp->w_win == NULL) {
+ DECREF(wp);
+ return NULL;
+ }
+ windowlist[tag] = wp;
+ wsettag(wp->w_win, tag);
+ return (object *)wp;
+}
+
+static object *
+stdwin_get_poll_event(poll, args)
+ int poll;
+ object *args;
+{
+ EVENT e;
+ object *v, *w;
+ if (!getnoarg(args))
+ return NULL;
+ if (Drawing != NULL) {
+ err_setstr(RuntimeError, "cannot getevent() while drawing");
+ return NULL;
+ }
+/* again: */
+ if (poll) {
+ if (!wpollevent(&e)) {
+ INCREF(None);
+ return None;
+ }
+ }
+ else
+ wgetevent(&e);
+ if (e.type == WE_COMMAND && e.u.command == WC_CANCEL) {
+ /* Turn keyboard interrupts into exceptions */
+ err_set(KeyboardInterrupt);
+ return NULL;
+ }
+/*
+ if (e.window == NULL && (e.type == WE_COMMAND || e.type == WE_CHAR))
+ goto again;
+*/
+ if (e.type == WE_COMMAND && e.u.command == WC_CLOSE) {
+ /* Turn WC_CLOSE commands into WE_CLOSE events */
+ e.type = WE_CLOSE;
+ }
+ v = newtupleobject(3);
+ if (v == NULL)
+ return NULL;
+ if ((w = newintobject((long)e.type)) == NULL) {
+ DECREF(v);
+ return NULL;
+ }
+ settupleitem(v, 0, w);
+ if (e.window == NULL)
+ w = None;
+ else {
+ int tag = wgettag(e.window);
+ if (tag < 0 || tag >= MAXNWIN || windowlist[tag] == NULL)
+ w = None;
+ else
+ w = (object *)windowlist[tag];
+#ifdef sgi
+ /* XXX Trap for unexplained weird bug */
+ if ((long)w == (long)0x80000001) {
+ err_setstr(SystemError,
+ "bad pointer in stdwin.getevent()");
+ return NULL;
+ }
+#endif
+ }
+ INCREF(w);
+ settupleitem(v, 1, w);
+ switch (e.type) {
+ case WE_CHAR:
+ {
+ char c[1];
+ c[0] = e.u.character;
+ w = newsizedstringobject(c, 1);
+ }
+ break;
+ case WE_COMMAND:
+ w = newintobject((long)e.u.command);
+ break;
+ case WE_DRAW:
+ w = makerect(e.u.area.left, e.u.area.top,
+ e.u.area.right, e.u.area.bottom);
+ break;
+ case WE_MOUSE_DOWN:
+ case WE_MOUSE_MOVE:
+ case WE_MOUSE_UP:
+ w = makemouse(e.u.where.h, e.u.where.v,
+ e.u.where.clicks,
+ e.u.where.button,
+ e.u.where.mask);
+ break;
+ case WE_MENU:
+ if (e.u.m.id >= IDOFFSET && e.u.m.id < IDOFFSET+MAXNMENU &&
+ menulist[e.u.m.id - IDOFFSET] != NULL)
+ w = (object *)menulist[e.u.m.id - IDOFFSET];
+ else
+ w = None;
+ w = makemenu(w, e.u.m.item);
+ break;
+ case WE_LOST_SEL:
+ w = newintobject((long)e.u.sel);
+ break;
+ default:
+ w = None;
+ INCREF(w);
+ break;
+ }
+ if (w == NULL) {
+ DECREF(v);
+ return NULL;
+ }
+ settupleitem(v, 2, w);
+ return v;
+}
+
+static object *
+stdwin_getevent(sw, args)
+ object *sw;
+ object *args;
+{
+ return stdwin_get_poll_event(0, args);
+}
+
+static object *
+stdwin_pollevent(sw, args)
+ object *sw;
+ object *args;
+{
+ return stdwin_get_poll_event(1, args);
+}
+
+static object *
+stdwin_setdefwinpos(sw, args)
+ object *sw;
+ object *args;
+{
+ int a[2];
+ if (!getpointarg(args, a))
+ return NULL;
+ wsetdefwinpos(a[0], a[1]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+stdwin_setdefwinsize(sw, args)
+ object *sw;
+ object *args;
+{
+ int a[2];
+ if (!getpointarg(args, a))
+ return NULL;
+ wsetdefwinsize(a[0], a[1]);
+ INCREF(None);
+ return None;
+}
+
+static object *
+stdwin_getdefwinpos(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int h, v;
+ if (!getnoarg(args))
+ return NULL;
+ wgetdefwinpos(&h, &v);
+ return makepoint(h, v);
+}
+
+static object *
+stdwin_getdefwinsize(wp, args)
+ windowobject *wp;
+ object *args;
+{
+ int width, height;
+ if (!getnoarg(args))
+ return NULL;
+ wgetdefwinsize(&width, &height);
+ return makepoint(width, height);
+}
+
+static object *
+stdwin_menucreate(self, args)
+ object *self;
+ object *args;
+{
+ object *title;
+ if (!getstrarg(args, &title))
+ return NULL;
+ wmenusetdeflocal(0);
+ return (object *)newmenuobject(title);
+}
+
+static object *
+stdwin_askfile(self, args)
+ object *self;
+ object *args;
+{
+ object *prompt, *dflt;
+ int new, ret;
+ char buf[256];
+ if (!getstrstrintarg(args, &prompt, &dflt, &new))
+ return NULL;
+ strncpy(buf, getstringvalue(dflt), sizeof buf);
+ buf[sizeof buf - 1] = '\0';
+ ret = waskfile(getstringvalue(prompt), buf, sizeof buf, new);
+ if (!ret) {
+ err_set(KeyboardInterrupt);
+ return NULL;
+ }
+ return newstringobject(buf);
+}
+
+static object *
+stdwin_askync(self, args)
+ object *self;
+ object *args;
+{
+ object *prompt;
+ int new, ret;
+ if (!getstrintarg(args, &prompt, &new))
+ return NULL;
+ ret = waskync(getstringvalue(prompt), new);
+ if (ret < 0) {
+ err_set(KeyboardInterrupt);
+ return NULL;
+ }
+ return newintobject((long)ret);
+}
+
+static object *
+stdwin_askstr(self, args)
+ object *self;
+ object *args;
+{
+ object *prompt, *dflt;
+ int ret;
+ char buf[256];
+ if (!getstrstrarg(args, &prompt, &dflt))
+ return NULL;
+ strncpy(buf, getstringvalue(dflt), sizeof buf);
+ buf[sizeof buf - 1] = '\0';
+ ret = waskstr(getstringvalue(prompt), buf, sizeof buf);
+ if (!ret) {
+ err_set(KeyboardInterrupt);
+ return NULL;
+ }
+ return newstringobject(buf);
+}
+
+static object *
+stdwin_message(self, args)
+ object *self;
+ object *args;
+{
+ object *msg;
+ if (!getstrarg(args, &msg))
+ return NULL;
+ wmessage(getstringvalue(msg));
+ INCREF(None);
+ return None;
+}
+
+static object *
+stdwin_fleep(self, args)
+ object *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ wfleep();
+ INCREF(None);
+ return None;
+}
+
+static object *
+stdwin_setcutbuffer(self, args)
+ object *self;
+ object *args;
+{
+ int i;
+ object *str;
+ if (!getintstrarg(args, &i, &str))
+ return NULL;
+ wsetcutbuffer(i, getstringvalue(str), getstringsize(str));
+ INCREF(None);
+ return None;
+}
+
+static object *
+stdwin_getcutbuffer(self, args)
+ object *self;
+ object *args;
+{
+ int i;
+ char *str;
+ int len;
+ if (!getintarg(args, &i))
+ return NULL;
+ str = wgetcutbuffer(i, &len);
+ if (str == NULL) {
+ str = "";
+ len = 0;
+ }
+ return newsizedstringobject(str, len);
+}
+
+static object *
+stdwin_rotatecutbuffers(self, args)
+ object *self;
+ object *args;
+{
+ int i;
+ if (!getintarg(args, &i))
+ return NULL;
+ wrotatecutbuffers(i);
+ INCREF(None);
+ return None;
+}
+
+static object *
+stdwin_getselection(self, args)
+ object *self;
+ object *args;
+{
+ int sel;
+ char *data;
+ int len;
+ if (!getintarg(args, &sel))
+ return NULL;
+ data = wgetselection(sel, &len);
+ if (data == NULL) {
+ data = "";
+ len = 0;
+ }
+ return newsizedstringobject(data, len);
+}
+
+static object *
+stdwin_resetselection(self, args)
+ object *self;
+ object *args;
+{
+ int sel;
+ if (!getintarg(args, &sel))
+ return NULL;
+ wresetselection(sel);
+ INCREF(None);
+ return None;
+}
+
+static struct methodlist stdwin_methods[] = {
+ {"askfile", stdwin_askfile},
+ {"askstr", stdwin_askstr},
+ {"askync", stdwin_askync},
+ {"fleep", stdwin_fleep},
+ {"getselection", stdwin_getselection},
+ {"getcutbuffer", stdwin_getcutbuffer},
+ {"getdefwinpos", stdwin_getdefwinpos},
+ {"getdefwinsize", stdwin_getdefwinsize},
+ {"getevent", stdwin_getevent},
+ {"menucreate", stdwin_menucreate},
+ {"message", stdwin_message},
+ {"open", stdwin_open},
+ {"pollevent", stdwin_pollevent},
+ {"resetselection", stdwin_resetselection},
+ {"rotatecutbuffers", stdwin_rotatecutbuffers},
+ {"setcutbuffer", stdwin_setcutbuffer},
+ {"setdefwinpos", stdwin_setdefwinpos},
+ {"setdefwinsize", stdwin_setdefwinsize},
+
+ /* Text measuring methods borrow code from drawing objects: */
+ {"baseline", drawing_baseline},
+ {"lineheight", drawing_lineheight},
+ {"textbreak", drawing_textbreak},
+ {"textwidth", drawing_textwidth},
+ {NULL, NULL} /* sentinel */
+};
+
+void
+initstdwin()
+{
+ static int inited;
+ if (!inited) {
+ winit();
+ inited = 1;
+ }
+ initmodule("stdwin", stdwin_methods);
+}
diff --git a/src/stdwinobject.h b/src/stdwinobject.h
new file mode 100644
index 0000000..a6d20b8
--- /dev/null
+++ b/src/stdwinobject.h
@@ -0,0 +1,31 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Stdwin object interface */
+
+extern typeobject Stdwintype;
+
+#define is_stdwinobject(op) ((op)->ob_type == &Stdwintype)
+
+extern object *newstdwinobject PROTO((void));
diff --git a/src/strdup.c b/src/strdup.c
new file mode 100644
index 0000000..e39796d
--- /dev/null
+++ b/src/strdup.c
@@ -0,0 +1,39 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+#include "PROTO.h"
+#include "malloc.h"
+#include "string.h"
+
+char *
+strdup(str)
+ const char *str;
+{
+ if (str != NULL) {
+ register char *copy = NEW(char, strlen(str) + 1);
+ if (copy != NULL)
+ return strcpy(copy, str);
+ }
+ return NULL;
+}
diff --git a/src/strerror.c b/src/strerror.c
new file mode 100644
index 0000000..b2d9da9
--- /dev/null
+++ b/src/strerror.c
@@ -0,0 +1,47 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* PD implementation of strerror() for systems that don't have it.
+ Author: Guido van Rossum, CWI Amsterdam, Oct. 1990, <[email protected]>. */
+
+#include <stdio.h>
+
+extern int sys_nerr;
+extern char *sys_errlist[];
+
+char *
+strerror(err)
+ int err;
+{
+ static char buf[20];
+ if (err >= 0 && err < sys_nerr)
+ return sys_errlist[err];
+ sprintf(buf, "Unknown errno %d", err);
+ return buf;
+}
+
+#ifdef THINK_C
+int sys_nerr = 0;
+char *sys_errlist[1] = 0;
+#endif
diff --git a/src/stringobject.c b/src/stringobject.c
new file mode 100644
index 0000000..d27243f
--- /dev/null
+++ b/src/stringobject.c
@@ -0,0 +1,347 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* String object implementation */
+
+#include "allobjects.h"
+
+object *
+newsizedstringobject(str, size)
+ char *str;
+ int size;
+{
+ register stringobject *op = (stringobject *)
+ malloc(sizeof(stringobject) + size * sizeof(char));
+ if (op == NULL)
+ return err_nomem();
+ NEWREF(op);
+ op->ob_type = &Stringtype;
+ op->ob_size = size;
+ if (str != NULL)
+ memcpy(op->ob_sval, str, size);
+ op->ob_sval[size] = '\0';
+ return (object *) op;
+}
+
+object *
+newstringobject(str)
+ char *str;
+{
+ register unsigned int size = strlen(str);
+ register stringobject *op = (stringobject *)
+ malloc(sizeof(stringobject) + size * sizeof(char));
+ if (op == NULL)
+ return err_nomem();
+ NEWREF(op);
+ op->ob_type = &Stringtype;
+ op->ob_size = size;
+ strcpy(op->ob_sval, str);
+ return (object *) op;
+}
+
+unsigned int
+getstringsize(op)
+ register object *op;
+{
+ if (!is_stringobject(op)) {
+ err_badcall();
+ return -1;
+ }
+ return ((stringobject *)op) -> ob_size;
+}
+
+/*const*/ char *
+getstringvalue(op)
+ register object *op;
+{
+ if (!is_stringobject(op)) {
+ err_badcall();
+ return NULL;
+ }
+ return ((stringobject *)op) -> ob_sval;
+}
+
+/* Methods */
+
+static void
+stringprint(op, fp, flags)
+ stringobject *op;
+ FILE *fp;
+ int flags;
+{
+ int i;
+ char c;
+ if (flags & PRINT_RAW) {
+ fwrite(op->ob_sval, 1, (int) op->ob_size, fp);
+ return;
+ }
+ fprintf(fp, "'");
+ for (i = 0; i < op->ob_size; i++) {
+ c = op->ob_sval[i];
+ if (c == '\'' || c == '\\')
+ fprintf(fp, "\\%c", c);
+ else if (c < ' ' || c >= 0177)
+ fprintf(fp, "\\%03o", c&0377);
+ else
+ putc(c, fp);
+ }
+ fprintf(fp, "'");
+}
+
+static object *
+stringrepr(op)
+ register stringobject *op;
+{
+ /* XXX overflow? */
+ int newsize = 2 + 4 * op->ob_size * sizeof(char);
+ object *v = newsizedstringobject((char *)NULL, newsize);
+ if (v == NULL) {
+ return err_nomem();
+ }
+ else {
+ register int i;
+ register char c;
+ register char *p;
+ NEWREF(v);
+ v->ob_type = &Stringtype;
+ ((stringobject *)v)->ob_size = newsize;
+ p = ((stringobject *)v)->ob_sval;
+ *p++ = '\'';
+ for (i = 0; i < op->ob_size; i++) {
+ c = op->ob_sval[i];
+ if (c == '\'' || c == '\\')
+ *p++ = '\\', *p++ = c;
+ else if (c < ' ' || c >= 0177) {
+ sprintf(p, "\\%03o", c&0377);
+ while (*p != '\0')
+ p++;
+
+ }
+ else
+ *p++ = c;
+ }
+ *p++ = '\'';
+ *p = '\0';
+ resizestring(&v, (int) (p - ((stringobject *)v)->ob_sval));
+ return v;
+ }
+}
+
+static int
+stringlength(a)
+ stringobject *a;
+{
+ return a->ob_size;
+}
+
+static object *
+stringconcat(a, bb)
+ register stringobject *a;
+ register object *bb;
+{
+ register unsigned int size;
+ register stringobject *op;
+ if (!is_stringobject(bb)) {
+ err_badarg();
+ return NULL;
+ }
+#define b ((stringobject *)bb)
+ /* Optimize cases with empty left or right operand */
+ if (a->ob_size == 0) {
+ INCREF(bb);
+ return bb;
+ }
+ if (b->ob_size == 0) {
+ INCREF(a);
+ return (object *)a;
+ }
+ size = a->ob_size + b->ob_size;
+ op = (stringobject *)
+ malloc(sizeof(stringobject) + size * sizeof(char));
+ if (op == NULL)
+ return err_nomem();
+ NEWREF(op);
+ op->ob_type = &Stringtype;
+ op->ob_size = size;
+ memcpy(op->ob_sval, a->ob_sval, (int) a->ob_size);
+ memcpy(op->ob_sval + a->ob_size, b->ob_sval, (int) b->ob_size);
+ op->ob_sval[size] = '\0';
+ return (object *) op;
+#undef b
+}
+
+static object *
+stringrepeat(a, n)
+ register stringobject *a;
+ register int n;
+{
+ register int i;
+ register unsigned int size;
+ register stringobject *op;
+ if (n < 0)
+ n = 0;
+ size = a->ob_size * n;
+ if (size == a->ob_size) {
+ INCREF(a);
+ return (object *)a;
+ }
+ op = (stringobject *)
+ malloc(sizeof(stringobject) + size * sizeof(char));
+ if (op == NULL)
+ return err_nomem();
+ NEWREF(op);
+ op->ob_type = &Stringtype;
+ op->ob_size = size;
+ for (i = 0; i < size; i += a->ob_size)
+ memcpy(op->ob_sval+i, a->ob_sval, (int) a->ob_size);
+ op->ob_sval[size] = '\0';
+ return (object *) op;
+}
+
+/* String slice a[i:j] consists of characters a[i] ... a[j-1] */
+
+static object *
+stringslice(a, i, j)
+ register stringobject *a;
+ register int i, j; /* May be negative! */
+{
+ if (i < 0)
+ i = 0;
+ if (j < 0)
+ j = 0; /* Avoid signed/unsigned bug in next line */
+ if (j > a->ob_size)
+ j = a->ob_size;
+ if (i == 0 && j == a->ob_size) { /* It's the same as a */
+ INCREF(a);
+ return (object *)a;
+ }
+ if (j < i)
+ j = i;
+ return newsizedstringobject(a->ob_sval + i, (int) (j-i));
+}
+
+static object *
+stringitem(a, i)
+ stringobject *a;
+ register int i;
+{
+ if (i < 0 || i >= a->ob_size) {
+ err_setstr(IndexError, "string index out of range");
+ return NULL;
+ }
+ return stringslice(a, i, i+1);
+}
+
+static int
+stringcompare(a, b)
+ stringobject *a, *b;
+{
+ int len_a = a->ob_size, len_b = b->ob_size;
+ int min_len = (len_a < len_b) ? len_a : len_b;
+ int cmp = memcmp(a->ob_sval, b->ob_sval, min_len);
+ if (cmp != 0)
+ return cmp;
+ return (len_a < len_b) ? -1 : (len_a > len_b) ? 1 : 0;
+}
+
+static sequence_methods string_as_sequence = {
+ stringlength, /*tp_length*/
+ stringconcat, /*tp_concat*/
+ stringrepeat, /*tp_repeat*/
+ stringitem, /*tp_item*/
+ stringslice, /*tp_slice*/
+ 0, /*tp_ass_item*/
+ 0, /*tp_ass_slice*/
+};
+
+typeobject Stringtype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "string",
+ sizeof(stringobject),
+ sizeof(char),
+ free, /*tp_dealloc*/
+ stringprint, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ stringcompare, /*tp_compare*/
+ stringrepr, /*tp_repr*/
+ 0, /*tp_as_number*/
+ &string_as_sequence, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
+
+void
+joinstring(pv, w)
+ register object **pv;
+ register object *w;
+{
+ register object *v;
+ if (*pv == NULL || w == NULL || !is_stringobject(*pv))
+ return;
+ v = stringconcat((stringobject *) *pv, w);
+ DECREF(*pv);
+ *pv = v;
+}
+
+/* The following function breaks the notion that strings are immutable:
+ it changes the size of a string. We get away with this only if there
+ is only one module referencing the object. You can also think of it
+ as creating a new string object and destroying the old one, only
+ more efficiently. In any case, don't use this if the string may
+ already be known to some other part of the code... */
+
+int
+resizestring(pv, newsize)
+ object **pv;
+ int newsize;
+{
+ register object *v;
+ register stringobject *sv;
+ v = *pv;
+ if (!is_stringobject(v) || v->ob_refcnt != 1) {
+ *pv = 0;
+ DECREF(v);
+ err_badcall();
+ return -1;
+ }
+ /* XXX UNREF/NEWREF interface should be more symmetrical */
+#ifdef REF_DEBUG
+ --ref_total;
+#endif
+ UNREF(v);
+ *pv = (object *)
+ realloc((char *)v,
+ sizeof(stringobject) + newsize * sizeof(char));
+ if (*pv == NULL) {
+ DEL(v);
+ err_nomem();
+ return -1;
+ }
+ NEWREF(*pv);
+ sv = (stringobject *) *pv;
+ sv->ob_size = newsize;
+ sv->ob_sval[newsize] = '\0';
+ return 0;
+}
diff --git a/src/stringobject.h b/src/stringobject.h
new file mode 100644
index 0000000..17e0367
--- /dev/null
+++ b/src/stringobject.h
@@ -0,0 +1,63 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* String object interface */
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+Type stringobject represents a character string. An extra zero byte is
+reserved at the end to ensure it is zero-terminated, but a size is
+present so strings with null bytes in them can be represented. This
+is an immutable object type.
+
+There are functions to create new string objects, to test
+an object for string-ness, and to get the
+string value. The latter function returns a null pointer
+if the object is not of the proper type.
+There is a variant that takes an explicit size as well as a
+variant that assumes a zero-terminated string. Note that none of the
+functions should be applied to nil objects.
+*/
+
+/* NB The type is revealed here only because it is used in dictobject.c */
+
+typedef struct {
+ OB_VARHEAD
+ char ob_sval[1];
+} stringobject;
+
+extern typeobject Stringtype;
+
+#define is_stringobject(op) ((op)->ob_type == &Stringtype)
+
+extern object *newsizedstringobject PROTO((char *, int));
+extern object *newstringobject PROTO((char *));
+extern unsigned int getstringsize PROTO((object *));
+extern char *getstringvalue PROTO((object *));
+extern void joinstring PROTO((object **, object *));
+extern int resizestring PROTO((object **, int));
+
+/* Macro, trading safety for speed */
+#define GETSTRINGVALUE(op) ((op)->ob_sval)
diff --git a/src/strtol.c b/src/strtol.c
new file mode 100644
index 0000000..cdf9b92
--- /dev/null
+++ b/src/strtol.c
@@ -0,0 +1,122 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/*
+** strtol
+** This is a general purpose routine for converting
+** an ascii string to an integer in an arbitrary base.
+** Leading white space is ignored, if 'base' is zero
+** it looks for a leading 0, 0x or 0X to tell which
+** base. If these are absent it defaults to 10.
+** Base must be between 0 and 36.
+** If 'ptr' is non-NULL it will contain a pointer to
+** the end of the scan.
+** Errors due to bad pointers will probably result in
+** exceptions - we don't check for them.
+*/
+
+#include "ctype.h"
+
+long
+strtol(str, ptr, base)
+register char * str;
+char ** ptr;
+int base;
+{
+ register long result; /* return value of the function */
+ register int c; /* current input character */
+ int minus; /* true if a leading minus was found */
+
+ result = 0;
+ minus = 0;
+
+/* catch silly bases */
+ if (base < 0 || base > 36)
+ {
+ if (ptr)
+ *ptr = str;
+ return result;
+ }
+
+/* skip leading white space */
+ while (*str && isspace(*str))
+ str++;
+
+/* check for optional leading minus sign */
+ if (*str == '-')
+ {
+ minus = 1;
+ str++;
+ }
+
+/* check for leading 0 or 0x for auto-base or base 16 */
+ switch (base)
+ {
+ case 0: /* look for leading 0, 0x or 0X */
+ if (*str == '0')
+ {
+ str++;
+ if (*str == 'x' || *str == 'X')
+ {
+ str++;
+ base = 16;
+ }
+ else
+ base = 8;
+ }
+ else
+ base = 10;
+ break;
+
+ case 16: /* skip leading 0x or 0X */
+ if (*str == '0' && (*(str+1) == 'x' || *(str+1) == 'X'))
+ str += 2;
+ break;
+ }
+
+/* do the conversion */
+ while (c = *str)
+ {
+ if (isdigit(c) && c - '0' < base)
+ c -= '0';
+ else
+ {
+ if (isupper(c))
+ c = tolower(c);
+ if (c >= 'a' && c <= 'z')
+ c -= 'a' - 10;
+ else /* non-"digit" character */
+ break;
+ if (c >= base) /* non-"digit" character */
+ break;
+ }
+ result = result * base + c;
+ str++;
+ }
+
+/* set pointer to point to the last character scanned */
+ if (ptr)
+ *ptr = str;
+ return minus ? -result : result;
+}
diff --git a/src/structmember.c b/src/structmember.c
new file mode 100644
index 0000000..c87a3c7
--- /dev/null
+++ b/src/structmember.c
@@ -0,0 +1,158 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Map C struct members to Python object attributes */
+
+#include "allobjects.h"
+
+#include "structmember.h"
+
+object *
+getmember(addr, mlist, name)
+ char *addr;
+ struct memberlist *mlist;
+ char *name;
+{
+ struct memberlist *l;
+
+ for (l = mlist; l->name != NULL; l++) {
+ if (strcmp(l->name, name) == 0) {
+ object *v;
+ addr += l->offset;
+ switch (l->type) {
+ case T_SHORT:
+ v = newintobject((long) *(short*)addr);
+ break;
+ case T_INT:
+ v = newintobject((long) *(int*)addr);
+ break;
+ case T_LONG:
+ v = newintobject(*(long*)addr);
+ break;
+ case T_FLOAT:
+ v = newfloatobject((double)*(float*)addr);
+ break;
+ case T_DOUBLE:
+ v = newfloatobject(*(double*)addr);
+ break;
+ case T_STRING:
+ if (*(char**)addr == NULL) {
+ INCREF(None);
+ v = None;
+ }
+ else
+ v = newstringobject(*(char**)addr);
+ break;
+ case T_OBJECT:
+ v = *(object **)addr;
+ if (v == NULL)
+ v = None;
+ INCREF(v);
+ break;
+ default:
+ err_setstr(SystemError, "bad memberlist type");
+ v = NULL;
+ }
+ return v;
+ }
+ }
+
+ err_setstr(NameError, name);
+ return NULL;
+}
+
+int
+setmember(addr, mlist, name, v)
+ char *addr;
+ struct memberlist *mlist;
+ char *name;
+ object *v;
+{
+ struct memberlist *l;
+
+ for (l = mlist; l->name != NULL; l++) {
+ if (strcmp(l->name, name) == 0) {
+ if (l->readonly || l->type == T_STRING) {
+ err_setstr(RuntimeError, "readonly attribute");
+ return -1;
+ }
+ addr += l->offset;
+ switch (l->type) {
+ case T_SHORT:
+ if (!is_intobject(v)) {
+ err_badarg();
+ return -1;
+ }
+ *(short*)addr = getintvalue(v);
+ break;
+ case T_INT:
+ if (!is_intobject(v)) {
+ err_badarg();
+ return -1;
+ }
+ *(int*)addr = getintvalue(v);
+ break;
+ case T_LONG:
+ if (!is_intobject(v)) {
+ err_badarg();
+ return -1;
+ }
+ *(long*)addr = getintvalue(v);
+ break;
+ case T_FLOAT:
+ if (is_intobject(v))
+ *(float*)addr = getintvalue(v);
+ else if (is_floatobject(v))
+ *(float*)addr = getfloatvalue(v);
+ else {
+ err_badarg();
+ return -1;
+ }
+ break;
+ case T_DOUBLE:
+ if (is_intobject(v))
+ *(double*)addr = getintvalue(v);
+ else if (is_floatobject(v))
+ *(double*)addr = getfloatvalue(v);
+ else {
+ err_badarg();
+ return -1;
+ }
+ break;
+ case T_OBJECT:
+ XDECREF(*(object **)addr);
+ XINCREF(v);
+ *(object **)addr = v;
+ break;
+ default:
+ err_setstr(SystemError, "bad memberlist type");
+ return -1;
+ }
+ return 0;
+ }
+ }
+
+ err_setstr(NameError, name);
+ return -1;
+}
diff --git a/src/structmember.h b/src/structmember.h
new file mode 100644
index 0000000..93d2a2e
--- /dev/null
+++ b/src/structmember.h
@@ -0,0 +1,64 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Interface to map C struct members to Python object attributes */
+
+/* The offsetof() macro calculates the offset of a structure member
+ in its structure. Unfortunately this cannot be written down
+ portably, hence it is provided by a Standard C header file.
+ For pre-Standard C compilers, here is a version that usually works
+ (but watch out!): */
+
+#ifndef offsetof
+#define offsetof(type, member) ( (int) & ((type*)0) -> member )
+#endif
+
+/* An array of memberlist structures defines the name, type and offset
+ of selected members of a C structure. These can be read by
+ getmember() and set by setmember() (except if their READONLY flag
+ is set). The array must be terminated with an entry whose name
+ pointer is NULL. */
+
+struct memberlist {
+ char *name;
+ int type;
+ int offset;
+ int readonly;
+};
+
+/* Types */
+#define T_SHORT 0
+#define T_INT 1
+#define T_LONG 2
+#define T_FLOAT 3
+#define T_DOUBLE 4
+#define T_STRING 5
+#define T_OBJECT 6
+
+/* Readonly flag */
+#define READONLY 1
+#define RO READONLY /* Shorthand */
+
+object *getmember PROTO((char *, struct memberlist *, char *));
+int setmember PROTO((char *, struct memberlist *, char *, object *));
diff --git a/src/stubcode.h b/src/stubcode.h
new file mode 100644
index 0000000..6e76c23
--- /dev/null
+++ b/src/stubcode.h
@@ -0,0 +1,28 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+
+#define CAP 0
+#define STUBC 1
+#define NAME 2
diff --git a/src/sysmodule.c b/src/sysmodule.c
new file mode 100644
index 0000000..6b3b576
--- /dev/null
+++ b/src/sysmodule.c
@@ -0,0 +1,214 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* System module */
+
+/*
+Various bits of information used by the interpreter are collected in
+module 'sys'.
+Function member:
+- exit(sts): call (C, POSIX) exit(sts)
+Data members:
+- stdin, stdout, stderr: standard file objects
+- modules: the table of modules (dictionary)
+- path: module search path (list of strings)
+- argv: script arguments (list of strings)
+- ps1, ps2: optional primary and secondary prompts (strings)
+*/
+
+#include "allobjects.h"
+
+#include "sysmodule.h"
+#include "import.h"
+#include "modsupport.h"
+
+/* Define delimiter used in $PYTHONPATH */
+
+#ifdef THINK_C
+#define DELIM ' '
+#endif
+
+#ifndef DELIM
+#define DELIM ':'
+#endif
+
+static object *sysdict;
+
+object *
+sysget(name)
+ char *name;
+{
+ return dictlookup(sysdict, name);
+}
+
+FILE *
+sysgetfile(name, def)
+ char *name;
+ FILE *def;
+{
+ FILE *fp = NULL;
+ object *v = sysget(name);
+ if (v != NULL)
+ fp = getfilefile(v);
+ if (fp == NULL)
+ fp = def;
+ return fp;
+}
+
+int
+sysset(name, v)
+ char *name;
+ object *v;
+{
+ if (v == NULL)
+ return dictremove(sysdict, name);
+ else
+ return dictinsert(sysdict, name, v);
+}
+
+static object *
+sys_exit(self, args)
+ object *self;
+ object *args;
+{
+ int sts;
+ if (!getintarg(args, &sts))
+ return NULL;
+ goaway(sts);
+ exit(sts); /* Just in case */
+ /* NOTREACHED */
+}
+
+static struct methodlist sys_methods[] = {
+ {"exit", sys_exit},
+ {NULL, NULL} /* sentinel */
+};
+
+static object *sysin, *sysout, *syserr;
+
+void
+initsys()
+{
+ object *m = initmodule("sys", sys_methods);
+ sysdict = getmoduledict(m);
+ INCREF(sysdict);
+ /* NB keep an extra ref to the std files to avoid closing them
+ when the user deletes them */
+ /* XXX File objects should have a "don't close" flag instead */
+ sysin = newopenfileobject(stdin, "<stdin>", "r");
+ sysout = newopenfileobject(stdout, "<stdout>", "w");
+ syserr = newopenfileobject(stderr, "<stderr>", "w");
+ if (err_occurred())
+ fatal("can't create sys.std* file objects");
+ dictinsert(sysdict, "stdin", sysin);
+ dictinsert(sysdict, "stdout", sysout);
+ dictinsert(sysdict, "stderr", syserr);
+ dictinsert(sysdict, "modules", get_modules());
+ if (err_occurred())
+ fatal("can't insert sys.* objects in sys dict");
+}
+
+static object *
+makepathobject(path, delim)
+ char *path;
+ int delim;
+{
+ int i, n;
+ char *p;
+ object *v, *w;
+
+ n = 1;
+ p = path;
+ while ((p = strchr(p, delim)) != NULL) {
+ n++;
+ p++;
+ }
+ v = newlistobject(n);
+ if (v == NULL)
+ return NULL;
+ for (i = 0; ; i++) {
+ p = strchr(path, delim);
+ if (p == NULL)
+ p = strchr(path, '\0'); /* End of string */
+ w = newsizedstringobject(path, (int) (p - path));
+ if (w == NULL) {
+ DECREF(v);
+ return NULL;
+ }
+ setlistitem(v, i, w);
+ if (*p == '\0')
+ break;
+ path = p+1;
+ }
+ return v;
+}
+
+void
+setpythonpath(path)
+ char *path;
+{
+ object *v;
+ if ((v = makepathobject(path, DELIM)) == NULL)
+ fatal("can't create sys.path");
+ if (sysset("path", v) != 0)
+ fatal("can't assign sys.path");
+ DECREF(v);
+}
+
+static object *
+makeargvobject(argc, argv)
+ int argc;
+ char **argv;
+{
+ object *av;
+ if (argc < 0 || argv == NULL)
+ argc = 0;
+ av = newlistobject(argc);
+ if (av != NULL) {
+ int i;
+ for (i = 0; i < argc; i++) {
+ object *v = newstringobject(argv[i]);
+ if (v == NULL) {
+ DECREF(av);
+ av = NULL;
+ break;
+ }
+ setlistitem(av, i, v);
+ }
+ }
+ return av;
+}
+
+void
+setpythonargv(argc, argv)
+ int argc;
+ char **argv;
+{
+ object *av = makeargvobject(argc, argv);
+ if (av == NULL)
+ fatal("no mem for sys.argv");
+ if (sysset("argv", av) != 0)
+ fatal("can't assign sys.argv");
+ DECREF(av);
+}
diff --git a/src/sysmodule.h b/src/sysmodule.h
new file mode 100644
index 0000000..eed1944
--- /dev/null
+++ b/src/sysmodule.h
@@ -0,0 +1,30 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* System module interface */
+
+object *sysget PROTO((char *));
+int sysset PROTO((char *, object *));
+FILE *sysgetfile PROTO((char *, FILE *));
+void initsys PROTO((void));
diff --git a/src/timemodule.c b/src/timemodule.c
new file mode 100644
index 0000000..dcaedbd
--- /dev/null
+++ b/src/timemodule.c
@@ -0,0 +1,229 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Time module */
+
+#include "allobjects.h"
+
+#include "modsupport.h"
+
+#include "sigtype.h"
+
+#include <signal.h>
+#include <setjmp.h>
+
+#ifdef __STDC__
+#include <time.h>
+#else /* !__STDC__ */
+typedef unsigned long time_t;
+extern time_t time();
+#endif /* !__STDC__ */
+
+
+/* Time methods */
+
+static object *
+time_time(self, args)
+ object *self;
+ object *args;
+{
+ long secs;
+ if (!getnoarg(args))
+ return NULL;
+ secs = time((time_t *)NULL);
+ return newintobject(secs);
+}
+
+static jmp_buf sleep_intr;
+
+static void
+sleep_catcher(sig)
+ int sig;
+{
+ longjmp(sleep_intr, 1);
+}
+
+static object *
+time_sleep(self, args)
+ object *self;
+ object *args;
+{
+ int secs;
+ SIGTYPE (*sigsave)();
+ if (!getintarg(args, &secs))
+ return NULL;
+ if (setjmp(sleep_intr)) {
+ signal(SIGINT, sigsave);
+ err_set(KeyboardInterrupt);
+ return NULL;
+ }
+ sigsave = signal(SIGINT, SIG_IGN);
+ if (sigsave != (SIGTYPE (*)()) SIG_IGN)
+ signal(SIGINT, sleep_catcher);
+ sleep(secs);
+ signal(SIGINT, sigsave);
+ INCREF(None);
+ return None;
+}
+
+#ifdef THINK_C
+#define DO_MILLI
+#endif /* THINK_C */
+
+#ifdef AMOEBA
+#define DO_MILLI
+extern long sys_milli();
+#define millitimer sys_milli
+#endif /* AMOEBA */
+
+#ifdef BSD_TIME
+#define DO_MILLI
+#endif /* BSD_TIME */
+
+#ifdef DO_MILLI
+
+static object *
+time_millisleep(self, args)
+ object *self;
+ object *args;
+{
+ long msecs;
+ SIGTYPE (*sigsave)();
+ if (!getlongarg(args, &msecs))
+ return NULL;
+ if (setjmp(sleep_intr)) {
+ signal(SIGINT, sigsave);
+ err_set(KeyboardInterrupt);
+ return NULL;
+ }
+ sigsave = signal(SIGINT, SIG_IGN);
+ if (sigsave != (SIGTYPE (*)()) SIG_IGN)
+ signal(SIGINT, sleep_catcher);
+ millisleep(msecs);
+ signal(SIGINT, sigsave);
+ INCREF(None);
+ return None;
+}
+
+static object *
+time_millitimer(self, args)
+ object *self;
+ object *args;
+{
+ long msecs;
+ extern long millitimer();
+ if (!getnoarg(args))
+ return NULL;
+ msecs = millitimer();
+ return newintobject(msecs);
+}
+
+#endif /* DO_MILLI */
+
+
+static struct methodlist time_methods[] = {
+#ifdef DO_MILLI
+ {"millisleep", time_millisleep},
+ {"millitimer", time_millitimer},
+#endif /* DO_MILLI */
+ {"sleep", time_sleep},
+ {"time", time_time},
+ {NULL, NULL} /* sentinel */
+};
+
+
+void
+inittime()
+{
+ initmodule("time", time_methods);
+}
+
+
+#ifdef THINK_C
+
+#define MacTicks (* (long *)0x16A)
+
+static
+sleep(msecs)
+ int msecs;
+{
+ register long deadline;
+
+ deadline = MacTicks + msecs * 60;
+ while (MacTicks < deadline) {
+ if (intrcheck())
+ sleep_catcher(SIGINT);
+ }
+}
+
+static
+millisleep(msecs)
+ long msecs;
+{
+ register long deadline;
+
+ deadline = MacTicks + msecs * 3 / 50; /* msecs * 60 / 1000 */
+ while (MacTicks < deadline) {
+ if (intrcheck())
+ sleep_catcher(SIGINT);
+ }
+}
+
+static long
+millitimer()
+{
+ return MacTicks * 50 / 3; /* MacTicks * 1000 / 60 */
+}
+
+#endif /* THINK_C */
+
+
+#ifdef BSD_TIME
+
+#include <sys/types.h>
+#include <sys/time.h>
+
+static long
+millitimer()
+{
+ struct timeval t;
+ struct timezone tz;
+ if (gettimeofday(&t, &tz) != 0)
+ return -1;
+ return t.tv_sec*1000 + t.tv_usec/1000;
+
+}
+
+static
+millisleep(msecs)
+ long msecs;
+{
+ struct timeval t;
+ t.tv_sec = msecs/1000;
+ t.tv_usec = (msecs%1000)*1000;
+ (void) select(0, (fd_set *)0, (fd_set *)0, (fd_set *)0, &t);
+}
+
+#endif /* BSD_TIME */
+
diff --git a/src/token.h b/src/token.h
new file mode 100644
index 0000000..79f0ed0
--- /dev/null
+++ b/src/token.h
@@ -0,0 +1,69 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Token types */
+
+#define ENDMARKER 0
+#define NAME 1
+#define NUMBER 2
+#define STRING 3
+#define NEWLINE 4
+#define INDENT 5
+#define DEDENT 6
+#define LPAR 7
+#define RPAR 8
+#define LSQB 9
+#define RSQB 10
+#define COLON 11
+#define COMMA 12
+#define SEMI 13
+#define PLUS 14
+#define MINUS 15
+#define STAR 16
+#define SLASH 17
+#define VBAR 18
+#define AMPER 19
+#define LESS 20
+#define GREATER 21
+#define EQUAL 22
+#define DOT 23
+#define PERCENT 24
+#define BACKQUOTE 25
+#define LBRACE 26
+#define RBRACE 27
+#define OP 28
+#define ERRORTOKEN 29
+#define N_TOKENS 30
+
+/* Special definitions for cooperation with parser */
+
+#define NT_OFFSET 256
+
+#define ISTERMINAL(x) ((x) < NT_OFFSET)
+#define ISNONTERMINAL(x) ((x) >= NT_OFFSET)
+#define ISEOF(x) ((x) == ENDMARKER)
+
+
+extern char *tok_name[]; /* Token names */
+extern int tok_1char PROTO((int));
diff --git a/src/tokenizer.c b/src/tokenizer.c
new file mode 100644
index 0000000..231123f
--- /dev/null
+++ b/src/tokenizer.c
@@ -0,0 +1,523 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Tokenizer implementation */
+
+/* XXX This is rather old, should be restructured perhaps */
+/* XXX Need a better interface to report errors than writing to stderr */
+/* XXX Should use editor resource to fetch true tab size on Macintosh */
+
+#include "pgenheaders.h"
+
+#include <ctype.h>
+#include "string.h"
+
+#include "fgetsintr.h"
+#include "tokenizer.h"
+#include "errcode.h"
+
+#ifdef THINK_C
+#define TABSIZE 4
+#endif
+
+#ifndef TABSIZE
+#define TABSIZE 8
+#endif
+
+/* Forward */
+static struct tok_state *tok_new PROTO((void));
+static int tok_nextc PROTO((struct tok_state *tok));
+static void tok_backup PROTO((struct tok_state *tok, int c));
+
+/* Token names */
+
+char *tok_name[] = {
+ "ENDMARKER",
+ "NAME",
+ "NUMBER",
+ "STRING",
+ "NEWLINE",
+ "INDENT",
+ "DEDENT",
+ "LPAR",
+ "RPAR",
+ "LSQB",
+ "RSQB",
+ "COLON",
+ "COMMA",
+ "SEMI",
+ "PLUS",
+ "MINUS",
+ "STAR",
+ "SLASH",
+ "VBAR",
+ "AMPER",
+ "LESS",
+ "GREATER",
+ "EQUAL",
+ "DOT",
+ "PERCENT",
+ "BACKQUOTE",
+ "LBRACE",
+ "RBRACE",
+ "OP",
+ "<ERRORTOKEN>",
+ "<N_TOKENS>"
+};
+
+
+/* Create and initialize a new tok_state structure */
+
+static struct tok_state *
+tok_new()
+{
+ struct tok_state *tok = NEW(struct tok_state, 1);
+ if (tok == NULL)
+ return NULL;
+ tok->buf = tok->cur = tok->end = tok->inp = NULL;
+ tok->done = E_OK;
+ tok->fp = NULL;
+ tok->tabsize = TABSIZE;
+ tok->indent = 0;
+ tok->indstack[0] = 0;
+ tok->atbol = 1;
+ tok->pendin = 0;
+ tok->prompt = tok->nextprompt = NULL;
+ tok->lineno = 0;
+ return tok;
+}
+
+
+/* Set up tokenizer for string */
+
+struct tok_state *
+tok_setups(str)
+ char *str;
+{
+ struct tok_state *tok = tok_new();
+ if (tok == NULL)
+ return NULL;
+ tok->buf = tok->cur = str;
+ tok->end = tok->inp = strchr(str, '\0');
+ return tok;
+}
+
+
+/* Set up tokenizer for string */
+
+struct tok_state *
+tok_setupf(fp, ps1, ps2)
+ FILE *fp;
+ char *ps1, *ps2;
+{
+ struct tok_state *tok = tok_new();
+ if (tok == NULL)
+ return NULL;
+ if ((tok->buf = NEW(char, BUFSIZ)) == NULL) {
+ DEL(tok);
+ return NULL;
+ }
+ tok->cur = tok->inp = tok->buf;
+ tok->end = tok->buf + BUFSIZ;
+ tok->fp = fp;
+ tok->prompt = ps1;
+ tok->nextprompt = ps2;
+ return tok;
+}
+
+
+/* Free a tok_state structure */
+
+void
+tok_free(tok)
+ struct tok_state *tok;
+{
+ /* XXX really need a separate flag to say 'my buffer' */
+ if (tok->fp != NULL && tok->buf != NULL)
+ DEL(tok->buf);
+ DEL(tok);
+}
+
+
+/* Get next char, updating state; error code goes into tok->done */
+
+static int
+tok_nextc(tok)
+ register struct tok_state *tok;
+{
+ if (tok->done != E_OK)
+ return EOF;
+
+ for (;;) {
+ if (tok->cur < tok->inp)
+ return *tok->cur++;
+ if (tok->fp == NULL) {
+ tok->done = E_EOF;
+ return EOF;
+ }
+ if (tok->inp > tok->buf && tok->inp[-1] == '\n')
+ tok->inp = tok->buf;
+ if (tok->inp == tok->end) {
+ int n = tok->end - tok->buf;
+ char *new = tok->buf;
+ RESIZE(new, char, n+n);
+ if (new == NULL) {
+ fprintf(stderr, "tokenizer out of mem\n");
+ tok->done = E_NOMEM;
+ return EOF;
+ }
+ tok->buf = new;
+ tok->inp = tok->buf + n;
+ tok->end = tok->inp + n;
+ }
+#ifdef USE_READLINE
+ if (tok->prompt != NULL) {
+ extern char *readline PROTO((char *prompt));
+ static int been_here;
+ if (!been_here) {
+ /* Force rebind of TAB to insert-tab */
+ extern int rl_insert();
+ rl_bind_key('\t', rl_insert);
+ been_here++;
+ }
+ if (tok->buf != NULL)
+ free(tok->buf);
+ tok->buf = readline(tok->prompt);
+ (void) intrcheck(); /* Clear pending interrupt */
+ if (tok->nextprompt != NULL)
+ tok->prompt = tok->nextprompt;
+ /* XXX different semantics w/o readline()! */
+ if (tok->buf == NULL) {
+ tok->done = E_EOF;
+ }
+ else {
+ unsigned int n = strlen(tok->buf);
+ if (n > 0)
+ add_history(tok->buf);
+ /* Append the '\n' that readline()
+ doesn't give us, for the tokenizer... */
+ tok->buf = realloc(tok->buf, n+2);
+ if (tok->buf == NULL)
+ tok->done = E_NOMEM;
+ else {
+ tok->end = tok->buf + n;
+ *tok->end++ = '\n';
+ *tok->end = '\0';
+ tok->inp = tok->end;
+ tok->cur = tok->buf;
+ }
+ }
+ }
+ else
+#endif
+ {
+ tok->cur = tok->inp;
+ if (tok->prompt != NULL && tok->inp == tok->buf) {
+ fprintf(stderr, "%s", tok->prompt);
+ tok->prompt = tok->nextprompt;
+ }
+ tok->done = fgets_intr(tok->inp,
+ (int)(tok->end - tok->inp), tok->fp);
+ }
+ if (tok->done != E_OK) {
+ if (tok->prompt != NULL)
+ fprintf(stderr, "\n");
+ return EOF;
+ }
+ tok->inp = strchr(tok->inp, '\0');
+ }
+}
+
+
+/* Back-up one character */
+
+static void
+tok_backup(tok, c)
+ register struct tok_state *tok;
+ register int c;
+{
+ if (c != EOF) {
+ if (--tok->cur < tok->buf) {
+ fprintf(stderr, "tok_backup: begin of buffer\n");
+ abort();
+ }
+ if (*tok->cur != c)
+ *tok->cur = c;
+ }
+}
+
+
+/* Return the token corresponding to a single character */
+
+int
+tok_1char(c)
+ int c;
+{
+ switch (c) {
+ case '(': return LPAR;
+ case ')': return RPAR;
+ case '[': return LSQB;
+ case ']': return RSQB;
+ case ':': return COLON;
+ case ',': return COMMA;
+ case ';': return SEMI;
+ case '+': return PLUS;
+ case '-': return MINUS;
+ case '*': return STAR;
+ case '/': return SLASH;
+ case '|': return VBAR;
+ case '&': return AMPER;
+ case '<': return LESS;
+ case '>': return GREATER;
+ case '=': return EQUAL;
+ case '.': return DOT;
+ case '%': return PERCENT;
+ case '`': return BACKQUOTE;
+ case '{': return LBRACE;
+ case '}': return RBRACE;
+ default: return OP;
+ }
+}
+
+
+/* Get next token, after space stripping etc. */
+
+int
+tok_get(tok, p_start, p_end)
+ register struct tok_state *tok; /* In/out: tokenizer state */
+ char **p_start, **p_end; /* Out: point to start/end of token */
+{
+ register int c;
+
+ /* Get indentation level */
+ if (tok->atbol) {
+ register int col = 0;
+ tok->atbol = 0;
+ tok->lineno++;
+ for (;;) {
+ c = tok_nextc(tok);
+ if (c == ' ')
+ col++;
+ else if (c == '\t')
+ col = (col/tok->tabsize + 1) * tok->tabsize;
+ else
+ break;
+ }
+ tok_backup(tok, c);
+ if (col == tok->indstack[tok->indent]) {
+ /* No change */
+ }
+ else if (col > tok->indstack[tok->indent]) {
+ /* Indent -- always one */
+ if (tok->indent+1 >= MAXINDENT) {
+ fprintf(stderr, "excessive indent\n");
+ tok->done = E_TOKEN;
+ return ERRORTOKEN;
+ }
+ tok->pendin++;
+ tok->indstack[++tok->indent] = col;
+ }
+ else /* col < tok->indstack[tok->indent] */ {
+ /* Dedent -- any number, must be consistent */
+ while (tok->indent > 0 &&
+ col < tok->indstack[tok->indent]) {
+ tok->indent--;
+ tok->pendin--;
+ }
+ if (col != tok->indstack[tok->indent]) {
+ fprintf(stderr, "inconsistent dedent\n");
+ tok->done = E_TOKEN;
+ return ERRORTOKEN;
+ }
+ }
+ }
+
+ *p_start = *p_end = tok->cur;
+
+ /* Return pending indents/dedents */
+ if (tok->pendin != 0) {
+ if (tok->pendin < 0) {
+ tok->pendin++;
+ return DEDENT;
+ }
+ else {
+ tok->pendin--;
+ return INDENT;
+ }
+ }
+
+ again:
+ /* Skip spaces */
+ do {
+ c = tok_nextc(tok);
+ } while (c == ' ' || c == '\t');
+
+ /* Set start of current token */
+ *p_start = tok->cur - 1;
+
+ /* Skip comment */
+ if (c == '#') {
+ /* Hack to allow overriding the tabsize in the file.
+ This is also recognized by vi, when it occurs near the
+ beginning or end of the file. (Will vi never die...?) */
+ int x;
+ /* XXX The case to (unsigned char *) is needed by THINK C 3.0 */
+ if (sscanf(/*(unsigned char *)*/tok->cur,
+ " vi:set tabsize=%d:", &x) == 1 &&
+ x >= 1 && x <= 40) {
+ fprintf(stderr, "# vi:set tabsize=%d:\n", x);
+ tok->tabsize = x;
+ }
+ do {
+ c = tok_nextc(tok);
+ } while (c != EOF && c != '\n');
+ }
+
+ /* Check for EOF and errors now */
+ if (c == EOF)
+ return tok->done == E_EOF ? ENDMARKER : ERRORTOKEN;
+
+ /* Identifier (most frequent token!) */
+ if (isalpha(c) || c == '_') {
+ do {
+ c = tok_nextc(tok);
+ } while (isalnum(c) || c == '_');
+ tok_backup(tok, c);
+ *p_end = tok->cur;
+ return NAME;
+ }
+
+ /* Newline */
+ if (c == '\n') {
+ tok->atbol = 1;
+ *p_end = tok->cur - 1; /* Leave '\n' out of the string */
+ return NEWLINE;
+ }
+
+ /* Number */
+ if (isdigit(c)) {
+ if (c == '0') {
+ /* Hex or octal */
+ c = tok_nextc(tok);
+ if (c == '.')
+ goto fraction;
+ if (c == 'x' || c == 'X') {
+ /* Hex */
+ do {
+ c = tok_nextc(tok);
+ } while (isxdigit(c));
+ }
+ else {
+ /* Octal; c is first char of it */
+ /* There's no 'isoctdigit' macro, sigh */
+ while ('0' <= c && c < '8') {
+ c = tok_nextc(tok);
+ }
+ }
+ }
+ else {
+ /* Decimal */
+ do {
+ c = tok_nextc(tok);
+ } while (isdigit(c));
+ /* Accept floating point numbers.
+ XXX This accepts incomplete things like 12e or 1e+;
+ worry about that at run-time.
+ XXX Doesn't accept numbers starting with a dot */
+ if (c == '.') {
+ fraction:
+ /* Fraction */
+ do {
+ c = tok_nextc(tok);
+ } while (isdigit(c));
+ }
+ if (c == 'e' || c == 'E') {
+ /* Exponent part */
+ c = tok_nextc(tok);
+ if (c == '+' || c == '-')
+ c = tok_nextc(tok);
+ while (isdigit(c)) {
+ c = tok_nextc(tok);
+ }
+ }
+ }
+ tok_backup(tok, c);
+ *p_end = tok->cur;
+ return NUMBER;
+ }
+
+ /* String */
+ if (c == '\'') {
+ for (;;) {
+ c = tok_nextc(tok);
+ if (c == '\n' || c == EOF) {
+ tok->done = E_TOKEN;
+ return ERRORTOKEN;
+ }
+ if (c == '\\') {
+ c = tok_nextc(tok);
+ *p_end = tok->cur;
+ if (c == '\n' || c == EOF) {
+ tok->done = E_TOKEN;
+ return ERRORTOKEN;
+ }
+ continue;
+ }
+ if (c == '\'')
+ break;
+ }
+ *p_end = tok->cur;
+ return STRING;
+ }
+
+ /* Line continuation */
+ if (c == '\\') {
+ c = tok_nextc(tok);
+ if (c != '\n') {
+ tok->done = E_TOKEN;
+ return ERRORTOKEN;
+ }
+ tok->lineno++;
+ goto again; /* Read next line */
+ }
+
+ /* Punctuation character */
+ *p_end = tok->cur;
+ return tok_1char(c);
+}
+
+
+#ifdef DEBUG
+
+void
+tok_dump(type, start, end)
+ int type;
+ char *start, *end;
+{
+ printf("%s", tok_name[type]);
+ if (type == NAME || type == NUMBER || type == STRING || type == OP)
+ printf("(%.*s)", (int)(end - start), start);
+}
+
+#endif
diff --git a/src/tokenizer.h b/src/tokenizer.h
new file mode 100644
index 0000000..aec5ef3
--- /dev/null
+++ b/src/tokenizer.h
@@ -0,0 +1,53 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Tokenizer interface */
+
+#include "token.h" /* For token types */
+
+#define MAXINDENT 100 /* Max indentation level */
+
+/* Tokenizer state */
+struct tok_state {
+ /* Input state; buf <= cur <= inp <= end */
+ /* NB an entire token must fit in the buffer */
+ char *buf; /* Input buffer */
+ char *cur; /* Next character in buffer */
+ char *inp; /* End of data in buffer */
+ char *end; /* End of input buffer */
+ int done; /* 0 normally, 1 at EOF, -1 after error */
+ FILE *fp; /* Rest of input; NULL if tokenizing a string */
+ int tabsize; /* Tab spacing */
+ int indent; /* Current indentation index */
+ int indstack[MAXINDENT]; /* Stack of indents */
+ int atbol; /* Nonzero if at begin of new line */
+ int pendin; /* Pending indents (if > 0) or dedents (if < 0) */
+ char *prompt, *nextprompt; /* For interactive prompting */
+ int lineno; /* Current line number */
+};
+
+extern struct tok_state *tok_setups PROTO((char *));
+extern struct tok_state *tok_setupf PROTO((FILE *, char *ps1, char *ps2));
+extern void tok_free PROTO((struct tok_state *));
+extern int tok_get PROTO((struct tok_state *, char **, char **));
diff --git a/src/traceback.c b/src/traceback.c
new file mode 100644
index 0000000..7d40ca5
--- /dev/null
+++ b/src/traceback.c
@@ -0,0 +1,217 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Traceback implementation */
+
+#include "allobjects.h"
+
+#include "compile.h"
+#include "frameobject.h"
+#include "traceback.h"
+#include "structmember.h"
+
+typedef struct _tracebackobject {
+ OB_HEAD
+ struct _tracebackobject *tb_next;
+ frameobject *tb_frame;
+ int tb_lasti;
+ int tb_lineno;
+} tracebackobject;
+
+#define OFF(x) offsetof(tracebackobject, x)
+
+static struct memberlist tb_memberlist[] = {
+ {"tb_next", T_OBJECT, OFF(tb_next)},
+ {"tb_frame", T_OBJECT, OFF(tb_frame)},
+ {"tb_lasti", T_INT, OFF(tb_lasti)},
+ {"tb_lineno", T_INT, OFF(tb_lineno)},
+ {NULL} /* Sentinel */
+};
+
+static object *
+tb_getattr(tb, name)
+ tracebackobject *tb;
+ char *name;
+{
+ return getmember((char *)tb, tb_memberlist, name);
+}
+
+static void
+tb_dealloc(tb)
+ tracebackobject *tb;
+{
+ XDECREF(tb->tb_next);
+ XDECREF(tb->tb_frame);
+ DEL(tb);
+}
+
+static typeobject Tracebacktype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "traceback",
+ sizeof(tracebackobject),
+ 0,
+ tb_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ tb_getattr, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
+
+#define is_tracebackobject(v) ((v)->ob_type == &Tracebacktype)
+
+static tracebackobject *
+newtracebackobject(next, frame, lasti, lineno)
+ tracebackobject *next;
+ frameobject *frame;
+ int lasti, lineno;
+{
+ tracebackobject *tb;
+ if ((next != NULL && !is_tracebackobject(next)) ||
+ frame == NULL || !is_frameobject(frame)) {
+ err_badcall();
+ return NULL;
+ }
+ tb = NEWOBJ(tracebackobject, &Tracebacktype);
+ if (tb != NULL) {
+ XINCREF(next);
+ tb->tb_next = next;
+ XINCREF(frame);
+ tb->tb_frame = frame;
+ tb->tb_lasti = lasti;
+ tb->tb_lineno = lineno;
+ }
+ return tb;
+}
+
+static tracebackobject *tb_current = NULL;
+
+int
+tb_here(frame, lasti, lineno)
+ frameobject *frame;
+ int lasti;
+ int lineno;
+{
+ tracebackobject *tb;
+ tb = newtracebackobject(tb_current, frame, lasti, lineno);
+ if (tb == NULL)
+ return -1;
+ XDECREF(tb_current);
+ tb_current = tb;
+ return 0;
+}
+
+object *
+tb_fetch()
+{
+ object *v;
+ v = (object *)tb_current;
+ tb_current = NULL;
+ return v;
+}
+
+int
+tb_store(v)
+ object *v;
+{
+ if (v != NULL && !is_tracebackobject(v)) {
+ err_badcall();
+ return -1;
+ }
+ XDECREF(tb_current);
+ XINCREF(v);
+ tb_current = (tracebackobject *)v;
+ return 0;
+}
+
+static void
+tb_displayline(fp, filename, lineno)
+ FILE *fp;
+ char *filename;
+ int lineno;
+{
+ FILE *xfp;
+ char buf[1000];
+ int i;
+ if (filename[0] == '<' && filename[strlen(filename)-1] == '>')
+ return;
+ xfp = fopen(filename, "r");
+ if (xfp == NULL) {
+ fprintf(fp, " (cannot open \"%s\")\n", filename);
+ return;
+ }
+ for (i = 0; i < lineno; i++) {
+ if (fgets(buf, sizeof buf, xfp) == NULL)
+ break;
+ }
+ if (i == lineno) {
+ char *p = buf;
+ while (*p == ' ' || *p == '\t')
+ p++;
+ fprintf(fp, " %s", p);
+ if (strchr(p, '\n') == NULL)
+ fprintf(fp, "\n");
+ }
+ fclose(xfp);
+}
+
+static void
+tb_printinternal(tb, fp)
+ tracebackobject *tb;
+ FILE *fp;
+{
+ while (tb != NULL) {
+ if (intrcheck()) {
+ fprintf(fp, "[interrupted]\n");
+ break;
+ }
+ fprintf(fp, " File \"");
+ printobject(tb->tb_frame->f_code->co_filename, fp, PRINT_RAW);
+ fprintf(fp, "\", line %d\n", tb->tb_lineno);
+ tb_displayline(fp,
+ getstringvalue(tb->tb_frame->f_code->co_filename),
+ tb->tb_lineno);
+ tb = tb->tb_next;
+ }
+}
+
+int
+tb_print(v, fp)
+ object *v;
+ FILE *fp;
+{
+ if (v == NULL)
+ return 0;
+ if (!is_tracebackobject(v)) {
+ err_badcall();
+ return -1;
+ }
+ sysset("last_traceback", v);
+ tb_printinternal((tracebackobject *)v, fp);
+ return 0;
+}
diff --git a/src/traceback.h b/src/traceback.h
new file mode 100644
index 0000000..2127a33
--- /dev/null
+++ b/src/traceback.h
@@ -0,0 +1,30 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Traceback interface */
+
+int tb_here PROTO((struct _frame *, int, int));
+object *tb_fetch PROTO((void));
+int tb_store PROTO((object *));
+int tb_print PROTO((object *, FILE *));
diff --git a/src/tupleobject.c b/src/tupleobject.c
new file mode 100644
index 0000000..5ea1e11
--- /dev/null
+++ b/src/tupleobject.c
@@ -0,0 +1,287 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Tuple object implementation */
+
+#include "allobjects.h"
+
+object *
+newtupleobject(size)
+ register int size;
+{
+ register int i;
+ register tupleobject *op;
+ if (size < 0) {
+ err_badcall();
+ return NULL;
+ }
+ op = (tupleobject *)
+ malloc(sizeof(tupleobject) + size * sizeof(object *));
+ if (op == NULL)
+ return err_nomem();
+ NEWREF(op);
+ op->ob_type = &Tupletype;
+ op->ob_size = size;
+ for (i = 0; i < size; i++)
+ op->ob_item[i] = NULL;
+ return (object *) op;
+}
+
+int
+gettuplesize(op)
+ register object *op;
+{
+ if (!is_tupleobject(op)) {
+ err_badcall();
+ return -1;
+ }
+ else
+ return ((tupleobject *)op)->ob_size;
+}
+
+object *
+gettupleitem(op, i)
+ register object *op;
+ register int i;
+{
+ if (!is_tupleobject(op)) {
+ err_badcall();
+ return NULL;
+ }
+ if (i < 0 || i >= ((tupleobject *)op) -> ob_size) {
+ err_setstr(IndexError, "tuple index out of range");
+ return NULL;
+ }
+ return ((tupleobject *)op) -> ob_item[i];
+}
+
+int
+settupleitem(op, i, newitem)
+ register object *op;
+ register int i;
+ register object *newitem;
+{
+ register object *olditem;
+ if (!is_tupleobject(op)) {
+ if (newitem != NULL)
+ DECREF(newitem);
+ err_badcall();
+ return -1;
+ }
+ if (i < 0 || i >= ((tupleobject *)op) -> ob_size) {
+ if (newitem != NULL)
+ DECREF(newitem);
+ err_setstr(IndexError, "tuple assignment index out of range");
+ return -1;
+ }
+ olditem = ((tupleobject *)op) -> ob_item[i];
+ ((tupleobject *)op) -> ob_item[i] = newitem;
+ if (olditem != NULL)
+ DECREF(olditem);
+ return 0;
+}
+
+/* Methods */
+
+static void
+tupledealloc(op)
+ register tupleobject *op;
+{
+ register int i;
+ for (i = 0; i < op->ob_size; i++) {
+ if (op->ob_item[i] != NULL)
+ DECREF(op->ob_item[i]);
+ }
+ free((ANY *)op);
+}
+
+static void
+tupleprint(op, fp, flags)
+ tupleobject *op;
+ FILE *fp;
+ int flags;
+{
+ int i;
+ fprintf(fp, "(");
+ for (i = 0; i < op->ob_size && !StopPrint; i++) {
+ if (i > 0) {
+ fprintf(fp, ", ");
+ }
+ printobject(op->ob_item[i], fp, flags);
+ }
+ if (op->ob_size == 1)
+ fprintf(fp, ",");
+ fprintf(fp, ")");
+}
+
+object *
+tuplerepr(v)
+ tupleobject *v;
+{
+ object *s, *t, *comma;
+ int i;
+ s = newstringobject("(");
+ comma = newstringobject(", ");
+ for (i = 0; i < v->ob_size && s != NULL; i++) {
+ if (i > 0)
+ joinstring(&s, comma);
+ t = reprobject(v->ob_item[i]);
+ joinstring(&s, t);
+ if (t != NULL)
+ DECREF(t);
+ }
+ DECREF(comma);
+ if (v->ob_size == 1) {
+ t = newstringobject(",");
+ joinstring(&s, t);
+ DECREF(t);
+ }
+ t = newstringobject(")");
+ joinstring(&s, t);
+ DECREF(t);
+ return s;
+}
+
+static int
+tuplecompare(v, w)
+ register tupleobject *v, *w;
+{
+ register int len =
+ (v->ob_size < w->ob_size) ? v->ob_size : w->ob_size;
+ register int i;
+ for (i = 0; i < len; i++) {
+ int cmp = cmpobject(v->ob_item[i], w->ob_item[i]);
+ if (cmp != 0)
+ return cmp;
+ }
+ return v->ob_size - w->ob_size;
+}
+
+static int
+tuplelength(a)
+ tupleobject *a;
+{
+ return a->ob_size;
+}
+
+static object *
+tupleitem(a, i)
+ register tupleobject *a;
+ register int i;
+{
+ if (i < 0 || i >= a->ob_size) {
+ err_setstr(IndexError, "tuple index out of range");
+ return NULL;
+ }
+ INCREF(a->ob_item[i]);
+ return a->ob_item[i];
+}
+
+static object *
+tupleslice(a, ilow, ihigh)
+ register tupleobject *a;
+ register int ilow, ihigh;
+{
+ register tupleobject *np;
+ register int i;
+ if (ilow < 0)
+ ilow = 0;
+ if (ihigh > a->ob_size)
+ ihigh = a->ob_size;
+ if (ihigh < ilow)
+ ihigh = ilow;
+ if (ilow == 0 && ihigh == a->ob_size) {
+ /* XXX can only do this if tuples are immutable! */
+ INCREF(a);
+ return (object *)a;
+ }
+ np = (tupleobject *)newtupleobject(ihigh - ilow);
+ if (np == NULL)
+ return NULL;
+ for (i = ilow; i < ihigh; i++) {
+ object *v = a->ob_item[i];
+ INCREF(v);
+ np->ob_item[i - ilow] = v;
+ }
+ return (object *)np;
+}
+
+static object *
+tupleconcat(a, bb)
+ register tupleobject *a;
+ register object *bb;
+{
+ register int size;
+ register int i;
+ tupleobject *np;
+ if (!is_tupleobject(bb)) {
+ err_badarg();
+ return NULL;
+ }
+#define b ((tupleobject *)bb)
+ size = a->ob_size + b->ob_size;
+ np = (tupleobject *) newtupleobject(size);
+ if (np == NULL) {
+ return err_nomem();
+ }
+ for (i = 0; i < a->ob_size; i++) {
+ object *v = a->ob_item[i];
+ INCREF(v);
+ np->ob_item[i] = v;
+ }
+ for (i = 0; i < b->ob_size; i++) {
+ object *v = b->ob_item[i];
+ INCREF(v);
+ np->ob_item[i + a->ob_size] = v;
+ }
+ return (object *)np;
+#undef b
+}
+
+static sequence_methods tuple_as_sequence = {
+ tuplelength, /*sq_length*/
+ tupleconcat, /*sq_concat*/
+ 0, /*sq_repeat*/
+ tupleitem, /*sq_item*/
+ tupleslice, /*sq_slice*/
+ 0, /*sq_ass_item*/
+ 0, /*sq_ass_slice*/
+};
+
+typeobject Tupletype = {
+ OB_HEAD_INIT(&Typetype)
+ 0,
+ "tuple",
+ sizeof(tupleobject) - sizeof(object *),
+ sizeof(object *),
+ tupledealloc, /*tp_dealloc*/
+ tupleprint, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ tuplecompare, /*tp_compare*/
+ tuplerepr, /*tp_repr*/
+ 0, /*tp_as_number*/
+ &tuple_as_sequence, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+};
diff --git a/src/tupleobject.h b/src/tupleobject.h
new file mode 100644
index 0000000..293da22
--- /dev/null
+++ b/src/tupleobject.h
@@ -0,0 +1,56 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Tuple object interface */
+
+/*
+123456789-123456789-123456789-123456789-123456789-123456789-123456789-12
+
+Another generally useful object type is an tuple of object pointers.
+This is a mutable type: the tuple items can be changed (but not their
+number). Out-of-range indices or non-tuple objects are ignored.
+
+*** WARNING *** settupleitem does not increment the new item's reference
+count, but does decrement the reference count of the item it replaces,
+if not nil. It does *decrement* the reference count if it is *not*
+inserted in the tuple. Similarly, gettupleitem does not increment the
+returned item's reference count.
+*/
+
+typedef struct {
+ OB_VARHEAD
+ object *ob_item[1];
+} tupleobject;
+
+extern typeobject Tupletype;
+
+#define is_tupleobject(op) ((op)->ob_type == &Tupletype)
+
+extern object *newtupleobject PROTO((int size));
+extern int gettuplesize PROTO((object *));
+extern object *gettupleitem PROTO((object *, int));
+extern int settupleitem PROTO((object *, int, object *));
+
+/* Macro, trading safety for speed */
+#define GETTUPLEITEM(op, i) ((op)->ob_item[i])
diff --git a/src/typeobject.c b/src/typeobject.c
new file mode 100644
index 0000000..39ed7c7
--- /dev/null
+++ b/src/typeobject.c
@@ -0,0 +1,61 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Type object implementation */
+
+#include "allobjects.h"
+
+/* Type object implementation */
+
+static void
+type_print(v, fp, flags)
+ typeobject *v;
+ FILE *fp;
+ int flags;
+{
+ fprintf(fp, "<type '%s'>", v->tp_name);
+}
+
+static object *
+type_repr(v)
+ typeobject *v;
+{
+ char buf[100];
+ sprintf(buf, "<type '%.80s'>", v->tp_name);
+ return newstringobject(buf);
+}
+
+typeobject Typetype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /* Number of items for varobject */
+ "type", /* Name of this type */
+ sizeof(typeobject), /* Basic object size */
+ 0, /* Item size for varobject */
+ 0, /*tp_dealloc*/
+ type_print, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ type_repr, /*tp_repr*/
+};
diff --git a/src/xxobject.c b/src/xxobject.c
new file mode 100644
index 0000000..52be44b
--- /dev/null
+++ b/src/xxobject.c
@@ -0,0 +1,131 @@
+/***********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* Use this file as a template to start implementing a new object type.
+ If your objects will be called foobar, start by copying this file to
+ foobarobject.c, changing all occurrences of xx to foobar and all
+ occurrences of Xx by Foobar. You will probably want to delete all
+ references to 'x_attr' and add your own types of attributes
+ instead. Maybe you want to name your local variables other than
+ 'xp'. If your object type is needed in other files, you'll have to
+ create a file "foobarobject.h"; see intobject.h for an example. */
+
+
+/* Xx objects */
+
+#include "allobjects.h"
+
+typedef struct {
+ OB_HEAD
+ object *x_attr; /* Attributes dictionary */
+} xxobject;
+
+extern typeobject Xxtype; /* Really static, forward */
+
+#define is_xxobject(v) ((v)->ob_type == &Xxtype)
+
+static xxobject *
+newxxobject(arg)
+ object *arg;
+{
+ xxobject *xp;
+ xp = NEWOBJ(xxobject, &Xxtype);
+ if (xp == NULL)
+ return NULL;
+ xp->x_attr = NULL;
+ return xp;
+}
+
+/* Xx methods */
+
+static void
+xx_dealloc(xp)
+ xxobject *xp;
+{
+ XDECREF(xp->x_attr);
+ DEL(xp);
+}
+
+static object *
+xx_demo(self, args)
+ xxobject *self;
+ object *args;
+{
+ if (!getnoarg(args))
+ return NULL;
+ INCREF(None);
+ return None;
+}
+
+static struct methodlist xx_methods[] = {
+ "demo", xx_demo,
+ {NULL, NULL} /* sentinel */
+};
+
+static object *
+xx_getattr(xp, name)
+ xxobject *xp;
+ char *name;
+{
+ if (xp->x_attr != NULL) {
+ object *v = dictlookup(xp->x_attr, name);
+ if (v != NULL) {
+ INCREF(v);
+ return v;
+ }
+ }
+ return findmethod(xx_methods, (object *)xp, name);
+}
+
+static int
+xx_setattr(xp, name, v)
+ xxobject *xp;
+ char *name;
+ object *v;
+{
+ if (xp->x_attr == NULL) {
+ xp->x_attr = newdictobject();
+ if (xp->x_attr == NULL)
+ return -1;
+ }
+ if (v == NULL)
+ return dictremove(xp->x_attr, name);
+ else
+ return dictinsert(xp->x_attr, name, v);
+}
+
+static typeobject Xxtype = {
+ OB_HEAD_INIT(&Typetype)
+ 0, /*ob_size*/
+ "xx", /*tp_name*/
+ sizeof(xxobject), /*tp_size*/
+ 0, /*tp_itemsize*/
+ /* methods */
+ xx_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ xx_getattr, /*tp_getattr*/
+ xx_setattr, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+};