* lex yacc

utils/tply/COPYING

@@ -0,0 +1,339 @@
+                   GNU GENERAL PUBLIC LICENSE
+                       Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+                          675 Mass Ave, Cambridge, MA 02139, USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+                            Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it.  (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.)  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must show them these terms so they know their
+rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary.  To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+                    GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License.  The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language.  (Hereinafter, translation is included without limitation in
+the term "modification".)  Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+  1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+  2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) You must cause the modified files to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    b) You must cause any work that you distribute or publish, that in
+    whole or in part contains or is derived from the Program or any
+    part thereof, to be licensed as a whole at no charge to all third
+    parties under the terms of this License.
+
+    c) If the modified program normally reads commands interactively
+    when run, you must cause it, when started running for such
+    interactive use in the most ordinary way, to print or display an
+    announcement including an appropriate copyright notice and a
+    notice that there is no warranty (or else, saying that you provide
+    a warranty) and that users may redistribute the program under
+    these conditions, and telling the user how to view a copy of this
+    License.  (Exception: if the Program itself is interactive but
+    does not normally print such an announcement, your work based on
+    the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+    a) Accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of Sections
+    1 and 2 above on a medium customarily used for software interchange; or,
+
+    b) Accompany it with a written offer, valid for at least three
+    years, to give any third party, for a charge no more than your
+    cost of physically performing source distribution, a complete
+    machine-readable copy of the corresponding source code, to be
+    distributed under the terms of Sections 1 and 2 above on a medium
+    customarily used for software interchange; or,
+
+    c) Accompany it with the information you received as to the offer
+    to distribute corresponding source code.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form with such
+    an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it.  For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable.  However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+  5. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Program or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+  9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+  10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+                            NO WARRANTY
+
+  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+                     END OF TERMS AND CONDITIONS
+
+        Appendix: How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) 19yy  <name of author>
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+    Gnomovision version 69, Copyright (C) 19yy name of author
+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+  `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs.  If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library.  If this is what you want to do, use the GNU Library General
+Public License instead of this License.

utils/tply/Makefile

@@ -0,0 +1,926 @@
+#
+# Makefile generated by fpcmake v0.99.13 on 1999-11-24 23:15
+#
+
+defaultrule: all
+
+#####################################################################
+# Autodetect OS (Linux or Dos or Windows NT)
+# define inlinux when running under linux
+# define inWinNT when running under WinNT
+#####################################################################
+
+# We need only / in the path
+override PATH:=$(subst \,/,$(PATH))
+
+# Search for PWD and determine also if we are under linux
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH)))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH)))))
+ifeq ($(PWD),)
+nopwd:
+	@echo You need the GNU utils package to use this Makefile!
+	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
+	@exit
+else
+inlinux=1
+endif
+else
+PWD:=$(firstword $(PWD))
+endif
+
+# Detect NT - NT sets OS to Windows_NT
+ifndef inlinux
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+endif
+endif
+
+# Detect OS/2 - OS/2 has OS2_SHELL defined
+ifndef inlinux
+ifndef inWinNT
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+endif
+
+# The extension of executables
+ifdef inlinux
+EXEEXT=
+else
+EXEEXT=.exe
+endif
+
+# The path which is search separated by spaces
+ifdef inlinux
+SEARCHPATH=$(subst :, ,$(PATH))
+else
+SEARCHPATH=$(subst ;, ,$(PATH))
+endif
+
+#####################################################################
+# FPC version/target Detection
+#####################################################################
+
+# What compiler to use ?
+ifndef FPC
+ifdef inOS2
+export FPC=ppos2$(EXEEXT)
+else
+export FPC=ppc386$(EXEEXT)
+endif
+endif
+
+# Target OS
+ifndef OS_TARGET
+export OS_TARGET:=$(shell $(FPC) -iTO)
+endif
+
+# Source OS
+ifndef OS_SOURCE
+export OS_SOURCE:=$(shell $(FPC) -iSO)
+endif
+
+# Target CPU
+ifndef CPU_TARGET
+export CPU_TARGET:=$(shell $(FPC) -iTP)
+endif
+
+# Source CPU
+ifndef CPU_SOURCE
+export CPU_SOURCE:=$(shell $(FPC) -iSP)
+endif
+
+# FPC version
+ifndef FPC_VERSION
+export FPC_VERSION:=$(shell $(FPC) -iV)
+endif
+
+#####################################################################
+# Default Settings
+#####################################################################
+
+# Release ? Then force OPT and don't use extra opts via commandline
+ifdef RELEASE
+override OPT:=-Xs -OG2p3 -n
+endif
+
+# Verbose settings (warning,note,info)
+ifdef VERBOSE
+override OPT+=-vwni
+endif
+
+#####################################################################
+# User Settings
+#####################################################################
+
+
+# Pre Settings
+
+ifdef inlinux
+CODPATH=/usr/lib/fpc/lexyacc
+else
+CODPATH=$(BININSTALLDIR)
+endif
+
+# Targets
+
+UNITOBJECTS+=lexlib yacclib
+EXEOBJECTS+=plex pyacc
+
+# Clean
+
+EXTRACLEANUNITS+=lexbase lexopt lexdfa lexpos lexlist lexrules lexmsgs lextable yaccbase yaccmsgs yaccclos yaccpars yacclook yaccsem yacclr0 yacctabl
+
+# Install
+
+EXTRAINSTALLFILES+=yylex.cod yyparse.cod
+
+# Defaults
+
+override NEEDOPT=-Sg
+
+# Directories
+
+ifndef FPCDIR
+FPCDIR=../..
+endif
+ifndef PACKAGEDIR
+PACKAGEDIR=$(FPCDIR)/packages
+endif
+
+# Packages
+
+
+# Libraries
+
+
+# Info
+
+FPCINFO=fpc_infocfg fpc_infoobjects fpc_infoinstall 
+
+#####################################################################
+# Default Directories
+#####################################################################
+
+# Base dir
+ifdef PWD
+BASEDIR:=$(shell $(PWD))
+else
+BASEDIR=.
+endif
+
+# this can be set to 'rtl' when the RTL units are installed
+ifndef UNITPREFIX
+UNITPREFIX=units
+endif
+
+# set the prefix directory where to install everything
+ifndef PREFIXINSTALLDIR
+ifdef inlinux
+export PREFIXINSTALLDIR=/usr
+else
+export PREFIXINSTALLDIR=/pp
+endif
+endif
+
+#####################################################################
+# Install Directories
+#####################################################################
+
+# set the base directory where to install everything
+ifndef BASEINSTALLDIR
+ifdef inlinux
+BASEINSTALLDIR=$(PREFIXINSTALLDIR)/lib/fpc/$(FPC_VERSION)
+else
+BASEINSTALLDIR=$(PREFIXINSTALLDIR)
+endif
+endif
+
+# set the directory where to install the binaries
+ifndef BININSTALLDIR
+ifdef inlinux
+BININSTALLDIR=$(PREFIXINSTALLDIR)/bin
+else
+BININSTALLDIR=$(BASEINSTALLDIR)/bin/$(OS_TARGET)
+endif
+endif
+
+# set the directory where to install the units.
+ifndef UNITINSTALLDIR
+UNITINSTALLDIR=$(BASEINSTALLDIR)/$(UNITPREFIX)/$(OS_TARGET)
+endif
+
+# Where to install shared libraries
+ifndef LIBINSTALLDIR
+ifdef inlinux
+LIBINSTALLDIR=$(PREFIXINSTALLDIR)/lib
+else
+LIBINSTALLDIR=$(UNITINSTALLDIR)
+endif
+endif
+
+# Where the source files will be stored
+ifndef SOURCEINSTALLDIR
+ifdef inlinux
+SOURCEINSTALLDIR=$(PREFIXINSTALLDIR)/src/fpc-$(FPC_VERSION)
+else
+SOURCEINSTALLDIR=$(BASEINSTALLDIR)/source
+endif
+endif
+
+# Where the doc files will be stored
+ifndef DOCINSTALLDIR
+ifdef inlinux
+DOCINSTALLDIR=$(PREFIXINSTALLDIR)/doc/fpc/$(FPC_VERSION)
+else
+DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
+endif
+endif
+
+# Where the some extra (data)files will be stored
+ifndef EXTRAINSTALLDIR
+EXTRAINSTALLDIR=$(BASEINSTALLDIR)
+endif
+
+
+#####################################################################
+# Compiler Command Line
+#####################################################################
+
+# Load commandline OPTDEF and add FPC_CPU define
+override FPCOPTDEF:=-d$(CPU_TARGET)
+
+# Load commandline OPT and add target and unit dir to be sure
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+
+ifdef NEEDOPT
+override FPCOPT+=$(NEEDOPT)
+endif
+
+# RTL first and then Unit dir (a unit can override RTLunit). Don't add the
+# dirs if fpcdir=. which can be used for the rtl makefiles
+ifdef FPCDIR
+ifneq ($(FPCDIR),.)
+override FPCOPT+=-Fu$(FPCDIR)/rtl/$(OS_TARGET) -Fu$(FPCDIR)/units/$(OS_TARGET)
+endif
+endif
+
+# Smartlinking
+ifdef SMARTLINK
+override FPCOPT+=-CX
+endif
+
+# Debug
+ifdef DEBUG
+override FPCOPT+=-g
+endif
+
+# Add commandline options
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+
+# Add defines from FPCOPTDEF to FPCOPT
+ifdef FPCOPTDEF
+override FPCOPT+=$(FPCOPTDEF)
+endif
+
+# Was a config file specified ?
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+
+override COMPILER=$(FPC) $(FPCOPT)
+
+#####################################################################
+# Shell tools
+#####################################################################
+
+# To copy pograms
+ifndef COPY
+export COPY:=cp -fp
+endif
+
+# To move pograms
+ifndef MOVE
+export MOVE:=mv -f
+endif
+
+# Check delete program
+ifndef DEL
+export DEL:=rm -f
+endif
+
+# Check deltree program
+ifndef DELTREE
+export DELTREE:=rm -rf
+endif
+
+# To install files
+ifndef INSTALL
+ifdef inlinux
+export INSTALL:=install -m 644
+else
+export INSTALL:=$(COPY)
+endif
+endif
+
+# To install programs
+ifndef INSTALLEXE
+ifdef inlinux
+export INSTALLEXE:=install -m 755
+else
+export INSTALLEXE:=$(COPY)
+endif
+endif
+
+# To make a directory.
+ifndef MKDIR
+ifdef inlinux
+export MKDIR:=install -m 755 -d
+else
+export MKDIR:=ginstall -m 755 -d
+endif
+endif
+
+#####################################################################
+# Default Tools
+#####################################################################
+
+# assembler, redefine it if cross compiling
+ifndef AS
+AS=as
+endif
+
+# linker, but probably not used
+ifndef LD
+LD=ld
+endif
+
+# ppas.bat / ppas.sh
+ifdef inlinux
+PPAS=ppas.sh
+else
+ifdef inOS2
+PPAS=ppas.cmd
+else
+PPAS=ppas.bat
+endif
+endif
+
+# also call ppas if with command option -s
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+EXECPPAS=@$(PPAS)
+endif
+
+# ldconfig to rebuild .so cache
+ifdef inlinux
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+
+# echo
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+export ECHO:=echo
+else
+export ECHO:=$(firstword $(ECHO))
+endif
+endif
+
+# ppdep
+ifndef PPDEP
+PPDEP:=$(strip $(wildcard $(addsuffix /ppdep$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(PPDEP),)
+PPDEP=
+else
+export PPDEP:=$(firstword $(PPDEP))
+endif
+endif
+
+# ppumove
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE=
+else
+export PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+
+# ppufiles
+ifndef PPUFILES
+PPUFILES:=$(strip $(wildcard $(addsuffix /ppufiles$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUFILES),)
+PPUFILES=
+else
+export PPUFILES:=$(firstword $(PPUFILES))
+endif
+endif
+
+# Look if UPX is found for go32v2 and win32. We can't use $UPX becuase
+# upx uses that one itself (PFV)
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+export UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+
+# gdate/date
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /date$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(EXEEXT),$(SEACHPATH))))
+ifeq ($(DATE),)
+DATE=
+else
+export DATE:=$(firstword $(DATE))
+endif
+else
+export DATE:=$(firstword $(DATE))
+endif
+endif
+
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+
+# ZipProg, you can't use Zip as the var name (PFV)
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG=
+else
+export ZIPPROG:=$(firstword $(ZIPPROG)) -D9 -r
+endif
+endif
+
+ifndef ZIPEXT
+ZIPEXT=.zip
+endif
+
+#####################################################################
+# Default extensions
+#####################################################################
+
+# Default needed extensions (Go32v2,Linux)
+LOADEREXT=.as
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+PACKAGESUFFIX=
+
+# Go32v1
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+PACKAGESUFFIX=v1
+endif
+
+# Go32v2
+ifeq ($(OS_TARGET),go32v2)
+PACKAGESUFFIX=go32
+endif
+
+# Linux
+ifeq ($(OS_TARGET),linux)
+PACKAGESUFFIX=linux
+endif
+
+# Win32
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+PACKAGESUFFIX=win32
+endif
+
+# OS/2
+ifeq ($(OS_TARGET),os2)
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+SMARTEXT=.so
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+PACKAGESUFFIX=os2
+endif
+
+# library prefix
+LIBPREFIX=lib
+ifeq ($(OS_TARGET),go32v2)
+LIBPREFIX=
+endif
+ifeq ($(OS_TARGET),go32v1)
+LIBPREFIX=
+endif
+
+# determine which .pas extension is used
+ifndef PASEXT
+ifdef EXEOBJECTS
+override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(EXEOBJECTS)))))
+else
+override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(UNITOBJECTS)))))
+endif
+ifeq ($(TESTPAS),)
+PASEXT=.pp
+else
+PASEXT=.pas
+endif
+endif
+
+#####################################################################
+# Default rules
+#####################################################################
+
+.PHONY: defaultrule all debug examples test smart shared \
+	showinstall install zipinstall zipinstalladd \
+	clean cleanall depend info
+
+all: fpc_all
+
+debug: fpc_debug
+
+smart: fpc_smart
+
+shared: fpc_shared
+
+showinstall: fpc_showinstall
+
+install: fpc_install
+
+zipinstall: fpc_zipinstall
+
+zipinstalladd: fpc_zipinstalladd
+
+clean: fpc_clean
+
+cleanall: fpc_cleanall
+
+info: fpc_info
+
+#####################################################################
+# Units
+#####################################################################
+
+.PHONY: fpc_units
+
+override ALLTARGET+=fpc_units
+
+UNITPPUFILES=$(addsuffix $(PPUEXT),$(UNITOBJECTS))
+override INSTALLPPUFILES+=$(UNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES)
+
+fpc_units: $(UNITPPUFILES)
+
+#####################################################################
+# Exes
+#####################################################################
+
+.PHONY: fpc_exes
+
+EXEFILES=$(addsuffix $(EXEEXT),$(EXEOBJECTS))
+EXEOFILES=$(addsuffix $(OEXT),$(EXEOBJECTS))
+
+override ALLTARGET+=fpc_exes
+override INSTALLEXEFILES+=$(EXEFILES)
+override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)
+
+fpc_exes: $(EXEFILES)
+
+#####################################################################
+# General compile rules
+#####################################################################
+
+.PHONY: fpc_all fpc_debug
+
+fpc_all: $(ALLTARGET)
+
+fpc_debug:
+	$(MAKE) all DEBUG=1
+
+# General compile rules, available for both possible PASEXT
+
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
+
+%$(PPUEXT): %.pp
+	$(COMPILER) $< $(REDIR)
+	$(EXECPASS)
+
+%$(PPUEXT): %.pas
+	$(COMPILER) $< $(REDIR)
+	$(EXECPASS)
+
+%$(EXEEXT): %.pp
+	$(COMPILER) $< $(REDIR)
+	$(EXECPASS)
+
+%$(EXEEXT): %.pas
+	$(COMPILER) $< $(REDIR)
+	$(EXECPASS)
+
+#####################################################################
+# Library
+#####################################################################
+
+.PHONY: fpc_smart fpc_shared
+
+# Default sharedlib units are all unit objects
+ifndef SHAREDLIBUNITOBJECTS
+SHAREDLIBUNITOBJECTS=$(UNITOBJECTS)
+endif
+
+fpc_smart:
+	$(MAKE) all SMARTLINK=1
+
+fpc_shared: all
+ifdef inlinux
+ifndef LIBNAME
+	@$(ECHO) LIBNAME not set
+else
+	$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBNAME)
+endif
+else
+	@$(ECHO) Shared Libraries not supported
+endif
+
+#####################################################################
+# Install rules
+#####################################################################
+
+.PHONY: fpc_showinstall fpc_install
+
+ifdef EXTRAINSTALLUNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRAINSTALLUNITS))
+endif
+
+ifdef INSTALLPPUFILES
+ifdef PPUFILES
+ifdef inlinux
+INSTALLPPULINKFILES=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
+INSTALLPPULIBFILES=$(shell $(PPUFILES) -L $(INSTALLPPUFILES))
+else
+INSTALLPPULINKFILES=$(shell $(PPUFILES) $(INSTALLPPUFILES))
+endif
+endif
+endif
+
+fpc_showinstall: $(SHOWINSTALLTARGET)
+ifdef INSTALLEXEFILES
+	@$(ECHO) $(addprefix "\n"$(BININSTALLDIR)/,$(INSTALLEXEFILES))
+endif
+ifdef INSTALLPPUFILES
+	@$(ECHO) $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPUFILES))
+ifneq ($(INSTALLPPULINKFILES),)
+	@$(ECHO) $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPULINKFILES))
+endif
+ifneq ($(INSTALLPPULIBFILES),)
+	@$(ECHO) $(addprefix "\n"$(LIBINSTALLDIR)/,$(INSTALLPPULIBFILES))
+endif
+endif
+ifdef EXTRAINSTALLFILES
+	@$(ECHO) $(addprefix "\n"$(EXTRAINSTALLDIR)/,$(EXTRAINSTALLFILES))
+endif
+
+fpc_install: $(INSTALLTARGET)
+# Create UnitInstallFiles
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(BININSTALLDIR)
+# Compress the exes if upx is defined
+ifdef UPXPROG
+	-$(UPXPROG) $(INSTALLEXEFILES)
+endif
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(BININSTALLDIR)
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(UNITINSTALLDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(UNITINSTALLDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(UNITINSTALLDIR)
+endif
+ifneq ($(INSTALLPPULIBFILES),)
+	$(MKDIR) $(LIBINSTALLDIR)
+	$(INSTALL) $(INSTALLPPULIBFILES) $(LIBINSTALLDIR)
+endif
+endif
+ifdef EXTRAINSTALLFILES
+	$(MKDIR) $(EXTRAINSTALLDIR)
+	$(INSTALL) $(EXTRAINSTALLFILES) $(EXTRAINSTALLDIR)
+endif
+
+#####################################################################
+# Zip
+#####################################################################
+
+.PHONY: fpc_zipinstall fpc_zipinstalladd
+
+# Temporary path to pack a file
+ifndef PACKDIR
+ifndef inlinux
+PACKDIR=pack_tmp
+else
+PACKDIR=/tmp/fpc-pack
+endif
+endif
+
+# Test dir if none specified
+ifndef PACKAGEDIR
+PACKAGEDIR=$(BASEDIR)
+endif
+
+# Add .zip/.tar.gz extension
+ifdef ZIPNAME
+ifndef inlinux
+override ZIPNAME:=$(ZIPNAME)$(ZIPEXT)
+endif
+endif
+
+# Default target which is call before zipping
+ifndef ZIPTARGET
+ZIPTARGET=install
+endif
+
+# Note: This will not remove the zipfile first
+fpc_zipinstalladd:
+ifndef ZIPNAME
+	@$(ECHO) Please specify ZIPNAME!
+	@exit
+else
+	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
+ifdef inlinux
+	gzip -d $(PACKAGEDIR)/$(ZIPNAME).tar.gz
+	cd $(PACKDIR) ; tar rv --file $(PACKAGEDIR)/$(ZIPNAME).tar * ; cd $(BASEDIR)
+	gzip $(PACKAGEDIR)/$(ZIPNAME).tar
+else
+	cd $(PACKDIR) ; $(ZIPPROG) $(PACKAGEDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
+endif
+	$(DELTREE) $(PACKDIR)
+endif
+
+# First remove the zip and then install
+fpc_zipinstall:
+ifndef ZIPNAME
+	@$(ECHO) Please specify ZIPNAME!
+	@exit
+else
+	$(DEL) $(PACKAGEDIR)/$(ZIPNAME)
+	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
+ifdef inlinux
+	cd $(PACKDIR) ; tar cvz --file $(PACKAGEDIR)/$(ZIPNAME).tar.gz * ; cd $(BASEDIR)
+else
+	cd $(PACKDIR) ; $(ZIPPROG) $(PACKAGEDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
+endif
+	$(DELTREE) $(PACKDIR)
+endif
+
+#####################################################################
+# Clean rules
+#####################################################################
+
+.PHONY: fpc_clean fpc_cleanall
+
+ifdef EXTRACLEANUNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRACLEANUNITS))
+endif
+
+ifdef CLEANPPUFILES
+ifdef PPUFILES
+CLEANPPULINKFILES=$(shell $(PPUFILES) $(CLEANPPUFILES))
+endif
+endif
+
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef EXTRACLEANFILES
+	-$(DEL) $(EXTRACLEANFILES)
+endif
+	-$(DEL) $(PPAS) link.res log
+
+fpc_cleanall:
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) $(PPAS) link.res log
+
+#####################################################################
+# Info rules
+#####################################################################
+
+.PHONY: fpc_info fpc_cfginfo fpc_objectinfo fpc_toolsinfo fpc_installinfo \
+	fpc_dirinfo
+
+fpc_info: $(FPCINFO)
+
+fpc_infocfg:
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC....... $(FPC)
+	@$(ECHO)  Version... $(FPC_VERSION)
+	@$(ECHO)  CPU....... $(CPU_TARGET)
+	@$(ECHO)  Source.... $(OS_SOURCE)
+	@$(ECHO)  Target.... $(OS_TARGET)
+	@$(ECHO)
+
+fpc_infoobjects:
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  LoaderObjects..... $(LOADEROBJECTS)
+	@$(ECHO)  UnitObjects....... $(UNITOBJECTS)
+	@$(ECHO)  ExeObjects........ $(EXEOBJECTS)
+	@$(ECHO)
+	@$(ECHO)  ExtraCleanUnits... $(EXTRACLEANUNITS)
+	@$(ECHO)  ExtraCleanFiles... $(EXTRACLEANFILES)
+	@$(ECHO)
+	@$(ECHO)  ExtraInstallUnits. $(EXTRAINSTALLUNITS)
+	@$(ECHO)  ExtraInstallFiles. $(EXTRAINSTALLFILES)
+	@$(ECHO)
+
+fpc_infoinstall:
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+ifdef DATE
+	@$(ECHO)  DateStr.............. $(DATESTR)
+endif
+	@$(ECHO)  PackageSuffix........ $(PACKAGESUFFIX)
+	@$(ECHO)
+	@$(ECHO)  BaseInstallDir....... $(BASEINSTALLDIR)
+	@$(ECHO)  BinInstallDir........ $(BININSTALLDIR)
+	@$(ECHO)  LibInstallDir........ $(LIBINSTALLDIR)
+	@$(ECHO)  UnitInstallDir....... $(UNITINSTALLDIR)
+	@$(ECHO)  SourceInstallDir..... $(SOURCEINSTALLDIR)
+	@$(ECHO)  DocInstallDir........ $(DOCINSTALLDIR)
+	@$(ECHO)  ExtraInstallDir...... $(EXTRAINSTALLDIR)
+	@$(ECHO)
+
+#####################################################################
+# Users rules
+#####################################################################
+
+pyacc$(EXEEXT): pyacc$(PASEXT) $(wildcard yacc*$(PASEXT))
+	$(COMPILER) pyacc$(PASEXT) $(REDIR)
+
+plex$(EXEEXT): plex$(PASEXT) $(wildcard lex*$(PASEXT))
+	$(COMPILER) plex$(PASEXT) $(REDIR)
+
+lexlib$(PPUEXT): lexlib$(PASEXT)
+
+yacclib$(PPUEXT): yacclib$(PASEXT)

utils/tply/Makefile.fpc

@@ -0,0 +1,41 @@
+#
+#   Makefile.fpc for Pascal lex/yacc
+#
+
+[targets]
+programs=plex pyacc
+units=lexlib yacclib
+
+[clean]
+units=lexbase lexopt lexdfa lexpos lexlist lexrules lexmsgs lextable \
+      yaccbase yaccmsgs yaccclos yaccpars yacclook yaccsem yacclr0 yacctabl
+
+[install]
+files=yylex.cod yyparse.cod
+
+[dirs]
+fpcdir=../..
+extrainstalldir=$(CODPATH)
+
+[defaults]
+defaultoptions=-Sg
+
+
+[presettings]
+ifdef inlinux
+CODPATH=/usr/lib/fpc/lexyacc
+else
+CODPATH=$(BININSTALLDIR)
+endif
+
+
+[rules]
+pyacc$(EXEEXT): pyacc$(PASEXT) $(wildcard yacc*$(PASEXT))
+        $(COMPILER) pyacc$(PASEXT) $(REDIR)
+
+plex$(EXEEXT): plex$(PASEXT) $(wildcard lex*$(PASEXT))
+        $(COMPILER) plex$(PASEXT) $(REDIR)
+
+lexlib$(PPUEXT): lexlib$(PASEXT)
+
+yacclib$(PPUEXT): yacclib$(PASEXT)

utils/tply/README

@@ -0,0 +1,203 @@
+
+About this Package
+===== ==== =======
+
+This is Version 4.1 of TPLY (Turbo Pascal Lex and Yacc), a compiler generator
+for Turbo Pascal and compatibles. The package contains two programs, TP Lex
+and Yacc, which are approximately compatible with the UNIX utilities Lex and
+Yacc, but are written in, and produce code for the Turbo Pascal programming
+language. The present version works with all recent flavours of Turbo/Borland
+Pascal, including Delphi, and with the Free Pascal Compiler, a GPL'ed Turbo
+Pascal-compatible compiler which currently runs on DOS and Linux (other ports
+are under development). Recent information about TPLY and the sources are
+available from the TPLY homepage:
+
+	http://www.musikwissenschaft.uni-mainz.de/~ag/tply
+
+For information about the Free Pascal Compiler, please refer to:
+
+	http://tfdec1.fys.kuleuven.ac.be/~michael/fpc/fpc.html
+
+The manual can be found in the files tply.tex (TeX version) and tply.doc
+(ASCII version) contained in the package. An extended version of the manual
+has also been published in the CCAI journal (A. Graef, TP Lex and Yacc: A
+compiler generator toolset for Turbo Pascal, Journal of Communication and
+Cognition - Artificial Intelligence (CCAI), 12(4), 1995, pp. 383-424).
+Furthermore, there is one book I know of which devotes three chapters to TP
+Lex/Yacc; unfortunately, it is written in French ;-) (Nino Silverio, Realiser
+un compilateur: Les outil Lex et Yacc, Editions Eyrolles, France, 1994, ISBN
+2-212-08834-5).
+
+
+License
+=======
+
+Since version 4.0, TPLY and its derivatives are distributed under the GNU
+General Public License (Version 2 or later); see the file COPYING for details.
+
+
+Authors
+=======
+
+The original version of the TPLY package was written by Albert Graef
+<[email protected], [email protected]> for Turbo Pascal
+4.0-6.0. Berend de Boer <[email protected]>, the current maintainer of the
+Turbo/Borland Pascal version, adapted TPLY to take advantage of the large
+memory models in Borland Pascal 7.0 and Delphi. Michael Van Canneyt
+<[email protected]>, who maintains the Linux version of
+the Free Pascal compiler, is the author of the Free Pascal port.
+
+
+History
+=======
+
+*** Version 2.0		Albert Graef <[email protected]>
+
+Around 1990. First public release.
+
+*** Version 3.0		Albert Graef <[email protected]>
+
+1991. Lots of changes to make TPLY more compatible to UNIX Lex/Yacc. Moreover,
+all DFA and LALR parser construction algorithms were reimplemented from
+scratch in order to improve efficiency.
+
+*** Version 3.0a	Albert Graef <[email protected]>
+
+May 1992. Bug fix release.
+
+*** Version 4.0		Berend de Boer <[email protected]>
+
+Oct 1996. This version differs with the previous release, 3.0a, that it
+compiles under Dos, DPMI, Windows, Delphi 16 and Delphi 32. The source is now
+maintained by Berend de Boer <[email protected]>.
+
+For the protected mode or win32 platforms Lex and Yacc also have significantly
+lager tables. The win32 in fact can have unlimited tables because you have 2GB
+to store things :-) The 16-bit DPMI platforms have tables extended as large as
+possible without changing basic Lex or Yacc sources.
+
+This version was ported to Free Pascal by Michael Van Canneyt
+<[email protected]> (April 1998).
+
+*** Version 4.1		Michael Van Canneyt
+			<[email protected]>
+			Albert Graef <[email protected]>
+
+May 1998. Merges the Turbo and Free Pascal versions into a single package.
+
+
+Contents of the Package
+======== == === =======
+
+The TP Lex and Yacc programs consist of 23 modules with about 11000 lines of
+code. A short description of each of the source modules is given below.
+
+LEX      PAS		TP Lex main program
+LEXBASE  PAS		base module (global declarations)
+LEXDFA   PAS		DFA construction algorithm
+LEXLIB   PAS		TP Lex library unit
+LEXLIST  PAS		listing operations
+LEXMSGS  PAS		messages and error handling
+LEXOPT   PAS		DFA optimization algorithm
+LEXPOS   PAS		operations to construct the position table
+LEXRULES PAS		parser for TP Lex grammar rules
+LEXTABLE PAS		internal tables used by the TP Lex program
+
+YACC     PAS		TP Yacc parser and main program
+YACC     Y		TP Yacc source for YACC.PAS
+YACCBASE PAS		base module (global declarations)
+YACCCLOS PAS		closure and first set construction algorithms
+YACCLIB  PAS		TP Yacc library unit
+YACCLOOK PAS		LALR lookahead computation algorithm
+YACCLR0  PAS		LR(0) set construction algorithm
+YACCMSGS PAS		messages and error handling
+YACCPARS PAS		parse table construction
+YACCSEM  PAS		semantic routines of the TP Yacc parser
+YACCTABL PAS		internal tables used by the TP Yacc program
+
+YYLEX    COD		code template for the lexical analyzer routine
+YYPARSE  COD		code template for the LALR parser routine
+
+Besides this, the package also contains the following docs:
+
+COPYING			GNU General Public License
+README      		this file
+TPLY     DOC		ASCII version of the manual
+TPLY     TEX		TeX version of the manual
+
+Furthermore, the EXAMPLE subdir contains various sample TP Lex and Yacc
+programs, such as a (Standard) Pascal parser and a complete TPLY cross
+referencing utility named `yref'. (NB: Many of these examples still do not
+work properly with Free Pascal, apparently due to some incompatibilities in
+the Free Pascal runtime library concerning the handling of standard
+input/output. Programs operating on "real" files seem to be unaffected. I hope
+that this will be fixed in a future release of the Free Pascal RTL.)
+
+
+Installation
+============
+
+The items to be installed are the executables of TP Lex and Yacc (compiled
+from the lex.pas and yacc.pas programs), the Lex and Yacc code templates
+(*.cod files), and the LexLib and YaccLib library units (compiled from
+lexlib.pas and yacclib.pas).
+
+For the Free Pascal/Linux version, a Makefile is provided. To install, issue
+the command `make' (maybe you have to edit the Makefile before this to reflect
+your setup) and then `make install'. Note that in the Linux version the
+executables will be named `plex' and `pyacc' to avoid name clashes with the
+corresponding UNIX utilities.
+
+For the Turbo/Borland/Free Pascal versions under DOS and Windows, several DOS
+batch files are provided:
+
+	MAKEDOS.BAT  - makes a real mode executable. Compiles with
+	               Turbo Pascal 6.0 to Borland Pascal 7.0.
+	MAKEDPMI.BAT - makes a dos protected mode executable. Needs
+	               Borland Pascal 7.0.
+	MAKEBPW.BAT  - makes a 16-bit Windows executable. Needs 
+	               Borland Pascal 7.0 or Borland Pascal for Windows.
+	MAKED16.BAT  - makes a 16-bit Windows executable. 
+	               Needs Delphi 1.X.
+	MAKED32.BAT  - makes a 32-bit Windows NT or Windows 95 console
+	               application. Needs Delphi 2.X.
+	MAKEFPC.BAT  - makes a 32 bit executable. Needs the Free Pascal
+	               compiler.
+
+These will compile the programs lex.pas and yacc.pas, as well as the units
+lexlib.pas and yacclib.pas. To install, copy the executables lex.exe and
+yacc.exe along with the code templates yylex.cod and yyparse.cod to a place
+somewhere on your DOS path. Furthermore, copy the compiled lexlib and yacclib
+units to a directory which is searched for unit files by your compiler.
+
+(NB1: I currently have no means to check whether these batch files work except
+for the makedos and makefpc files. If you have problems with any of the other
+files, please let me know.)
+
+(NB2: The type of compiler used to compile TP Lex and Yacc affects the sizes
+of internal tables of these programs. If you want to be able to compile large
+grammars, you should therefore compile TP Lex/Yacc using one of the 32 bit
+compilers like BP 7.0 or Free Pascal. Note that the Pascal output generated by
+TP Lex and Yacc is independent of the type of compiler with which the programs
+were compiled. Thus the generated code can be used with any of the supported
+compilers, regardless of the type of compiler used to compile the TP Lex and
+Yacc programs themselves. You only have to compile the LexLib and YaccLib
+units separately for each type of compiler which will be used to compile TP
+Lex/Yacc generated programs.)
+
+To complete the installation, you might also wish to install the contents of
+the example subdir in a directory of your choice.
+
+As soon as the installation is finished, you can perform a quick bootstrap
+test with the command `yacc yacc.y test.pas' (or `pyacc yacc.y test.pas' for
+the Free Pascal/Linux version). You can then compare the distributed
+`yacc.pas' against the generated `test.pas' with the DOS command `fc' or the
+UNIX `diff' command. The two files should not differ.
+
+That's it! Hope you enjoy using this package.
+
+----
+Dr. Albert Gr"af
+Dept. of Musicinformatics, Johannes Gutenberg-University Mainz, Germany
+Email:  [email protected], [email protected]
+WWW:    http://www.musikwissenschaft.uni-mainz.de/~ag

utils/tply/lexbase.pas

@@ -0,0 +1,1167 @@
+{
+  This module collects the basic data types and operations used in the TP
+  Lex program, and other basic stuff that does not belong anywhere else:
+  - Lex input and output files and corresponding bookkeeping information
+    used by the parser
+  - symbolic character constants
+  - dynamically allocated strings and character classes
+  - integer sets
+  - generic quicksort and hash table routines
+  - utilities for list-generating
+  - other tiny utilities
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-08-01 10:21 $
+
+$History: LEXBASE.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+}
+
+
+unit LexBase;
+
+interface
+
+
+const
+
+(* symbolic character constants: *)
+
+bs   = #8;      (* backspace character *)
+tab  = #9;      (* tab character *)
+nl   = #10;     (* newline character *)
+cr   = #13;     (* carriage return *)
+ff   = #12;     (* form feed character *)
+
+var
+
+(* Filenames: *)
+
+lfilename     : String;
+pasfilename   : String;
+lstfilename   : String;
+codfilename   : String;
+codfilepath   : String; { Under linux, binary and conf file
+                          are not in the same path}
+
+(* Lex input, output, list and code template file: *)
+
+yyin, yylst, yyout, yycod : Text;
+
+(* the following values are initialized and updated by the parser: *)
+
+line : String;  (* current input line *)
+lno  : Integer; (* current line number *)
+
+const
+
+max_elems  = 100;  (* maximum size of integer sets *)
+
+type
+
+(* String and character class pointers: *)
+
+StrPtr    = ^String;
+CClass    = set of Char;
+CClassPtr = ^CClass;
+
+(* Sorted integer sets: *)
+
+IntSet    = array [0..max_elems] of Integer;
+              (* word 0 is size *)
+IntSetPtr = ^IntSet;
+
+(* Regular expressions: *)
+
+RegExpr = ^Node;
+
+NodeType = (mark_node,    (* marker node *)
+            char_node,    (* character node *)
+            str_node,     (* string node *)
+            cclass_node,  (* character class node *)
+            star_node,    (* star node *)
+            plus_node,    (* plus node *)
+            opt_node,     (* option node *)
+            cat_node,     (* concatenation node *)
+            alt_node);    (* alternatives node (|) *)
+
+Node = record case node_type : NodeType of
+         mark_node : (rule, pos : Integer);
+         char_node : (c : Char);
+         str_node : (str : StrPtr);
+         cclass_node : (cc : CClassPtr);
+         star_node, plus_node, opt_node : (r : RegExpr);
+         cat_node, alt_node : (r1, r2 : RegExpr);
+       end;
+
+(* Some standard character classes: *)
+
+const
+
+letters   : CClass = ['A'..'Z','a'..'z','_'];
+digits    : CClass = ['0'..'9'];
+alphanums : CClass = ['A'..'Z','a'..'z','_','0'..'9'];
+
+(* Operations: *)
+
+(* Strings and character classes: *)
+
+function newStr(str : String) : StrPtr;
+  (* creates a string pointer (only the space actually needed for the given
+     string is allocated) *)
+function newCClass(cc : CClass) : CClassPtr;
+  (* creates a CClass pointer *)
+
+(* Integer sets (set arguments are passed by reference even if they are not
+   modified, for greater efficiency): *)
+
+procedure empty(var M : IntSet);
+  (* initializes M as empty *)
+procedure singleton(var M : IntSet; i : Integer);
+  (* initializes M as a singleton set containing the element i *)
+procedure include(var M : IntSet; i : Integer);
+  (* include i in M *)
+procedure exclude(var M : IntSet; i : Integer);
+  (* exclude i from M *)
+procedure setunion(var M, N : IntSet);
+  (* adds N to M *)
+procedure setminus(var M, N : IntSet);
+  (* removes N from M *)
+procedure intersect(var M, N : IntSet);
+  (* removes from M all elements NOT in N *)
+function size(var M : IntSet) : Integer;
+  (* cardinality of set M *)
+function member(i : Integer; var M : IntSet) : Boolean;
+  (* tests for membership of i in M *)
+function isempty(var M : IntSet) : Boolean;
+  (* checks whether M is an empty set *)
+function equal(var M, N : IntSet) : Boolean;
+  (* checks whether M and N are equal *)
+function subseteq(var M, N : IntSet) : Boolean;
+  (* checks whether M is a subset of N *)
+function newIntSet : IntSetPtr;
+  (* creates a pointer to an empty integer set *)
+
+(* Constructors for regular expressions: *)
+
+const epsExpr : RegExpr = nil;
+  (* empty regular expression *)
+function markExpr(rule, pos : Integer) : RegExpr;
+  (* markers are used to denote endmarkers of rules, as well as other
+     special positions in rules, e.g. the position of the lookahead
+     operator; they are considered nullable; by convention, we use
+     the following pos numbers:
+     - 0: endmarker position
+     - 1: lookahead operator position *)
+function charExpr(c : Char) : RegExpr;
+  (* character c *)
+function strExpr(str : StrPtr) : RegExpr;
+  (* "str" *)
+function cclassExpr(cc : CClassPtr) : RegExpr;
+  (* [str] where str are the literals in cc *)
+function starExpr(r : RegExpr) : RegExpr;
+  (* r* *)
+function plusExpr(r : RegExpr) : RegExpr;
+  (* r+ *)
+function optExpr(r : RegExpr) : RegExpr;
+  (* r? *)
+function mnExpr(r : RegExpr; m, n : Integer) : RegExpr;
+  (* constructor expanding expression r{m,n} to the corresponding
+     alt expression r^m|...|r^n *)
+function catExpr(r1, r2 : RegExpr) : RegExpr;
+  (* r1r2 *)
+function altExpr(r1, r2 : RegExpr) : RegExpr;
+  (* r1|r2 *)
+
+(* Unifiers for regular expressions:
+   The following predicates check whether the specified regular
+   expression r is of the denoted type; if the predicate succeeds,
+   the other arguments of the predicate are instantiated to the
+   corresponding values. *)
+
+function is_epsExpr(r : RegExpr) : Boolean;
+  (* empty regular expression *)
+function is_markExpr(r : RegExpr; var rule, pos : Integer) : Boolean;
+  (* marker expression *)
+function is_charExpr(r : RegExpr; var c : Char) : Boolean;
+  (* character c *)
+function is_strExpr(r : RegExpr; var str : StrPtr) : Boolean;
+  (* "str" *)
+function is_cclassExpr(r : RegExpr; var cc : CClassPtr) : Boolean;
+  (* [str] where str are the literals in cc *)
+function is_starExpr(r : RegExpr; var r1 : RegExpr) : Boolean;
+  (* r1* *)
+function is_plusExpr(r : RegExpr; var r1 : RegExpr) : Boolean;
+  (* r1+ *)
+function is_optExpr(r : RegExpr; var r1 : RegExpr) : Boolean;
+  (* r1? *)
+function is_catExpr(r : RegExpr; var r1, r2 : RegExpr) : Boolean;
+  (* r1r2 *)
+function is_altExpr(r : RegExpr; var r1, r2 : RegExpr) : Boolean;
+  (* r1|r2 *)
+
+(* Quicksort: *)
+
+type
+
+OrderPredicate = function (i, j : Integer) : Boolean;
+SwapProc = procedure (i, j : Integer);
+
+procedure quicksort(lo, hi: Integer;
+                    less : OrderPredicate;
+                    swap : SwapProc);
+  (* General inplace sorting procedure based on the quicksort algorithm.
+     This procedure can be applied to any sequential data structure;
+     only the corresponding routines less which compares, and swap which
+     swaps two elements i,j of the target data structure, must be
+     supplied as appropriate for the target data structure.
+     - lo, hi: the lower and higher indices, indicating the elements to
+       be sorted
+     - less(i, j): should return true if element no. i `is less than'
+       element no. j, and false otherwise; any total quasi-ordering may
+       be supplied here (if neither less(i, j) nor less(j, i) then elements
+       i and j are assumed to be `equal').
+     - swap(i, j): should swap the elements with index i and j *)
+
+(* Generic hash table routines (based on quadratic rehashing; hence the
+   table size must be a prime number): *)
+
+type
+
+TableLookupProc = function(k : Integer) : String;
+TableEntryProc  = procedure(k : Integer; symbol : String);
+
+function key(symbol : String;
+             table_size : Integer;
+             lookup : TableLookupProc;
+             entry  : TableEntryProc) : Integer;
+  (* returns a hash table key for symbol; inserts the symbol into the
+     table if necessary
+     - table_size is the symbol table size and must be a fixed prime number
+     - lookup is the table lookup procedure which should return the string
+       at key k in the table ('' if entry is empty)
+     - entry is the table entry procedure which is assumed to store the
+       given symbol at the given location *)
+
+function definedKey(symbol : String;
+                    table_size : Integer;
+                    lookup : TableLookupProc) : Boolean;
+  (* checks the table to see if symbol is in the table *)
+
+(* Utility routines: *)
+
+function min(i, j : Integer) : Integer;
+function max(i, j : Integer) : Integer;
+  (* minimum and maximum of two integers *)
+function nchars(cc : CClass) : Integer;
+  (* returns the cardinality (number of characters) of a character class *)
+function upper(str : String) : String;
+  (* returns str converted to uppercase *)
+function strip(str : String) : String;
+  (* returns str with leading and trailing blanks stripped off *)
+function blankStr(str : String) : String;
+  (* returns string of same length as str, with all non-whitespace characters
+     replaced by blanks *)
+function intStr(i : Integer) : String;
+  (* returns the string representation of i *)
+function isInt(str : String; var i : Integer) : Boolean;
+  (* checks whether str represents an integer; if so, returns the
+     value of it in i *)
+function path(filename : String) : String;
+  (* returns the path in filename *)
+function root(filename : String) : String;
+  (* returns root (i.e. extension stripped from filename) of
+     filename *)
+function addExt(filename, ext : String) : String;
+  (* if filename has no extension and last filename character is not '.',
+     add extension ext to filename *)
+function file_size(filename : String) : LongInt;
+  (* determines file size in bytes *)
+
+(* Utility functions for list generating routines: *)
+
+function charStr(c : char; reserved : CClass) : String;
+  (* returns a print name for character c, using the standard escape
+     conventions; reserved is the class of `reserved' special characters
+     which should be quoted with \ (\ itself is always quoted) *)
+function singleQuoteStr(str : String) : String;
+  (* returns print name of str enclosed in single quotes, using the
+     standard escape conventions *)
+function doubleQuoteStr(str : String) : String;
+  (* returns print name of str enclosed in double quotes, using the
+     standard escape conventions *)
+function cclassStr(cc : CClass) : String;
+  (* returns print name of character class cc, using the standard escape
+     conventions; if cc contains more than 128 elements, the complement
+     notation (^) is used; if cc is the class of all (non-null) characters
+     except newline, the period notation is used *)
+function cclassOrCharStr(cc : CClass) : String;
+  (* returns a print name for character class cc (either cclassStr, or,
+     if cc contains only one element, character in single quotes) *)
+function regExprStr(r : RegExpr) : String;
+  (* unparses a regular expression *)
+
+implementation
+
+uses LexMsgs;
+
+(* String and character class pointers: *)
+
+function newStr(str : String) : StrPtr;
+  var strp : StrPtr;
+  begin
+    getmem(strp, succ(length(str)));
+    move(str, strp^, succ(length(str)));
+    newStr := strp;
+  end(*newStr*);
+
+function newCClass(cc : CClass) : CClassPtr;
+  var ccp : CClassPtr;
+  begin
+    new(ccp);
+    ccp^ := cc;
+    newCClass := ccp;
+  end(*newCClass*);
+
+(* Integer sets: *)
+
+procedure empty(var M : IntSet);
+  begin
+    M[0] := 0;
+  end(*empty*);
+
+procedure singleton(var M : IntSet; i : Integer);
+  begin
+    M[0] := 1; M[1] := i;
+  end(*singleton*);
+
+procedure include(var M : IntSet; i : Integer);
+  var l, r, k : Integer;
+  begin
+    (* binary search: *)
+    l := 1; r := M[0];
+    k := l + (r-l) div 2;
+    while (l<r) and (M[k]<>i) do
+      begin
+        if M[k]<i then
+          l := succ(k)
+        else
+          r := pred(k);
+        k := l + (r-l) div 2;
+      end;
+    if (k>M[0]) or (M[k]<>i) then
+      begin
+        if M[0]>=max_elems then fatal(intset_overflow);
+        if (k<=M[0]) and (M[k]<i) then
+          begin
+            move(M[k+1], M[k+2], (M[0]-k)*sizeOf(Integer));
+            M[k+1] := i;
+          end
+        else
+          begin
+            move(M[k], M[k+1], (M[0]-k+1)*sizeOf(Integer));
+            M[k] := i;
+          end;
+        inc(M[0]);
+      end;
+  end(*include*);
+
+procedure exclude(var M : IntSet; i : Integer);
+  var l, r, k : Integer;
+  begin
+    (* binary search: *)
+    l := 1; r := M[0];
+    k := l + (r-l) div 2;
+    while (l<r) and (M[k]<>i) do
+      begin
+        if M[k]<i then
+          l := succ(k)
+        else
+          r := pred(k);
+        k := l + (r-l) div 2;
+      end;
+    if (k<=M[0]) and (M[k]=i) then
+      begin
+        move(M[k+1], M[k], (M[0]-k)*sizeOf(Integer));
+        dec(M[0]);
+      end;
+  end(*exclude*);
+
+procedure setunion(var M, N : IntSet);
+  var
+    K : IntSet;
+    i, j, i_M, i_N : Integer;
+  begin
+    (* merge sort: *)
+    i := 0; i_M := 1; i_N := 1;
+    while (i_M<=M[0]) and (i_N<=N[0]) do
+      begin
+        inc(i);
+        if i>max_elems then fatal(intset_overflow);
+        if M[i_M]<N[i_N] then
+          begin
+            K[i] := M[i_M]; inc(i_M);
+          end
+        else if N[i_N]<M[i_M] then
+          begin
+            K[i] := N[i_N]; inc(i_N);
+          end
+        else
+          begin
+            K[i] := M[i_M]; inc(i_M); inc(i_N);
+          end
+      end;
+    for j := i_M to M[0] do
+      begin
+        inc(i);
+        if i>max_elems then fatal(intset_overflow);
+        K[i] := M[j];
+      end;
+    for j := i_N to N[0] do
+      begin
+        inc(i);
+        if i>max_elems then fatal(intset_overflow);
+        K[i] := N[j];
+      end;
+    K[0] := i;
+    move(K, M, succ(i)*sizeOf(Integer));
+  end(*setunion*);
+
+procedure setminus(var M, N : IntSet);
+  var
+    K : IntSet;
+    i, i_M, i_N : Integer;
+  begin
+    i := 0; i_N := 1;
+    for i_M := 1 to M[0] do
+      begin
+        while (i_N<=N[0]) and (N[i_N]<M[i_M]) do inc(i_N);
+        if (i_N>N[0]) or (N[i_N]>M[i_M]) then
+          begin
+            inc(i);
+            K[i] := M[i_M];
+          end
+        else
+          inc(i_N);
+      end;
+    K[0] := i;
+    move(K, M, succ(i)*sizeOf(Integer));
+  end(*setminus*);
+
+procedure intersect(var M, N : IntSet);
+  var
+    K : IntSet;
+    i, i_M, i_N : Integer;
+  begin
+    i := 0; i_N := 1;
+    for i_M := 1 to M[0] do
+      begin
+        while (i_N<=N[0]) and (N[i_N]<M[i_M]) do inc(i_N);
+        if (i_N<=N[0]) and (N[i_N]=M[i_M]) then
+          begin
+            inc(i);
+            K[i] := M[i_M];
+            inc(i_N);
+          end
+      end;
+    K[0] := i;
+    move(K, M, succ(i)*sizeOf(Integer));
+  end(*intersect*);
+
+function size(var M : IntSet) : Integer;
+  begin
+    size := M[0]
+  end(*size*);
+
+function member(i : Integer; var M : IntSet) : Boolean;
+  var l, r, k : Integer;
+  begin
+    (* binary search: *)
+    l := 1; r := M[0];
+    k := l + (r-l) div 2;
+    while (l<r) and (M[k]<>i) do
+      begin
+        if M[k]<i then
+          l := succ(k)
+        else
+          r := pred(k);
+        k := l + (r-l) div 2;
+      end;
+    member := (k<=M[0]) and (M[k]=i);
+  end(*member*);
+
+function isempty(var M : IntSet) : Boolean;
+  begin
+    isempty := M[0]=0
+  end(*isempty*);
+
+function equal(var M, N : IntSet) : Boolean;
+  var i : Integer;
+  begin
+    if M[0]<>N[0] then
+      equal := false
+    else
+      begin
+        for i := 1 to M[0] do
+          if M[i]<>N[i] then
+            begin
+              equal := false;
+              exit
+            end;
+        equal := true
+      end
+  end(*equal*);
+
+function subseteq(var M, N : IntSet) : Boolean;
+  var
+    i_M, i_N : Integer;
+  begin
+    if M[0]>N[0] then
+      subseteq := false
+    else
+      begin
+        i_N := 1;
+        for i_M := 1 to M[0] do
+          begin
+            while (i_N<=N[0]) and (N[i_N]<M[i_M]) do inc(i_N);
+            if (i_N>N[0]) or (N[i_N]>M[i_M]) then
+              begin
+                subseteq := false;
+                exit
+              end
+            else
+              inc(i_N);
+          end;
+        subseteq := true
+      end;
+  end(*subseteq*);
+
+function newIntSet : IntSetPtr;
+  var
+    MP : IntSetPtr;
+  begin
+    getmem(MP, (max_elems+1)*sizeOf(Integer));
+    MP^[0] := 0;
+    newIntSet := MP
+  end(*newIntSet*);
+
+(* Constructors for regular expressions: *)
+
+function newExpr(node_type : NodeType; n : Integer) : RegExpr;
+  (* returns new RegExpr node (n: number of bytes to allocate) *)
+  var x : RegExpr;
+  begin
+    getmem(x, sizeOf(NodeType)+n);
+    x^.node_type := node_type;
+    newExpr := x
+  end(*newExpr*);
+function markExpr(rule, pos : Integer) : RegExpr;
+  var x : RegExpr;
+  begin
+    x := newExpr(mark_node, 2*sizeOf(Integer));
+    x^.rule := rule;
+    x^.pos  := pos;
+    markExpr := x
+  end(*markExpr*);
+function charExpr(c : Char) : RegExpr;
+  var x : RegExpr;
+  begin
+    x := newExpr(char_node, sizeOf(Char));
+    x^.c := c;
+    charExpr := x
+  end(*charExpr*);
+function strExpr(str : StrPtr) : RegExpr;
+  var x : RegExpr;
+  begin
+    x := newExpr(str_node, sizeOf(StrPtr));
+    x^.str := str;
+    strExpr := x
+  end(*strExpr*);
+function cclassExpr(cc : CClassPtr) : RegExpr;
+  var x : RegExpr;
+  begin
+    x := newExpr(cclass_node, sizeOf(CClassPtr));
+    x^.cc := cc;
+    cclassExpr := x
+  end(*cclassExpr*);
+function starExpr(r : RegExpr) : RegExpr;
+  var x : RegExpr;
+  begin
+    x := newExpr(star_node, sizeOf(RegExpr));
+    x^.r := r;
+    starExpr := x
+  end(*starExpr*);
+function plusExpr(r : RegExpr) : RegExpr;
+  var x : RegExpr;
+  begin
+    x := newExpr(plus_node, sizeOf(RegExpr));
+    x^.r := r;
+    plusExpr := x
+  end(*plusExpr*);
+function optExpr(r : RegExpr) : RegExpr;
+  var x : RegExpr;
+  begin
+    x := newExpr(opt_node, sizeOf(RegExpr));
+    x^.r := r;
+    optExpr := x
+  end(*optExpr*);
+function mnExpr(r : RegExpr; m, n : Integer) : RegExpr;
+  var
+    ri, rmn : RegExpr;
+    i : Integer;
+  begin
+    if (m>n) or (n=0) then
+      mnExpr := epsExpr
+    else
+      begin
+        (* construct r^m: *)
+        if m=0 then
+          ri := epsExpr
+        else
+          begin
+            ri := r;
+            for i := 2 to m do
+              ri := catExpr(ri, r);
+          end;
+        (* construct r{m,n}: *)
+        rmn := ri;                  (* r{m,n} := r^m *)
+        for i := m+1 to n do
+          begin
+            if is_epsExpr(ri) then
+              ri := r
+            else
+              ri := catExpr(ri, r);
+            rmn := altExpr(rmn, ri)  (* r{m,n} := r{m,n} | r^i,
+                                        i=m+1,...,n *)
+          end;
+        mnExpr := rmn
+      end
+  end(*mnExpr*);
+function catExpr(r1, r2 : RegExpr) : RegExpr;
+  var x : RegExpr;
+  begin
+    x := newExpr(cat_node, 2*sizeOf(RegExpr));
+    x^.r1 := r1;
+    x^.r2 := r2;
+    catExpr := x
+  end(*catExpr*);
+function altExpr(r1, r2 : RegExpr) : RegExpr;
+  var x : RegExpr;
+  begin
+    x := newExpr(alt_node, 2*sizeOf(RegExpr));
+    x^.r1 := r1;
+    x^.r2 := r2;
+    altExpr := x
+  end(*altExpr*);
+
+(* Unifiers for regular expressions: *)
+
+function is_epsExpr(r : RegExpr) : Boolean;
+  begin
+    is_epsExpr := r=epsExpr
+  end(*is_epsExpr*);
+function is_markExpr(r : RegExpr; var rule, pos : Integer) : Boolean;
+  begin
+    if r=epsExpr then
+      is_markExpr := false
+    else if r^.node_type=mark_node then
+      begin
+        is_markExpr := true;
+        rule := r^.rule;
+        pos  := r^.pos;
+      end
+    else
+      is_markExpr := false
+  end(*is_markExpr*);
+function is_charExpr(r : RegExpr; var c : Char) : Boolean;
+  begin
+    if r=epsExpr then
+      is_charExpr := false
+    else if r^.node_type=char_node then
+      begin
+        is_charExpr := true;
+        c := r^.c
+      end
+    else
+      is_charExpr := false
+  end(*is_charExpr*);
+function is_strExpr(r : RegExpr; var str : StrPtr) : Boolean;
+  begin
+    if r=epsExpr then
+      is_strExpr := false
+    else if r^.node_type=str_node then
+      begin
+        is_strExpr := true;
+        str := r^.str;
+      end
+    else
+      is_strExpr := false
+  end(*is_strExpr*);
+function is_cclassExpr(r : RegExpr; var cc : CClassPtr) : Boolean;
+  begin
+    if r=epsExpr then
+      is_cclassExpr := false
+    else if r^.node_type=cclass_node then
+      begin
+        is_cclassExpr := true;
+        cc := r^.cc
+      end
+    else
+      is_cclassExpr := false
+  end(*is_cclassExpr*);
+function is_starExpr(r : RegExpr; var r1 : RegExpr) : Boolean;
+  begin
+    if r=epsExpr then
+      is_starExpr := false
+    else if r^.node_type=star_node then
+      begin
+        is_starExpr := true;
+        r1 := r^.r
+      end
+    else
+      is_starExpr := false
+  end(*is_starExpr*);
+function is_plusExpr(r : RegExpr; var r1 : RegExpr) : Boolean;
+  begin
+    if r=epsExpr then
+      is_plusExpr := false
+    else if r^.node_type=plus_node then
+      begin
+        is_plusExpr := true;
+        r1 := r^.r
+      end
+    else
+      is_plusExpr := false
+  end(*is_plusExpr*);
+function is_optExpr(r : RegExpr; var r1 : RegExpr) : Boolean;
+  begin
+    if r=epsExpr then
+      is_optExpr := false
+    else if r^.node_type=opt_node then
+      begin
+        is_optExpr := true;
+        r1 := r^.r
+      end
+    else
+      is_optExpr := false
+  end(*is_optExpr*);
+function is_catExpr(r : RegExpr; var r1, r2 : RegExpr) : Boolean;
+  begin
+    if r=epsExpr then
+      is_catExpr := false
+    else if r^.node_type=cat_node then
+      begin
+        is_catExpr := true;
+        r1 := r^.r1;
+        r2 := r^.r2
+      end
+    else
+      is_catExpr := false
+  end(*is_catExpr*);
+function is_altExpr(r : RegExpr; var r1, r2 : RegExpr) : Boolean;
+  begin
+    if r=epsExpr then
+      is_altExpr := false
+    else if r^.node_type=alt_node then
+      begin
+        is_altExpr := true;
+        r1 := r^.r1;
+        r2 := r^.r2
+      end
+    else
+      is_altExpr := false
+  end(*is_altExpr*);
+
+(* Quicksort: *)
+
+procedure quicksort(lo, hi: Integer;
+                    less : OrderPredicate;
+                    swap : SwapProc);
+  (* derived from the quicksort routine in QSORT.PAS in the Turbo Pascal
+     distribution *)
+  procedure sort(l, r: Integer);
+    var i, j, k : Integer;
+    begin
+      i := l; j := r; k := (l+r) DIV 2;
+      repeat
+        while less(i, k) do inc(i);
+        while less(k, j) do dec(j);
+        if i<=j then
+          begin
+            swap(i, j);
+            if k=i then k := j (* pivot element swapped! *)
+            else if k=j then k := i;
+            inc(i); dec(j);
+          end;
+      until i>j;
+      if l<j then sort(l,j);
+      if i<r then sort(i,r);
+    end(*sort*);
+  begin
+    if lo<hi then sort(lo,hi);
+  end(*quicksort*);
+
+(* Generic hash table routines: *)
+
+function hash(str : String; table_size : Integer) : Integer;
+  (* computes a hash key for str *)
+  var i, key : Integer;
+  begin
+    key := 0;
+    for i := 1 to length(str) do
+      inc(key, ord(str[i]));
+    hash := key mod table_size + 1;
+  end(*hash*);
+
+procedure newPos(var pos, incr, count : Integer; table_size : Integer);
+  (* computes a new position in the table (quadratic collision strategy)
+     - pos: current position (+inc)
+     - incr: current increment (+2)
+     - count: current number of collisions (+1)
+     quadratic collision formula for position of str after n collisions:
+       pos(str, n) = (hash(str)+n^2) mod table_size +1
+     note that n^2-(n-1)^2 = 2n-1 <=> n^2 = (n-1)^2 + (2n-1) for n>0,
+     i.e. the increment inc=2n-1 increments by two in each collision *)
+  begin
+    inc(count);
+    inc(pos, incr);
+    if pos>table_size then pos := pos mod table_size + 1;
+    inc(incr, 2)
+  end(*newPos*);
+
+function key(symbol : String;
+             table_size : Integer;
+             lookup : TableLookupProc;
+             entry  : TableEntryProc) : Integer;
+  var pos, incr, count : Integer;
+  begin
+    pos := hash(symbol, table_size);
+    incr := 1;
+    count := 0;
+    while count<=table_size do
+      if lookup(pos)='' then
+        begin
+          entry(pos, symbol);
+          key := pos;
+          exit
+        end
+      else if lookup(pos)=symbol then
+        begin
+          key := pos;
+          exit
+        end
+      else
+        newPos(pos, incr, count, table_size);
+    fatal(sym_table_overflow)
+  end(*key*);
+
+function definedKey(symbol : String;
+                    table_size : Integer;
+                    lookup : TableLookupProc) : Boolean;
+  var pos, incr, count : Integer;
+  begin
+    pos := hash(symbol, table_size);
+    incr := 1;
+    count := 0;
+    while count<=table_size do
+      if lookup(pos)='' then
+        begin
+          definedKey := false;
+          exit
+        end
+      else if lookup(pos)=symbol then
+        begin
+          definedKey := true;
+          exit
+        end
+      else
+        newPos(pos, incr, count, table_size);
+    definedKey := false
+  end(*definedKey*);
+
+(* Utility routines: *)
+
+function min(i, j : Integer) : Integer;
+  begin
+    if i<j then
+      min := i
+    else
+      min := j
+  end(*min*);
+function max(i, j : Integer) : Integer;
+  begin
+    if i>j then
+      max := i
+    else
+      max := j
+  end(*max*);
+function nchars(cc : CClass) : Integer;
+  var
+    c : Char;
+    count : Integer;
+  begin
+    count := 0;
+    for c := #0 to #255 do if c in cc then inc(count);
+    nchars := count;
+  end(*nchars*);
+function upper(str : String) : String;
+  var i : Integer;
+  begin
+    for i := 1 to length(str) do
+      str[i] := upCase(str[i]);
+    upper := str
+  end(*upper*);
+function strip(str : String) : String;
+  begin
+    while (length(str)>0) and ((str[1]=' ') or (str[1]=tab)) do
+      delete(str, 1, 1);
+    while (length(str)>0) and
+          ((str[length(str)]= ' ') or
+           (str[length(str)]=tab)) do
+      delete(str, length(str), 1);
+    strip := str;
+  end(*strip*);
+function blankStr(str : String) : String;
+  var i : Integer;
+  begin
+    for i := 1 to length(str) do
+      if str[i]<>tab then str[i] := ' ';
+    blankStr := str;
+  end(*blankStr*);
+function intStr(i : Integer) : String;
+  var s : String;
+  begin
+    str(i, s);
+    intStr := s
+  end(*intStr*);
+function isInt(str : String; var i : Integer) : Boolean;
+  var res : Integer;
+  begin
+    val(str, i, res);
+    isInt := res = 0;
+  end(*isInt*);
+function path(filename : String) : String;
+  var i : Integer;
+  begin
+    i := length(filename);
+    while (i>0) and (filename[i]<>'\') and (filename[i]<>':') do
+      dec(i);
+    path := copy(filename, 1, i);
+  end(*path*);
+function root(filename : String) : String;
+  var
+    i : Integer;
+  begin
+    root := filename;
+    for i := length(filename) downto 1 do
+      case filename[i] of
+        '.' :
+          begin
+            root := copy(filename, 1, i-1);
+            exit
+          end;
+        '\': exit;
+        else
+      end;
+  end(*addExt*);
+function addExt(filename, ext : String) : String;
+  (* implemented with goto for maximum efficiency *)
+  label x;
+  var
+    i : Integer;
+  begin
+    addExt := filename;
+    for i := length(filename) downto 1 do
+      case filename[i] of
+        '.' : exit;
+        '\': goto x;
+        else
+      end;
+    x : addExt := filename+'.'+ext
+  end(*addExt*);
+function file_size(filename : String) : LongInt;
+  var f : File;
+  begin
+    assign(f, filename);
+    reset(f, 1);
+    if ioresult=0 then
+      file_size := fileSize(f)
+    else
+      file_size := 0;
+    close(f);
+  end(*file_size*);
+
+(* Utility functions for list generating routines: *)
+
+function charStr(c : char; reserved : CClass) : String;
+  function octStr(c : char) : String;
+    (* return octal string representation of character c *)
+    begin
+      octStr := intStr(ord(c) div 64)+intStr((ord(c) mod 64) div 8)+
+                intStr(ord(c) mod 8);
+    end(*octStr*);
+  begin
+    case c of
+      #0..#7,      (* nonprintable characters *)
+      #11,#14..#31,
+      #127..#255 : charStr := '\'+octStr(c);
+      bs         : charStr := '\b';
+      tab        : charStr := '\t';
+      nl         : charStr := '\n';
+      cr         : charStr := '\c';
+      ff         : charStr := '\f';
+      '\'        : charStr := '\\';
+      else if c in reserved then
+        charStr := '\'+c
+      else
+        charStr := c
+    end
+  end(*charStr*);
+
+function singleQuoteStr(str : String) : String;
+  var
+    i : Integer;
+    str1 : String;
+  begin
+    str1 := '';
+    for i := 1 to length(str) do
+      str1 := str1+charStr(str[i], ['''']);
+    singleQuoteStr := ''''+str1+''''
+  end(*singleQuoteStr*);
+
+function doubleQuoteStr(str : String) : String;
+  var
+    i : Integer;
+    str1 : String;
+  begin
+    str1 := '';
+    for i := 1 to length(str) do
+      str1 := str1+charStr(str[i], ['"']);
+    doubleQuoteStr := '"'+str1+'"'
+  end(*doubleQuoteStr*);
+
+function cclassStr(cc : CClass) : String;
+  const
+    reserved : CClass = ['^','-',']'];
+    MaxChar = #255;
+  var
+    c1, c2 : Char;
+    str : String;
+    Quit: Boolean;
+  begin
+    if cc=[#1..#255]-[nl] then
+      cclassStr := '.'
+    else
+      begin
+        str := '';
+        if nchars(cc)>128 then
+          begin
+            str := '^';
+            cc := [#0..#255]-cc;
+          end;
+        c1 := chr(0);
+        Quit := False;
+        while not Quit do  begin
+          if c1 in cc then  begin
+            c2 := c1;
+            while (c2<MaxChar) and (succ(c2) in cc) do
+              c2 := succ(c2);
+            if c1=c2
+             then  str := str+charStr(c1, reserved)
+             else
+               if c2=succ(c1)
+                then  str := str+charStr(c1, reserved)+charStr(c2, reserved)
+                else  str := str+charStr(c1, reserved)+'-'+charStr(c2, reserved);
+              c1 := c2;
+          end;
+          Quit := c1 = MaxChar;
+          if not Quit then
+            c1 := Succ(c1);
+        end; { of while }
+        cclassStr := '['+str+']'
+      end
+  end(*cclassStr*);
+
+function cclassOrCharStr(cc : CClass) : String;
+  var count : Integer;
+      c, c1 : Char;
+  begin
+    count := 0;
+    for c := #0 to #255 do
+      if c in cc then
+        begin
+          c1 := c;
+          inc(count);
+          if count>1 then
+            begin
+              cclassOrCharStr := cclassStr(cc);
+              exit;
+            end;
+        end;
+    if count=1 then
+      cclassOrCharStr := singleQuoteStr(c1)
+    else
+      cclassOrCharStr := '[]';
+  end(*cclassOrCharStr*);
+
+function regExprStr(r : RegExpr) : String;
+  function unparseExpr(r : RegExpr) : String;
+    var rule_no, pos : Integer;
+        c : Char;
+        str : StrPtr;
+        cc : CClassPtr;
+        r1, r2 : RegExpr;
+    begin
+      if is_epsExpr(r) then
+        unparseExpr := ''
+      else if is_markExpr(r, rule_no, pos) then
+        unparseExpr := '#('+intStr(rule_no)+','+intStr(pos)+')'
+      else if is_charExpr(r, c) then
+        unparseExpr := charStr(c, [ '"','.','^','$','[',']','*','+','?',
+                                    '{','}','|','(',')','/','<','>'])
+      else if is_strExpr(r, str) then
+        unparseExpr := doubleQuoteStr(str^)
+      else if is_cclassExpr(r, cc) then
+        unparseExpr := cclassStr(cc^)
+      else if is_starExpr(r, r1) then
+        unparseExpr := unparseExpr(r1)+'*'
+      else if is_plusExpr(r, r1) then
+        unparseExpr := unparseExpr(r1)+'+'
+      else if is_optExpr(r, r1) then
+        unparseExpr := unparseExpr(r1)+'?'
+      else if is_catExpr(r, r1, r2) then
+        unparseExpr := '('+unparseExpr(r1)+unparseExpr(r2)+')'
+      else if is_altExpr(r, r1, r2) then
+        unparseExpr := '('+unparseExpr(r1)+'|'+unparseExpr(r2)+')'
+      else
+        fatal('invalid expression');
+    end(*unparseExpr*);
+  begin
+    regExprStr := unparseExpr(r);
+  end(*regExprStr*);
+
+end(*LexBase*).

utils/tply/lexdfa.pas

@@ -0,0 +1,85 @@
+{
+  DFA table construction. This code, admittedly, is not the most aesthetic,
+  but it's quite efficient (and that's the main goal). For further
+  explanation, refer to Aho/Sethi/Ullman 1986, Section 3.9.
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-08-01 6:13 $
+
+$History: LEXDFA.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+}
+
+
+unit LexDFA;
+
+interface
+
+
+
+procedure makeDFATable;
+  (* construct DFA from position table *)
+
+implementation
+
+uses LexBase, LexTable;
+
+procedure makeDFATable;
+  var i : Integer;
+  begin
+    (* initialize start states: *)
+    for i := 2 to 2*n_start_states+1 do
+      setunion(first_pos_table^[i]^, first_pos_table^[i mod 2]^);
+    for i := 0 to 2*n_start_states+1 do
+      act_state := newState(first_pos_table^[i]);
+    act_state := -1;
+    while succ(act_state)<n_states do
+      begin
+        inc(act_state);
+        (* add transitions for active state: *)
+        startStateTrans;
+        for i := 1 to size(state_table^[act_state].state_pos^) do
+          with pos_table^[state_table^[act_state].state_pos^[i]] do
+            if pos_type=char_pos then
+              addTrans([c], follow_pos)
+            else if pos_type=cclass_pos then
+              addTrans(cc^, follow_pos)
+            else if pos=0 then
+              state_table^[act_state].final := true;
+        (* assign next states: *)
+        for i := state_table^[act_state].trans_lo to n_trans do
+          with trans_table^[i] do
+            next_state := addState(follow_pos);
+        (* merge transitions for the same next state: *)
+        mergeTrans;
+        (* sort transitions: *)
+        sortTrans;
+        endStateTrans;
+      end;
+  end(*makeDFATable*);
+
+end(*LexDFA*).

utils/tply/lexlib.pas

@@ -0,0 +1,409 @@
+
+{$I-}
+
+unit LexLib;
+
+(* Standard Lex library unit for TP Lex Version 3.0.
+   2-11-91 AG *)
+
+interface
+
+(* The Lex library unit supplies a collection of variables and routines
+   needed by the lexical analyzer routine yylex and application programs
+   using Lex-generated lexical analyzers. It also provides access to the
+   input/output streams used by the lexical analyzer and the text of the
+   matched string, and provides some utility functions which may be used
+   in actions.
+
+   This `standard' version of the LexLib unit is used to implement lexical
+   analyzers which read from and write to MS-DOS files (using standard input
+   and output, by default). It is suitable for many standard applications
+   for lexical analyzers, such as text conversion tools or compilers.
+
+   However, you may create your own version of the LexLib unit, tailored to
+   your target applications. In particular, you may wish to provide another
+   set of I/O functions, e.g., if you want to read from or write to memory
+   instead to files, or want to use different file types. *)
+
+(* Variables:
+
+   The variable yytext contains the current match, yyleng its length.
+   The variable yyline contains the current input line, and yylineno and
+   yycolno denote the current input position (line, column). These values
+   are often used in giving error diagnostics (however, they will only be
+   meaningful if there is no rescanning across line ends).
+
+   The variables yyinput and yyoutput are the text files which are used
+   by the lexical analyzer. By default, they are assigned to standard
+   input and output, but you may change these assignments to fit your
+   target application (use the Turbo Pascal standard routines assign,
+   reset, and rewrite for this purpose). *)
+
+var
+
+yyinput, yyoutput : Text;        (* input and output file *)
+yyline            : String;      (* current input line *)
+yylineno, yycolno : Integer;     (* current input position *)
+yytext            : String;      (* matched text (should be considered r/o) *)
+yyleng            : Byte         (* length of matched text *)
+  absolute yytext;
+
+(* I/O routines:
+
+   The following routines get_char, unget_char and put_char are used to
+   implement access to the input and output files. Since \n (newline) for
+   Lex means line end, the I/O routines have to translate MS-DOS line ends
+   (carriage-return/line-feed) into newline characters and vice versa. Input
+   is buffered to allow rescanning text (via unput_char).
+
+   The input buffer holds the text of the line to be scanned. When the input
+   buffer empties, a new line is obtained from the input stream. Characters
+   can be returned to the input buffer by calls to unget_char. At end-of-
+   file a null character is returned.
+
+   The input routines also keep track of the input position and set the
+   yyline, yylineno, yycolno variables accordingly.
+
+   Since the rest of the Lex library only depends on these three routines
+   (there are no direct references to the yyinput and yyoutput files or
+   to the input buffer), you can easily replace get_char, unget_char and
+   put_char by another suitable set of routines, e.g. if you want to read
+   from/write to memory, etc. *)
+
+function get_char : Char;
+  (* obtain one character from the input file (null character at end-of-
+     file) *)
+
+procedure unget_char ( c : Char );
+  (* return one character to the input file to be reread in subsequent calls
+     to get_char *)
+
+procedure put_char ( c : Char );
+  (* write one character to the output file *)
+
+(* Utility routines: *)
+
+procedure echo;
+  (* echoes the current match to the output stream *)
+
+procedure yymore;
+  (* append the next match to the current one *)
+
+procedure yyless ( n : Integer );
+  (* truncate yytext to size n and return the remaining characters to the
+     input stream *)
+
+procedure reject;
+  (* reject the current match and execute the next one *)
+
+  (* reject does not actually cause the input to be rescanned; instead,
+     internal state information is used to find the next match. Hence
+     you should not try to modify the input stream or the yytext variable
+     when rejecting a match. *)
+
+procedure return ( n : Integer );
+procedure returnc ( c : Char );
+  (* sets the return value of yylex *)
+
+procedure start ( state : Integer );
+  (* puts the lexical analyzer in the given start state; state=0 denotes
+     the default start state, other values are user-defined *)
+
+(* yywrap:
+
+   The yywrap function is called by yylex at end-of-file (unless you have
+   specified a rule matching end-of-file). You may redefine this routine
+   in your Lex program to do application-dependent processing at end of
+   file. In particular, yywrap may arrange for more input and return false
+   in which case the yylex routine resumes lexical analysis. *)
+
+function yywrap : Boolean;
+  (* The default yywrap routine supplied here closes input and output files
+     and returns true (causing yylex to terminate). *)
+
+(* The following are the internal data structures and routines used by the
+   lexical analyzer routine yylex; they should not be used directly. *)
+
+var
+
+yystate    : Integer; (* current state of lexical analyzer *)
+yyactchar  : Char;    (* current character *)
+yylastchar : Char;    (* last matched character (#0 if none) *)
+yyrule     : Integer; (* matched rule *)
+yyreject   : Boolean; (* current match rejected? *)
+yydone     : Boolean; (* yylex return value set? *)
+yyretval   : Integer; (* yylex return value *)
+
+procedure yynew;
+  (* starts next match; initializes state information of the lexical
+     analyzer *)
+
+procedure yyscan;
+  (* gets next character from the input stream and updates yytext and
+     yyactchar accordingly *)
+
+procedure yymark ( n : Integer );
+  (* marks position for rule no. n *)
+
+procedure yymatch ( n : Integer );
+  (* declares a match for rule number n *)
+
+function yyfind ( var n : Integer ) : Boolean;
+  (* finds the last match and the corresponding marked position and adjusts
+     the matched string accordingly; returns:
+     - true if a rule has been matched, false otherwise
+     - n: the number of the matched rule *)
+
+function yydefault : Boolean;
+  (* executes the default action (copy character); returns true unless
+     at end-of-file *)
+
+procedure yyclear;
+  (* reinitializes state information after lexical analysis has been
+     finished *)
+
+implementation
+
+procedure fatal ( msg : String );
+  (* writes a fatal error message and halts program *)
+  begin
+    writeln('LexLib: ', msg);
+    halt(1);
+  end(*fatal*);
+
+(* I/O routines: *)
+
+const nl = #10;  (* newline character *)
+
+const max_chars = 2048;
+
+var
+
+bufptr : Integer;
+buf    : array [1..max_chars] of Char;
+
+function get_char : Char;
+  var i : Integer;
+  begin
+    if (bufptr=0) and not eof(yyinput) then
+      begin
+        readln(yyinput, yyline);
+        inc(yylineno); yycolno := 1;
+        buf[1] := nl;
+        for i := 1 to length(yyline) do
+          buf[i+1] := yyline[length(yyline)-i+1];
+        inc(bufptr, length(yyline)+1);
+      end;
+    if bufptr>0 then
+      begin
+        get_char := buf[bufptr];
+        dec(bufptr);
+        inc(yycolno);
+      end
+    else
+      get_char := #0;
+  end(*get_char*);
+
+procedure unget_char ( c : Char );
+  begin
+    if bufptr=max_chars then fatal('input buffer overflow');
+    inc(bufptr);
+    dec(yycolno);
+    buf[bufptr] := c;
+  end(*unget_char*);
+
+procedure put_char ( c : Char );
+  begin
+    if c=#0 then
+      { ignore }
+    else if c=nl then
+      writeln(yyoutput)
+    else
+      write(yyoutput, c)
+  end(*put_char*);
+
+(* Variables:
+
+   Some state information is maintained to keep track with calls to yymore,
+   yyless, reject, start and yymatch/yymark, and to initialize state
+   information used by the lexical analyzer.
+   - yystext: contains the initial contents of the yytext variable; this
+     will be the empty string, unless yymore is called which sets yystext
+     to the current yytext
+   - yysstate: start state of lexical analyzer (set to 0 during
+     initialization, and modified in calls to the start routine)
+   - yylstate: line state information (1 if at beginning of line, 0
+     otherwise)
+   - yystack: stack containing matched rules; yymatches contains the number of
+     matches
+   - yypos: for each rule the last marked position (yymark); zeroed when rule
+     has already been considered
+   - yysleng: copy of the original yyleng used to restore state information
+     when reject is used *)
+
+const
+
+max_matches = 1024;
+max_rules   = 256;
+
+var
+
+yystext            : String;
+yysstate, yylstate : Integer;
+yymatches          : Integer;
+yystack            : array [1..max_matches] of Integer;
+yypos              : array [1..max_rules] of Integer;
+yysleng            : Byte;
+
+(* Utilities: *)
+
+procedure echo;
+  var i : Integer;
+  begin
+    for i := 1 to yyleng do
+      put_char(yytext[i])
+  end(*echo*);
+
+procedure yymore;
+  begin
+    yystext := yytext;
+  end(*yymore*);
+
+procedure yyless ( n : Integer );
+  var i : Integer;
+  begin
+    for i := yyleng downto n+1 do
+      unget_char(yytext[i]);
+    yyleng := n;
+  end(*yyless*);
+
+procedure reject;
+  var i : Integer;
+  begin
+    yyreject := true;
+    for i := yyleng+1 to yysleng do
+      yytext := yytext+get_char;
+    dec(yymatches);
+  end(*reject*);
+
+procedure return ( n : Integer );
+  begin
+    yyretval := n;
+    yydone := true;
+  end(*return*);
+
+procedure returnc ( c : Char );
+  begin
+    yyretval := ord(c);
+    yydone := true;
+  end(*returnc*);
+
+procedure start ( state : Integer );
+  begin
+    yysstate := state;
+  end(*start*);
+
+(* yywrap: *)
+
+function yywrap : Boolean;
+  begin
+    close(yyinput); close(yyoutput);
+    yywrap := true;
+  end(*yywrap*);
+
+(* Internal routines: *)
+
+procedure yynew;
+  begin
+    if yylastchar<>#0 then
+      if yylastchar=nl then
+        yylstate := 1
+      else
+        yylstate := 0;
+    yystate := yysstate+yylstate;
+    yytext  := yystext;
+    yystext := '';
+    yymatches := 0;
+    yydone := false;
+  end(*yynew*);
+
+procedure yyscan;
+  begin
+    if yyleng=255 then fatal('yytext overflow');
+    yyactchar := get_char;
+    inc(yyleng);
+    yytext[yyleng] := yyactchar;
+  end(*yyscan*);
+
+procedure yymark ( n : Integer );
+  begin
+    if n>max_rules then fatal('too many rules');
+    yypos[n] := yyleng;
+  end(*yymark*);
+
+procedure yymatch ( n : Integer );
+  begin
+    inc(yymatches);
+    if yymatches>max_matches then fatal('match stack overflow');
+    yystack[yymatches] := n;
+  end(*yymatch*);
+
+function yyfind ( var n : Integer ) : Boolean;
+  begin
+    yyreject := false;
+    while (yymatches>0) and (yypos[yystack[yymatches]]=0) do
+      dec(yymatches);
+    if yymatches>0 then
+      begin
+        yysleng := yyleng;
+        n       := yystack[yymatches];
+        yyless(yypos[n]);
+        yypos[n] := 0;
+        if yyleng>0 then
+          yylastchar := yytext[yyleng]
+        else
+          yylastchar := #0;
+        yyfind := true;
+      end
+    else
+      begin
+        yyless(0);
+        yylastchar := #0;
+        yyfind := false;
+      end
+  end(*yyfind*);
+
+function yydefault : Boolean;
+  begin
+    yyreject := false;
+    yyactchar := get_char;
+    if yyactchar<>#0 then
+      begin
+        put_char(yyactchar);
+        yydefault := true;
+      end
+    else
+      begin
+        yylstate := 1;
+        yydefault := false;
+      end;
+    yylastchar := yyactchar;
+  end(*yydefault*);
+
+procedure yyclear;
+  begin
+    bufptr := 0;
+    yysstate := 0;
+    yylstate := 1;
+    yylastchar := #0;
+    yytext := '';
+    yystext := '';
+  end(*yyclear*);
+
+begin
+  assign(yyinput, '');
+  assign(yyoutput, '');
+  reset(yyinput); rewrite(yyoutput);
+  yylineno := 0;
+  yyclear;
+end(*LexLib*).

utils/tply/lexlist.pas

@@ -0,0 +1,141 @@
+{
+  Lex listing routines.
+
+  This module provides some routines to produce a readable representation
+  of the generated DFA tables (the routines are only used when Lex is run
+  with the verbose option /v).
+
+  If this module is compiled with defined conditional `debug', the list file
+  will contain extensive debugging output (position table, state positions,
+  etc.).
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-08-01 6:28 $
+
+$History: LEXLIST.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+}
+
+
+unit LexList;
+
+interface
+
+uses
+  LexBase;
+
+
+procedure listDFATable;
+  (* list DFA table *)
+
+implementation
+
+uses LexTable;
+
+procedure listTrans(cc : CClassPtr; next_state : Integer);
+  (* list a transition in the format
+        cc : next_state *)
+  begin
+    write(yylst, cclassOrCharStr(cc^):30, ' : ', next_state:5);
+  end(*listTrans*);
+
+{$ifdef debug}
+
+procedure listPosTable;
+  (* lists the position table *)
+  var
+    p, i : Integer;
+  begin
+    if n_pos=0 then exit;
+    writeln(yylst);
+    for p := 1 to n_pos do
+      with pos_table^[p] do
+        begin
+          write(yylst, p:5, '     ');
+          if pos_type=char_pos then
+            write(yylst, singleQuoteStr(c):20)
+          else if pos_type=cclass_pos then
+            write(yylst, cclassStr(cc^):20)
+          else if pos_type=mark_pos then
+            if pos=0 then
+              write(yylst, '# (rule '+intStr(rule)+')':20)
+            else
+              write(yylst, '/ (rule '+intStr(rule)+')':20);
+          write(yylst, ' ':5);
+          for i := 1 to size(follow_pos^) do
+            if follow_pos^[i]>0 then write(yylst, follow_pos^[i]:5, ' ');
+          writeln(yylst);
+        end;
+    writeln(yylst);
+  end(*listPosTable*);
+
+{$endif}
+
+procedure listDFATable;
+  var k, state : Integer;
+  begin
+{$ifdef debug}
+    (* list position table: *)
+    writeln(yylst);
+    writeln(yylst, '( positions : )');
+    listPosTable;
+    (* list state table: *)
+    writeln(yylst);
+    writeln(yylst, '( states : )');
+{$endif}
+    writeln(yylst);
+    for state := 0 to pred(n_states) do
+      begin
+        writeln(yylst);
+        write(yylst, state);
+        with state_table^[state] do
+          begin
+            if final then
+              write(yylst, '* :')
+            else
+              write(yylst, '  :');
+{$ifdef debug}
+            for k := 1 to size(state_pos^) do
+              write(yylst, ' ', state_pos^[k]:5);
+{$else}
+            for k := 1 to size(state_pos^) do
+              with pos_table^[state_pos^[k]] do
+                if (pos_type=mark_pos) and (pos=0) then
+                  write(yylst, ' ', rule:5);
+{$endif}
+            writeln(yylst);
+            for k := trans_lo to trans_hi do
+              with trans_table^[k] do
+                begin
+                  listTrans(cc, next_state);
+                  writeln(yylst);
+                end;
+          end;
+      end;
+  end(*listDFATable*);
+
+end(*LexList*).

utils/tply/lexmsgs.pas

@@ -0,0 +1,173 @@
+{
+  TP Lex message and error handling module
+  Note: this module should be USEd by any module using the heap during
+        initialization, since it installs a heap error handler (which
+        terminates the program with fatal error `memory overflow').
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-08-01 8:52 $
+
+$History: LEXMSGS.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+}
+
+
+unit LexMsgs;
+
+interface
+
+
+var errors, warnings : Integer;
+  (* - current error and warning count *)
+procedure error(msg : String; pos : Integer);
+  (* - print current input line and error message (pos denotes position to
+       mark in source file line) *)
+procedure warning(msg : String; pos : Integer);
+  (* - print warning message *)
+procedure fatal(msg : String);
+  (* - writes a fatal error message, erases Lex output file and terminates
+       the program with errorlevel 1 *)
+
+const
+
+(* sign-on and usage message: *)
+
+sign_on = 'TP Lex Version 4.1 [May 1998], Copyright (c) 1990-98 Albert Graef';
+{$ifdef linux}
+usage   = 'Usage: plex [options] lex-file[.l] [output-file[.pas]]';
+{$else}
+usage   = 'Usage: lex [options] lex-file[.l] [output-file[.pas]]';
+{$endif}
+options = 'Options: -v verbose, -o optimize';
+
+(* command line error messages: *)
+
+invalid_option                  = 'invalid option ';
+illegal_no_args                 = 'illegal number of parameters';
+
+(* syntax errors: *)
+
+unmatched_lbrace                = '101: unmatched %{';
+syntax_error                    = '102: syntax error';
+unexpected_eof                  = '103: unexpected end of file';
+
+(* semantic errors: *)
+
+symbol_already_defined          = '201: symbol already defined';
+undefined_symbol                = '202: undefined symbol';
+invalid_charnum                 = '203: invalid character number';
+empty_grammar                   = '204: empty grammar?';
+
+(* fatal errors: *)
+
+cannot_open_file                = 'FATAL: cannot open file ';
+write_error                     = 'FATAL: write error';
+mem_overflow                    = 'FATAL: memory overflow';
+intset_overflow                 = 'FATAL: integer set overflow';
+sym_table_overflow              = 'FATAL: symbol table overflow';
+pos_table_overflow              = 'FATAL: position table overflow';
+state_table_overflow            = 'FATAL: state table overflow';
+trans_table_overflow            = 'FATAL: transition table overflow';
+macro_stack_overflow            = 'FATAL: macro stack overflow';
+
+implementation
+
+uses LexBase;
+
+procedure position(var f : Text;
+            lineNo : integer;
+            line : String;
+            pos : integer);
+  (* writes a position mark of the form
+     gfilename (lineno): line
+                          ^
+     on f with the caret ^ positioned at pos in line
+     a subsequent write starts at the next line, indented with tab *)
+  var
+    line1, line2 : String;
+  begin
+    (* this hack handles tab characters in line: *)
+    line1 := intStr(lineNo)+': '+line;
+    line2 := blankStr(intStr(lineNo)+': '+copy(line, 1, pos-1));
+    writeln(f, line1);
+    writeln(f, line2, '^');
+    write(f, tab)
+  end(*position*);
+
+procedure error(msg : String; pos : Integer);
+  begin
+    inc(errors);
+    writeln;
+    position(output, lno, line, pos);
+    writeln(msg);
+    writeln(yylst);
+    position(yylst, lno, line, pos);
+    writeln(yylst, msg);
+    if ioresult<>0 then ;
+  end(*error*);
+
+procedure warning(msg : String; pos : Integer);
+  begin
+    inc(warnings);
+    writeln;
+    position(output, lno, line, pos);
+    writeln(msg);
+    writeln(yylst);
+    position(yylst, lno, line, pos);
+    writeln(yylst, msg);
+    if ioresult<>0 then ;
+  end(*warning*);
+
+procedure fatal(msg : String);
+  begin
+    writeln;
+    writeln(msg);
+    close(yyin); close(yyout); close(yylst); erase(yyout);
+    halt(1)
+  end(*fatal*);
+
+{$ifndef fpc}
+{$IFNDEF Win32}
+function heapErrorHandler ( size : Word ): Integer; {$ifndef fpc}far;{$endif}
+  begin
+    if size>0 then
+      fatal(mem_overflow) (* never returns *)
+    else
+      heapErrorHandler := 1
+  end(*heapErrorHandler*);
+{$ENDIF}
+{$endif}
+
+begin
+  errors := 0; warnings := 0;
+{$ifndef fpc}
+{$IFNDEF Win32}
+  (* install heap error handler: *)
+  heapError := @heapErrorHandler;
+{$ENDIF}
+{$endif}
+end(*LexMsgs*).

utils/tply/lexopt.pas

@@ -0,0 +1,230 @@
+{
+  DFA optimization algorithm.
+  This is an efficient (O(n log(n)) DFA optimization procedure based on the
+  algorithm given in Aho/Sethi/Ullman, 1986, Section 3.9.
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-08-01 6:29 $
+
+$History: LEXOPT.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+}
+
+
+unit LexOpt;
+
+interface
+
+
+
+procedure optimizeDFATable;
+  (* optimize the state table *)
+
+implementation
+
+uses LexBase, LexTable;
+
+(* Partition table used in DFA optimization: *)
+
+const
+
+max_parts = max_states;  (* number of partitions of equivalent states; at
+                            worst, each state may be in a partition by
+                            itself *)
+
+type
+
+PartTable      = array [0..max_states-1] of IntSetPtr;
+                   (* state partitions (DFA optimization) *)
+
+StatePartTable = array [0..max_states-1] of Integer;
+                   (* partition number of states *)
+
+var
+
+(* partition table: *)
+
+n_parts           : Integer;
+part_table        : ^PartTable;
+state_part        : ^StatePartTable;
+
+(* optimized state and transition table: *)
+
+n_opt_states      : Integer;
+n_opt_trans       : Integer;
+opt_state_table   : ^StateTable;
+opt_trans_table   : ^TransTable;
+
+
+function equivStates(i, j : Integer) : Boolean;
+  (* checks whether states i and j are equivalent; two states are considered
+     equivalent iff:
+     - they cover the same marker positions (/ and endmarkers of rules)
+     - they have transitions on the same symbols/characters, and corresponding
+       transitions go to states in the same partition
+     two different start states are never considered equivalent *)
+  var ii, jj, k : Integer;
+      mark_pos_i, mark_pos_j : IntSet;
+  begin
+    (* check for start states: *)
+    if (i<=2*n_start_states+1) and (j<=2*n_start_states+1) and
+       (i<>j) then
+      begin
+        equivStates := false;
+        exit;
+      end;
+    (* check end positions: *)
+    empty(mark_pos_i);
+    with state_table^[i] do
+      for k := 1 to size(state_pos^) do
+        if pos_table^[state_pos^[k]].pos_type=mark_pos then
+          include(mark_pos_i, state_pos^[k]);
+    empty(mark_pos_j);
+    with state_table^[j] do
+      for k := 1 to size(state_pos^) do
+        if pos_table^[state_pos^[k]].pos_type=mark_pos then
+          include(mark_pos_j, state_pos^[k]);
+    if not equal(mark_pos_i, mark_pos_j) then
+      begin
+        equivStates := false;
+        exit
+      end;
+    (* check transitions: *)
+    if n_state_trans(i)<>n_state_trans(j) then
+      equivStates := false
+    else
+      begin
+        ii := state_table^[i].trans_lo;
+        jj := state_table^[j].trans_lo;
+        for k := 0 to pred(n_state_trans(i)) do
+          if (trans_table^[ii+k].cc^<>trans_table^[jj+k].cc^) then
+            begin
+              equivStates := false;
+              exit
+            end
+          else if state_part^[trans_table^[ii+k].next_state]<>
+                  state_part^[trans_table^[jj+k].next_state] then
+            begin
+              equivStates := false;
+              exit
+            end;
+        equivStates := true;
+      end
+  end(*equivStates*);
+
+procedure optimizeDFATable;
+
+  var
+    i, ii, j : Integer;
+    act_part, new_part, n_new_parts : Integer;
+
+  begin
+
+    n_parts := 0;
+
+    (* Initially, create one partition containing ALL states: *)
+
+    n_parts := 1;
+    part_table^[0] := newIntSet;
+    for i := 0 to n_states-1 do
+      begin
+        include(part_table^[0]^, i);
+        state_part^[i] := 0;
+      end;
+
+    (* Now, repeatedly pass over the created partitions, breaking up
+       partitions if they contain nonequivalent states, until no more
+       partitions have been added during the last pass: *)
+
+    repeat
+      n_new_parts := 0; act_part := 0;
+      new_part := n_parts;
+      part_table^[new_part] := newIntSet;
+      while (n_parts<n_states) and (act_part<n_parts) do
+        begin
+          for i := 2 to size(part_table^[act_part]^) do
+            if not equivStates(part_table^[act_part]^[1],
+                               part_table^[act_part]^[i]) then
+              (* add to new partition: *)
+              include(part_table^[new_part]^, part_table^[act_part]^[i]);
+          if size(part_table^[new_part]^)<>0 then
+            begin
+              (* add new partition: *)
+              inc(n_parts); inc(n_new_parts);
+              (* remove new partition from old one: *)
+              setminus(part_table^[act_part]^, part_table^[new_part]^);
+              (* update partition assignments: *)
+              for i := 1 to size(part_table^[new_part]^) do
+                state_part^[part_table^[new_part]^[i]] := new_part;
+              inc(new_part);
+              part_table^[new_part] := newIntSet;
+            end;
+          inc(act_part);
+        end;
+    until n_new_parts=0;
+
+    (* build the optimized state table: *)
+
+    n_opt_states := n_parts;
+    n_opt_trans := 0;
+    for i := 0 to n_parts-1 do
+      begin
+        ii := part_table^[i]^[1];
+        opt_state_table^[i] := state_table^[ii];
+        with opt_state_table^[i] do
+          begin
+            trans_lo := n_opt_trans+1;
+            trans_hi := n_opt_trans+1+state_table^[ii].trans_hi-
+                        state_table^[ii].trans_lo;
+            for j := 2 to size(part_table^[i]^) do
+              setunion(state_pos^, state_table^[
+                                     part_table^[i]^[j]].state_pos^);
+          end;
+        for j := state_table^[ii].trans_lo to state_table^[ii].trans_hi do
+          begin
+            inc(n_opt_trans);
+            opt_trans_table^[n_opt_trans] := trans_table^[j];
+            with opt_trans_table^[n_opt_trans] do
+              next_state := state_part^[next_state];
+          end;
+      end;
+
+      (* update state table: *)
+
+      n_states     := n_opt_states;
+      n_trans      := n_opt_trans;
+      state_table^ := opt_state_table^;
+      trans_table^ := opt_trans_table^;
+
+  end(*optimizeDFATable*);
+
+begin
+  new(part_table);
+  new(state_part);
+  new(opt_state_table);
+  new(opt_trans_table);
+end(*LexOpt*).

utils/tply/lexpos.pas

@@ -0,0 +1,166 @@
+{
+  Construct the position table, as well as first position sets.
+
+  The position table stores symbol positions in regular expressions of
+  the Lex grammar. It also allows to store the corresponding first
+  and follow sets. By this means, the position table represents an eps-
+  free nondeterministic automaton for the regular expressions of the
+  Lex grammar (cf. Aho/Sethi/Ullman, Compilers : Principles, Techniques
+  and Tools, 1986, Section 3.9, on constructing NFA's from regular
+  expressions using position tables).
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-08-01 6:30 $
+
+$History: LEXPOS.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+}
+
+
+unit LexPos;
+
+
+interface
+
+uses LexBase, LexTable;
+
+
+procedure addExpr(r : RegExpr; var FIRST : IntSet);
+  (* Add the positions in r to the position table, and return the set of
+     first positions of r. *)
+
+implementation
+
+procedure eval(r : RegExpr;
+               var FIRST, LAST : IntSet;
+               var nullable : Boolean);
+  (* Evaluates the expression r, adding the positions in r to the position
+     table and assigning FIRST, LAST and FOLLOW sets accordingly (cf. Aho/
+     Sethi/Ullman, Compilers : Principles, Techniques and Tools, Section 3.9).
+     Returns:
+     - FIRST: the set of first positions in r
+     - LAST: the set of last positions in r
+     - nullable: denotes whether the r is nullable (i.e. is matched by the
+       empty string). *)
+  var
+    c : Char;
+    str : StrPtr;
+    cc : CClassPtr;
+    rule, pos : Integer;
+    r1, r2 : RegExpr;
+    FIRST1, LAST1 : IntSet;
+    nullable1 : Boolean;
+    i : integer;
+  begin
+    if is_epsExpr(r) then
+      begin
+        empty(FIRST); empty(LAST);
+        nullable := true
+      end
+    else if is_markExpr(r, rule, pos) then
+      begin
+        addMarkPos(rule, pos);
+        singleton(FIRST, n_pos); singleton(LAST, n_pos);
+        nullable := true
+      end
+    else if is_charExpr(r, c) then
+      begin
+        addCharPos(c);
+        singleton(FIRST, n_pos); singleton(LAST, n_pos);
+        nullable := false
+      end
+    else if is_strExpr(r, str) then
+      if length(str^)=0 then
+        (* empty string is treated as empty expression *)
+        begin
+          empty(FIRST); empty(LAST);
+          nullable := true
+        end
+      else
+        begin
+          addCharPos(str^[1]);
+          singleton(FIRST, n_pos);
+          for i := 2 to length(str^) do
+            begin
+              addCharPos(str^[i]);
+              singleton(pos_table^[pred(n_pos)].follow_pos^, n_pos);
+            end;
+          singleton(LAST, n_pos);
+          nullable := false
+        end
+    else if is_CClassExpr(r, cc) then
+      begin
+        addCClassPos(cc);
+        singleton(FIRST, n_pos); singleton(LAST, n_pos);
+        nullable := false
+      end
+    else if is_starExpr(r, r1) then
+      begin
+        eval(r1, FIRST, LAST, nullable);
+        for i := 1 to size(LAST) do
+          setunion(pos_table^[LAST[i]].follow_pos^, FIRST);
+        nullable := true
+      end
+    else if is_plusExpr(r, r1) then
+      begin
+        eval(r1, FIRST, LAST, nullable);
+        for i := 1 to size(LAST) do
+          setunion(pos_table^[LAST[i]].follow_pos^, FIRST);
+      end
+    else if is_optExpr(r, r1) then
+      begin
+        eval(r1, FIRST, LAST, nullable);
+        nullable := true
+      end
+    else if is_catExpr(r, r1, r2) then
+      begin
+        eval(r1, FIRST, LAST1, nullable);
+        eval(r2, FIRST1, LAST, nullable1);
+        for i := 1 to size(LAST1) do
+          setunion(pos_table^[LAST1[i]].follow_pos^, FIRST1);
+        if nullable then setunion(FIRST, FIRST1);
+        if nullable1 then setunion(LAST, LAST1);
+        nullable := nullable and nullable1
+      end
+    else if is_altExpr(r, r1, r2) then
+      begin
+        eval(r1, FIRST, LAST, nullable);
+        eval(r2, FIRST1, LAST1, nullable1);
+        setunion(FIRST, FIRST1);
+        setunion(LAST, LAST1);
+        nullable := nullable or nullable1
+      end
+  end(*eval*);
+
+procedure addExpr(r : RegExpr; var FIRST : IntSet);
+  var LAST : IntSet;
+      nullable : Boolean;
+  begin
+    eval(r, FIRST, LAST, nullable);
+  end(*addExpr*);
+
+end(*LexPos*).

utils/tply/lexrules.pas

@@ -0,0 +1,626 @@
+{
+  Parser for Lex grammar rules.
+
+  This module implements a parser for Lex grammar rules. It should
+  probably be reimplemented using Lex and Yacc, but the irregular
+  lexical structure of the Lex language makes that rather tedious,
+  so I decided to use a conventional recursive-descent-parser
+  instead.
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-08-01 6:30 $
+
+$History: LEXRULES.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+}
+
+
+unit LexRules;
+
+interface
+
+uses LexBase, LexTable;
+
+
+procedure parse_rule ( rule_no : Integer );
+  (* rule parser (rule_no=number of parsed rule) *)
+
+(* Return values of rule parser: *)
+
+var
+
+expr, stmt : String;
+  (* expression and statement part of rule *)
+cf   : Boolean;
+  (* caret flag *)
+n_st : Integer;
+  (* number of start states in prefix *)
+st   : array [1..max_states] of Integer;
+  (* start states *)
+r    : RegExpr;
+  (* parsed expression *)
+
+implementation
+
+uses LexMsgs;
+
+(* Scanner routines:
+
+   The following routines provide access to the source line and handle
+   macro substitutions. To perform macro substitution, an input buffer
+   is maintained which contains the rest of the line to be parsed, plus
+   any pending macro substitutions. The input buffer is organized as
+   a stack onto which null-terminated replacement strings are pushed
+   as macro substitutions are processed (the terminating null-character
+   is used as an endmarker for macros, in order to keep track of the
+   number of pending macro substitutions); characters are popped from the
+   stack via calls to the get_char routine.
+
+   In order to perform macro substitution, the scanner also has to
+   maintain some state information to be able to determine when it
+   is scanning quoted characters, strings or character classes (s.t.
+   no macro substitution is performed in such cases).
+
+   The scanner also keeps track of the current source line position in
+   variable act_pos; if there are any macro substitutions on the stack,
+   act_pos will point to the position of the original macro call in the
+   source line. This is needed to give proper error diagnostics. *)
+
+const max_chars = 2048;
+
+var
+
+act_pos, bufptr : Integer;
+  (* current position in source line and input stack pointer *)
+buf : array [1..max_chars] of Char;
+  (* input buffer *)
+str_state, cclass_state, quote_state : Boolean;
+  (* state information *)
+n_macros : Integer;
+  (* number of macros currently on stack *)
+
+procedure mark_error ( msg : String; offset : Integer );
+  (* mark error position (offset=offset of error position (to the left of
+     act_pos) *)
+  begin
+    if n_macros=0 then
+      error(msg, act_pos-offset)
+    else
+      error(msg+' in regular definition', act_pos)
+  end(*mark_error*);
+
+procedure put_str(str : String);
+  (* push str onto input stack *)
+  var i : Integer;
+  begin
+    inc(bufptr, length(str));
+    if bufptr>max_chars then fatal(macro_stack_overflow);
+    for i := 1 to length(str) do
+      buf[bufptr-i+1] := str[i];
+  end(*put_str*);
+
+procedure init_scanner;
+  (* initialize the scanner *)
+  begin
+    act_pos := 1; bufptr := 0;
+    str_state := false; cclass_state := false; quote_state := false;
+    n_macros := 0;
+    put_str(line);
+  end(*init_scanner*);
+
+function act_char : Char;
+  (* current character (#0 if none) *)
+  function push_macro : Boolean;
+    (* check for macro call at current position in input buffer *)
+    function scan_macro ( var name : String ) : Boolean;
+      var i : Integer;
+      begin
+        if (bufptr>1) and
+           (buf[bufptr]='{') and (buf[bufptr-1] in letters) then
+          begin
+            name := '{'; i := bufptr-1;
+            while (i>0) and (buf[i] in alphanums) do
+              begin
+                name := name+buf[i];
+                dec(i);
+              end;
+            if (i>0) and (buf[i]='}') then
+              begin
+                scan_macro := true;
+                name := name+'}';
+                bufptr := i-1;
+              end
+            else
+              begin
+                scan_macro := false;
+                mark_error(syntax_error, -length(name));
+                bufptr := i;
+              end
+          end
+        else
+          scan_macro := false
+      end(*scan_macro*);
+    var name : String;
+    begin
+      if scan_macro(name) then
+        begin
+          push_macro := true;
+{$ifdef fpc}
+          with sym_table^[key(name, max_keys, @lookup, @entry)] do
+{$else}
+          with sym_table^[key(name, max_keys, lookup, entry)] do
+{$endif}
+            if sym_type=macro_sym then
+              begin
+                put_str(subst^+#0);
+                inc(n_macros);
+              end
+            else
+              mark_error(undefined_symbol, -1)
+        end
+      else
+        push_macro := false
+    end(*push_macro*);
+  function pop_macro : Boolean;
+    (* check for macro endmarker *)
+    begin
+      if (bufptr>0) and (buf[bufptr]=#0) then
+        begin
+          dec(bufptr);
+          dec(n_macros);
+          if n_macros=0 then act_pos := length(line)-bufptr+1;
+          pop_macro := true;
+        end
+      else
+        pop_macro := false
+    end(*pop_macro*);
+  begin
+    if not (str_state or cclass_state or quote_state) then
+      while push_macro do while pop_macro do ;
+    if bufptr=0 then
+      act_char := #0
+    else
+      begin
+        while pop_macro do ;
+        act_char := buf[bufptr];
+      end
+  end(*act_char*);
+
+procedure get_char;
+  (* get next character *)
+  begin
+    if bufptr>0 then
+      begin
+        case buf[bufptr] of
+          '\' : quote_state := not quote_state;
+          '"' : if quote_state then
+                  quote_state := false
+                else if not cclass_state then
+                  str_state := not str_state;
+          '[' : if quote_state then
+                  quote_state := false
+                else if not str_state then
+                  cclass_state := true;
+          ']' : if quote_state then
+                  quote_state := false
+                else if not str_state then
+                  cclass_state := false;
+          else  quote_state := false;
+        end;
+        dec(bufptr);
+        if n_macros=0 then
+          act_pos := length(line)-bufptr+1;
+      end
+  end(*get_char*);
+
+(* Semantic routines: *)
+
+procedure add_start_state ( symbol : String );
+  (* add start state to st array *)
+  begin
+{$ifdef fpc}
+    with sym_table^[key(symbol, max_keys, @lookup, @entry)] do
+{$else}
+    with sym_table^[key(symbol, max_keys, lookup, entry)] do
+{$endif}
+      if sym_type=start_state_sym then
+        begin
+          if n_st>=max_start_states then exit; { this shouldn't happen }
+          inc(n_st);
+          st[n_st] := start_state;
+        end
+      else
+        mark_error(undefined_symbol, length(symbol))
+  end(*add_start_state*);
+
+(* Parser: *)
+
+procedure parse_rule ( rule_no : Integer );
+
+  procedure rule ( var done : Boolean );
+
+    (* parse rule according to syntax:
+
+       rule                     : start_state_prefix caret
+                                  expr [ '$' | '/' expr ]
+                                ;
+
+       start_state_prefix       : /* empty */
+                                | '<' start_state_list '>'
+                                ;
+
+       start_state_list         : ident { ',' ident }
+                                ;
+
+       caret                    : /* empty */
+                                | '^'
+                                ;
+
+       expr                     : term { '|' term }
+                                ;
+
+       term                     : factor { factor }
+                                ;
+
+       factor                   : char
+                                | string
+                                | cclass
+                                | '.'
+                                | '(' expr ')'
+                                | factor '*'
+                                | factor '+'
+                                | factor '?'
+                                | factor '{' num [ ',' num ] '}'
+                                ;
+    *)
+
+    procedure start_state_prefix ( var done : Boolean );
+      procedure start_state_list ( var done : Boolean );
+        procedure ident ( var done : Boolean );
+          var idstr : String;
+          begin(*ident*)
+            done := act_char in letters;   if not done then exit;
+            idstr := act_char;
+            get_char;
+            while act_char in alphanums do
+              begin
+                idstr := idstr+act_char;
+                get_char;
+              end;
+            add_start_state(idstr);
+          end(*ident*);
+        begin(*start_state_list*)
+          ident(done);                     if not done then exit;
+          while act_char=',' do
+            begin
+              get_char;
+              ident(done);                 if not done then exit;
+            end;
+        end(*start_state_list*);
+      begin(*start_state_prefix*)
+        n_st := 0;
+        if act_char='<' then
+          begin
+            get_char;
+            start_state_list(done);        if not done then exit;
+            if act_char='>' then
+              begin
+                done := true;
+                get_char;
+              end
+            else
+              done := false
+          end
+        else
+          done := true
+      end(*start_state_prefix*);
+    procedure caret( var done : Boolean );
+      begin(*caret*)
+        done := true;
+        cf   := act_char='^';
+        if act_char='^' then get_char;
+      end(*caret*);
+
+  procedure scan_char ( var done : Boolean; var c : Char );
+    var
+      oct_val : Byte;
+      count : Integer;
+    begin
+      done := true;
+      if act_char='\' then
+        begin
+          get_char;
+          case act_char of
+            #0  : done := false;
+            'n' : begin
+                    c := nl;
+                    get_char
+                  end;
+            'r' : begin
+                    c := cr;
+                    get_char
+                  end;
+            't' : begin
+                    c := tab;
+                    get_char
+                  end;
+            'b' : begin
+                    c := bs;
+                    get_char
+                  end;
+            'f' : begin
+                    c := ff;
+                    get_char
+                  end;
+            '0'..'7' : begin
+                         oct_val := ord(act_char)-ord('0');
+                         get_char;
+                         count := 1;
+                         while ('0'<=act_char) and
+                           (act_char<='7') and
+                           (count<3) do
+                           begin
+                             inc(count);
+                             oct_val := oct_val*8+ord(act_char)-ord('0');
+                             get_char
+                           end;
+                         c := chr(oct_val);
+                       end
+            else  begin
+                    c := act_char;
+                    get_char
+                  end
+          end
+        end
+      else
+        begin
+          c := act_char;
+          get_char
+        end
+    end(*scan_char*);
+  procedure scan_str ( var done : Boolean; var str : String );
+    var c : Char;
+    begin
+      str := '';
+      get_char;
+      while (act_char<>#0) and (act_char<>'"') do
+        begin
+          scan_char(done, c);        if not done then exit;
+          str := str+c;
+        end;
+      if act_char=#0 then
+        done := false
+      else
+        begin
+          get_char;
+          done := true;
+        end
+    end(*scan_str*);
+  procedure scan_cclass( var done : Boolean; var cc : CClass );
+    (* scan a character class *)
+    var
+      caret : boolean;
+      c, c1,cl : Char;
+    begin
+      cc := [];
+      get_char;
+      if act_char='^' then
+        begin
+          caret := true;
+          get_char;
+        end
+      else
+        caret := false;
+      while (act_char<>#0) and (act_char<>']') do
+        begin
+          scan_char(done, c);              if not done then exit;
+          if act_char='-' then
+            begin
+              get_char;
+              if (act_char<>#0) and (act_char<>']') then
+                begin
+                  scan_char(done, c1);     if not done then exit;
+                  for cl:=c to c1 do
+                    cc:=cc+[cl];
+                   {cc := cc+[c..c1];}
+                end
+              else
+                cc := cc+[c,'-'];
+            end
+          else
+            cc := cc+[c];
+        end;
+      if act_char=#0 then
+        done := false
+      else
+        begin
+          get_char;
+          done := true;
+        end;
+      if caret then cc := [#1..#255]-cc;
+    end(*scan_cclass*);
+  procedure scan_num( var done : Boolean; var n : Integer );
+    var str : String;
+    begin
+      if act_char in digits then
+        begin
+          str := act_char;
+          get_char;
+          while act_char in digits do
+            begin
+              str := str+act_char;
+              get_char;
+            end;
+          done := isInt(str, n);
+        end
+      else
+        done := false
+    end(*scan_num*);
+
+    procedure DoExpr ( var done : Boolean; var r : RegExpr );
+      procedure term ( var done : Boolean; var r : RegExpr );
+        procedure factor ( var done : Boolean; var r : RegExpr );
+          var str  : String;
+              cc   : CClass;
+              c    : Char;
+              n, m : Integer;
+          begin(*factor*)
+            case act_char of
+              '"' : begin
+                      scan_str(done, str);         if not done then exit;
+                      r := strExpr(newStr(str));
+                    end;
+              '[' : begin
+                      scan_cclass(done, cc);       if not done then exit;
+                      r := cclassExpr(newCClass(cc));
+                    end;
+              '.' : begin
+                      get_char;
+                      r := cclassExpr(newCClass([#1..#255]-[nl]));
+                      done := true;
+                    end;
+              '(' : begin
+                      get_char;
+                      DoExpr(done, r);               if not done then exit;
+                      if act_char=')' then
+                        begin
+                          get_char;
+                          done := true;
+                        end
+                      else
+                        done := false
+                    end;
+              else  begin
+                      scan_char(done, c);          if not done then exit;
+                      r := charExpr(c);
+                    end;
+            end;
+            while done and (act_char in ['*','+','?','{']) do
+              case act_char of
+                '*' : begin
+                        get_char;
+                        r := starExpr(r);
+                      end;
+                '+' : begin
+                        get_char;
+                        r := plusExpr(r);
+                      end;
+                '?' : begin
+                        get_char;
+                        r := optExpr(r);
+                      end;
+                '{' : begin
+                        get_char;
+                        scan_num(done, m);         if not done then exit;
+                        if act_char=',' then
+                          begin
+                            get_char;
+                            scan_num(done, n);     if not done then exit;
+                            r := mnExpr(r, m, n);
+                          end
+                        else
+                          r := mnExpr(r, m, m);
+                        if act_char='}' then
+                          begin
+                            get_char;
+                            done := true;
+                          end
+                        else
+                          done := false
+                      end;
+              end
+          end(*factor*);
+        const term_delim : CClass = [#0,' ',tab,'$','|',')','/'];
+        var r1 : RegExpr;
+        begin(*term*)
+          if not (act_char in term_delim) then
+            begin
+              factor(done, r);             if not done then exit;
+              while not (act_char in term_delim) do
+                begin
+                  factor(done, r1);        if not done then exit;
+                  r := catExpr(r, r1);
+                end
+            end
+          else
+            begin
+              r := epsExpr;
+              done := true;
+            end
+        end(*term*);
+      var r1 : RegExpr;
+      begin(*expr*)
+        term(done, r);                     if not done then exit;
+        while act_char='|' do
+          begin
+            get_char;
+            term(done, r1);                if not done then exit;
+            r := altExpr(r, r1);
+          end
+      end(*expr*);
+
+    var r1, r2 : RegExpr;
+
+    begin(*rule*)
+      start_state_prefix(done);            if not done then exit;
+      caret(done);                         if not done then exit;
+      DoExpr(done, r1);                      if not done then exit;
+      if act_char='$' then
+        begin
+          r := catExpr(catExpr(r1,
+                 markExpr(rule_no, 1)),
+                 cclassExpr(newCClass([nl])));
+          get_char;
+        end
+      else if act_char='/' then
+        begin
+          get_char;
+          DoExpr(done, r2);                  if not done then exit;
+          r := catExpr(catExpr(r1,
+                 markExpr(rule_no, 1)), r2);
+        end
+      else
+        r := catExpr(r1, markExpr(rule_no, 1));
+      r := catExpr(r, markExpr(rule_no, 0));
+      done := (act_char=#0) or (act_char=' ') or (act_char=tab);
+    end(*rule*);
+
+  var done : Boolean;
+
+  begin(*parse_rule*)
+    init_scanner;
+    rule(done);
+    if done then
+      begin
+        expr := copy(line, 1, act_pos-1);
+        stmt := copy(line, act_pos, length(line));
+      end
+    else
+      mark_error(syntax_error, 0)
+  end(*parse_rule*);
+
+end(*LexRules*).

utils/tply/lextable.pas

@@ -0,0 +1,484 @@
+{
+  This module collects the various tables used by the Lex program:
+  - the symbol table
+  - the position table
+  - the DFA states and transition tables
+  Note: All tables are allocated dynamically (at initialization time)
+  because of the 64KB static data limit.
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-08-01 10:23 $
+
+$History: LEXTABLE.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+}
+
+
+unit LexTable;
+
+interface
+
+uses LexBase;
+
+
+{$IFNDEF Win32}
+var max_bytes : LongInt;
+  (* available memory *)
+
+function n_bytes : LongInt;
+  (* memory actually used *)
+{$ENDIF}
+
+const
+
+(* Maximum table sizes: *)
+
+max_keys           =  997;  (* size of hash symbol table (prime number!)   *)
+{$IFDEF MsDos}
+max_pos            =  600;  (* maximum number of positions                 *)
+max_states         =  300;  (* number of DFA states                        *)
+max_trans          =  600;  (* number of transitions                       *)
+max_start_states   =   50;  (* maximum number of user-defined start states *)
+{$ELSE}
+max_pos            = 1200;  (* maximum number of positions                 *)
+max_states         =  600;  (* number of DFA states                        *)
+max_trans          = 1200;  (* number of transitions                       *)
+max_start_states   =  100;  (* maximum number of user-defined start states *)
+{$ENDIF}
+
+var
+
+(* Actual table sizes: *)
+
+n_pos            : Integer;
+n_states         : Integer;
+n_trans          : Integer;
+n_start_states   : Integer;
+
+type
+
+(* Table data structures: *)
+
+SymTable = array [1..max_keys] of record
+             pname  : StrPtr;
+               (* print name; empty entries are denoted by pname=nil *)
+             case sym_type : ( none, macro_sym, start_state_sym ) of
+             macro_sym : ( subst : StrPtr );
+               (* macro substitution *)
+             start_state_sym : ( start_state : Integer );
+               (* start state *)
+           end;
+
+PosTableEntry = record
+                  follow_pos    : IntSetPtr;
+                    (* set of follow positions *)
+                  case pos_type : ( char_pos, cclass_pos, mark_pos ) of
+                  char_pos      : ( c   : Char );
+                    (* character position *)
+                  cclass_pos    : ( cc  : CClassPtr );
+                    (* character class position *)
+                  mark_pos      : ( rule, pos : Integer );
+                    (* mark position *)
+                end;
+
+PosTable = array [1..max_pos] of PosTableEntry;
+
+FirstPosTable  = array [0..2*max_start_states+1] of IntSetPtr;
+                   (* first positions for start states (even states
+                      are entered anywhere on the line, odd states only
+                      at the beginning of the line; states 0 and 1 denote
+                      default, states 2..2*n_start_states+1 user-defined
+                      start states) *)
+
+StateTableEntry = record
+                    state_pos : IntSetPtr;
+                      (* positions covered by state *)
+                    final     : Boolean;
+                      (* final state? *)
+                    trans_lo,
+                    trans_hi  : Integer;
+                      (* transitions *)
+                  end;
+
+StateTable = array [0..max_states-1] of StateTableEntry;
+
+TransTableEntry = record
+                    cc              : CClassPtr;
+                      (* characters of transition *)
+                    follow_pos      : IntSetPtr;
+                      (* follow positions (positions of next state) *)
+                    next_state      : Integer;
+                      (* next state *)
+                  end;
+
+TransTable = array [1..max_trans] of TransTableEntry;
+
+
+var
+
+verbose           : Boolean;          (* status of the verbose option *)
+optimize          : Boolean;          (* status of the optimization option *)
+
+sym_table         : ^SymTable;        (* symbol table *)
+pos_table         : ^PosTable;        (* position table *)
+first_pos_table   : ^FirstPosTable;   (* first positions table *)
+state_table       : ^StateTable;      (* DFA state table *)
+trans_table       : ^TransTable;      (* DFA transition table *)
+
+
+(* Operations: *)
+
+(* Hash symbol table:
+   The following routines are supplied to be used with the generic hash table
+   routines in LexBase. *)
+
+function lookup(k : Integer) : String;
+  (* print name of symbol no. k *)
+procedure entry(k : Integer; symbol : String);
+  (* enter symbol into table *)
+
+(* Routines to build the position table: *)
+
+procedure addCharPos(c : Char);
+procedure addCClassPos(cc : CClassPtr);
+procedure addMarkPos(rule, pos : Integer);
+  (* Positions are allocated in the order of calls to addCharPos, addCClassPos
+     and addMarkPos, starting at position 1. These routines also initialize
+     the corresponding follow sets. *)
+
+(* Routines to build the state table: *)
+
+var act_state : Integer; (* state currently considered *)
+
+function newState(POS : IntSetPtr) : Integer;
+  (* Add a new state with the given position set; initialize the state's
+     position set to POS (the offsets into the transition table are
+     initialized when the state becomes active, see startStateTrans, below).
+     Returns: the new state number *)
+
+function addState(POS : IntSetPtr) : Integer;
+  (* add a new state, but only if there is not already a state with the
+     same position set *)
+
+procedure startStateTrans;
+procedure endStateTrans;
+  (* initializes act_state's first and last offsets into the transition
+     table *)
+
+function n_state_trans(i : Integer) : Integer;
+  (* return number of transitions in state i *)
+
+procedure addTrans(cc : CClass; FOLLOW : IntSetPtr);
+  (* adds a transition to the table *)
+
+procedure mergeTrans;
+  (* sorts transitions w.r.t. next states and merges transitions for the
+     same next state in the active state *)
+
+procedure sortTrans;
+  (* sort transitions in act_state lexicographically *)
+
+implementation
+
+uses LexMsgs;
+
+{$IFNDEF Win32}
+function n_bytes : LongInt;
+  begin
+    n_bytes := max_bytes-memAvail
+  end(*n_bytes*);
+{$ENDIF}
+
+(* Hash table routines: *)
+
+function lookup(k : Integer) : String;
+  begin
+    with sym_table^[k] do
+      if pname=nil then
+        lookup := ''
+      else
+        lookup := copy(pname^, 1, length(pname^))
+  end(*lookup*);
+procedure entry(k : Integer; symbol : String);
+  begin
+    with sym_table^[k] do
+      begin
+        pname    := newStr(symbol);
+        sym_type := none;
+      end
+  end(*entry*);
+
+(* Routines to build the position table: *)
+
+procedure addCharPos(c : Char);
+  begin
+    inc(n_pos);
+    if n_pos>max_pos then fatal(pos_table_overflow);
+    pos_table^[n_pos].follow_pos     := newIntSet;
+    pos_table^[n_pos].pos_type       := char_pos;
+    pos_table^[n_pos].c              := c;
+  end(*addCharPos*);
+
+procedure addCClassPos(cc : CClassPtr);
+  begin
+    inc(n_pos);
+    if n_pos>max_pos then fatal(pos_table_overflow);
+    pos_table^[n_pos].follow_pos     := newIntSet;
+    pos_table^[n_pos].pos_type       := cclass_pos;
+    pos_table^[n_pos].cc             := cc;
+  end(*addCClassPos*);
+
+procedure addMarkPos(rule, pos : Integer);
+  begin
+    inc(n_pos);
+    if n_pos>max_pos then fatal(pos_table_overflow);
+    pos_table^[n_pos].follow_pos     := newIntSet;
+    pos_table^[n_pos].pos_type       := mark_pos;
+    pos_table^[n_pos].rule           := rule;
+    pos_table^[n_pos].pos            := pos;
+  end(*addMarkPos*);
+
+(* Routines to build the state table: *)
+
+function newState(POS : IntSetPtr) : Integer;
+  begin
+    if n_states>=max_states then fatal(state_table_overflow);
+    newState := n_states;
+    with state_table^[n_states] do
+      begin
+        state_pos := POS;
+        final     := false;
+      end;
+    inc(n_states);
+  end(*newState*);
+
+function addState(POS : IntSetPtr) : Integer;
+  var i : Integer;
+  begin
+    for i := 0 to pred(n_states) do
+      if equal(POS^, state_table^[i].state_pos^) then
+        begin
+          addState := i;
+          exit;
+        end;
+    addState := newState(POS);
+  end(*addState*);
+
+procedure startStateTrans;
+  begin
+    state_table^[act_state].trans_lo := succ(n_trans);
+  end(*startStateTrans*);
+
+procedure endStateTrans;
+  begin
+    state_table^[act_state].trans_hi := n_trans;
+  end(*endStateTrans*);
+
+function n_state_trans(i : Integer) : Integer;
+  begin
+    with state_table^[i] do
+      n_state_trans := trans_hi-trans_lo+1
+  end(*n_state_trans*);
+
+(* Construction of the transition table:
+   This implementation here uses a simple optimization which tries to avoid
+   the construction of different transitions for each individual character
+   in large character classes by MERGING transitions whenever possible. The
+   transitions, at any time, will be partitioned into transitions on disjoint
+   character classes. When adding a new transition on character class cc, we
+   repartition the transitions as follows:
+   1. If the current character class cc equals an existing one, we can
+      simply add the new follow set to the existing one.
+   2. Otherwise, for some existing transition on some character class
+      cc1 with cc*cc1<>[], we replace the existing transition by a new
+      transition on cc*cc1 with follow set = cc1's follow set + cc's follow
+      set, and, if necessary (i.e. if cc1-cc is nonempty), a transition on
+      cc1-cc with follow set = cc1's follow set. We then remove the elements
+      of cc1 from cc, and proceed again with step 1.
+   We may stop this process as soon as cc becomes empty (then all characters
+   in cc have been distributed among the existing partitions). If cc does
+   NOT become empty, we have to construct a new transition for the remaining
+   character class (which then will be disjoint from all other character
+   classes in the transition table). *)
+
+procedure addTrans(cc : CClass; FOLLOW : IntSetPtr);
+  var
+    i : Integer;
+    cc0, cc1, cc2 : CClass;
+  begin
+    for i := state_table^[act_state].trans_lo to n_trans do
+      if trans_table^[i].cc^=cc then
+        begin
+          setunion(trans_table^[i].follow_pos^, FOLLOW^);
+          exit
+        end
+      else
+        begin
+          cc0 := cc*trans_table^[i].cc^;
+          if cc0<>[] then
+            begin
+              cc1 := trans_table^[i].cc^-cc;
+              cc2 := cc-trans_table^[i].cc^;
+              if cc1<>[] then
+                begin
+                  trans_table^[i].cc^ := cc1;
+                  inc(n_trans);
+                  if n_trans>max_trans then fatal(trans_table_overflow);
+                  trans_table^[n_trans].cc := newCClass(cc0);
+                  trans_table^[n_trans].follow_pos := newIntSet;
+                  trans_table^[n_trans].follow_pos^ :=
+                    trans_table^[i].follow_pos^;
+                  setunion(trans_table^[n_trans].follow_pos^, FOLLOW^);
+                end
+              else
+                begin
+                  trans_table^[i].cc^ := cc0;
+                  setunion(trans_table^[i].follow_pos^, FOLLOW^);
+                end;
+              cc := cc2;
+              if cc=[] then exit;
+            end
+        end;
+    inc(n_trans);
+    if n_trans>max_trans then fatal(trans_table_overflow);
+    trans_table^[n_trans].cc          := newCClass(cc);
+    trans_table^[n_trans].follow_pos  := newIntSet;
+    trans_table^[n_trans].follow_pos^ := FOLLOW^;
+  end(*addCharTrans*);
+
+(* comparison and swap procedures for sorting transitions: *)
+function transLessNextState(i, j : Integer) : Boolean;{$ifndef fpc}far;{$endif}
+  (* compare transitions based on next states (used in mergeCharTrans) *)
+  begin
+    transLessNextState := trans_table^[i].next_state<
+                          trans_table^[j].next_state
+  end(*transLessNextState*);
+function transLess(i, j : Integer) : Boolean;{$ifndef fpc}far;{$endif}
+  (* lexical order on transitions *)
+  var c : Char; xi, xj : Boolean;
+  begin
+    for c := #0 to #255 do
+      begin
+        xi := c in trans_table^[i].cc^;
+        xj := c in trans_table^[j].cc^;
+        if xi<>xj then
+          begin
+            transLess := ord(xi)>ord(xj);
+            exit
+          end;
+      end;
+    transLess := false
+  end(*transLess*);
+procedure transSwap(i, j : Integer);{$ifndef fpc}far;{$endif}
+  (* swap transitions i and j *)
+  var x : TransTableEntry;
+  begin
+    x := trans_table^[i];
+    trans_table^[i] := trans_table^[j];
+    trans_table^[j] := x;
+  end(*transSwap*);
+
+procedure mergeTrans;
+  var
+    i, j, n_deleted : Integer;
+  begin
+    (* sort transitions w.r.t. next states: *)
+    quicksort(state_table^[act_state].trans_lo,
+              n_trans,
+              {$ifdef fpc}@{$endif}transLessNextState,
+              {$ifdef fpc}@{$endif}transSwap);
+    (* merge transitions for the same next state: *)
+    n_deleted := 0;
+    for i := state_table^[act_state].trans_lo to n_trans do
+    if trans_table^[i].cc<>nil then
+      begin
+        j := succ(i);
+        while (j<=n_trans) and
+              (trans_table^[i].next_state =
+               trans_table^[j].next_state) do
+          begin
+            (* merge cclasses of transitions i and j, then mark
+               transition j as deleted *)
+            trans_table^[i].cc^ := trans_table^[i].cc^+
+                                   trans_table^[j].cc^;
+            trans_table^[j].cc  := nil;
+            inc(n_deleted);
+            inc(j);
+          end;
+      end;
+    (* remove deleted transitions: *)
+    j := state_table^[act_state].trans_lo;
+    for i := state_table^[act_state].trans_lo to n_trans do
+      if trans_table^[i].cc<>nil then
+        if i<>j then
+          begin
+            trans_table^[j] := trans_table^[i];
+            inc(j);
+          end
+        else
+          inc(j);
+    (* update transition count: *)
+    dec(n_trans, n_deleted);
+  end(*mergeTrans*);
+
+procedure sortTrans;
+  begin
+    quicksort(state_table^[act_state].trans_lo,
+              n_trans,
+              {$ifdef fpc}@{$endif}transLess,
+              {$ifdef fpc}@{$endif}transSwap);
+  end(*sortTrans*);
+
+var i : Integer;
+
+begin
+
+  verbose          := false;
+  optimize         := false;
+
+{$IFNDEF Win32}
+  max_bytes        := memAvail;
+{$ENDIF}
+
+  n_pos            := 0;
+  n_states         := 0;
+  n_trans          := 0;
+  n_start_states   := 0;
+
+  (* allocate tables: *)
+
+  new(sym_table);
+  new(pos_table);
+  new(first_pos_table);
+  new(state_table);
+  new(trans_table);
+
+  (* initialize symbol table: *)
+
+  for i := 1 to max_keys do sym_table^[i].pname := nil;
+
+end(*LexTables*).

utils/tply/plex.pas

@@ -0,0 +1,745 @@
+{
+  TP Lex - A lexical analyzer generator for Turbo Pascal
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-08-01 10:22 $
+
+$History: LEX.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+
+------------------------- Synopsis ------------------------
+
+   Synopsis   lex [options] lex-file[.l] [output-file[.pas]]
+
+   Options
+
+   -v  "Verbose:" Lex generates a readable description of the generated
+       lexical analyzer, written to lex-file with new extension .LST.
+
+   -o  "Optimize:" Lex optimizes DFA tables to produce a minimal DFA
+
+   Description
+
+   This is a reimplementation of the popular UNIX lexical analyzer generator
+   Lex for MS-DOS and Turbo Pascal.
+
+   Differences from UNIX Lex:
+
+   - Produces output code for Turbo Pascal, rather than for C.
+
+   - Character tables (%T) are not supported; neither are any directives
+     to determine internal table sizes (%p, %n, etc.).
+
+------------------------- Synopsis ------------------------
+
+}
+
+{$IFDEF MsDos}
+{$M 16384,0,655360}
+{$ENDIF}
+{$IFDEF DPMI}
+{$M 32768}
+{$ENDIF}
+{$IFDEF Windows}
+{$M 32768,0}
+{$ENDIF}
+
+{$I-}
+program Lex;
+
+uses
+{$IFDEF Windows}
+  WinCrt,
+{$ENDIF}
+  LexBase, LexTable, LexPos, LexDFA, LexOpt, LexList, LexRules, LexMsgs;
+
+
+procedure get_line;
+  (* obtain line from source file *)
+  begin
+    readln(yyin, line);
+    inc(lno);
+  end(*get_line*);
+
+procedure next_section;
+  (* find next section mark (%%) in code template *)
+  var line : String;
+  begin
+    while not eof(yycod) do
+      begin
+        readln(yycod, line);
+        if line='%%' then exit;
+        writeln(yyout, line);
+      end;
+  end(*next_section*);
+
+(* Semantic routines: *)
+
+var n_rules : Integer; (* current number of rules *)
+
+procedure define_start_state ( symbol : String; pos : Integer );
+  (* process start state definition *)
+  begin
+{$ifdef fpc}
+    with sym_table^[key(symbol, max_keys, @lookup, @entry)] do
+{$else}
+    with sym_table^[key(symbol, max_keys, lookup, entry)] do
+{$endif}
+      if sym_type=none then
+        begin
+          inc(n_start_states);
+          if n_start_states>max_start_states then
+            fatal(state_table_overflow);
+          sym_type    := start_state_sym;
+          start_state := n_start_states;
+          writeln(yyout, 'const ', symbol, ' = ', 2*start_state, ';');
+          first_pos_table^[2*start_state] := newIntSet;
+          first_pos_table^[2*start_state+1] := newIntSet;
+        end
+      else
+        error(symbol_already_defined, pos)
+  end(*define_start_state*);
+
+procedure define_macro ( symbol, replacement : String );
+  (* process macro definition *)
+  begin
+{$ifdef fpc}
+    with sym_table^[key('{'+symbol+'}', max_keys, @lookup, @entry)] do
+{$else}
+    with sym_table^[key('{'+symbol+'}', max_keys, lookup, entry)] do
+{$endif}
+      if sym_type=none then
+        begin
+          sym_type := macro_sym;
+          subst    := newStr(replacement);
+        end
+      else
+        error(symbol_already_defined, 1)
+  end(*define_macro*);
+
+procedure add_rule;
+  (* process rule *)
+  var i : Integer;
+      FIRST : IntSet;
+  begin
+    addExpr(r, FIRST);
+    if n_st=0 then
+      if cf then
+        setunion(first_pos_table^[1]^, FIRST)
+      else
+        begin
+          setunion(first_pos_table^[0]^, FIRST);
+          setunion(first_pos_table^[1]^, FIRST);
+        end
+    else
+      if cf then
+        for i := 1 to n_st do
+          setunion(first_pos_table^[2*st[i]+1]^, FIRST)
+      else
+        for i := 1 to n_st do
+          begin
+            setunion(first_pos_table^[2*st[i]]^, FIRST);
+            setunion(first_pos_table^[2*st[i]+1]^, FIRST);
+          end
+  end(*add_rule*);
+
+procedure generate_table;
+
+  (* write the DFA table to the output file
+
+     Tables are represented as a collection of typed array constants:
+
+     type YYTRec = record
+                     cc : set of Char; { characters }
+                     s  : Integer;     { next state }
+                   end;
+
+     const
+
+     { table sizes: }
+
+     yynmarks   = ...;
+     yynmatches = ...;
+     yyntrans   = ...;
+     yynstates  = ...;
+
+     { rules of mark positions for each state: }
+
+     yyk : array [1..yynmarks] of Integer = ...;
+
+     { rules of matches for each state: }
+
+     yym : array [1..yynmatches] of Integer = ...;
+
+     { transition table: }
+
+     yyt : array [1..yyntrans] of YYTRec = ...;
+
+     { offsets into the marks, matches and transition tables: }
+
+     yykl, yykh,
+     yyml, yymh,
+     yytl, yyth : array [0..yynstates-1] of Integer = ...;
+
+  *)
+
+  var yynmarks, yynmatches, yyntrans, yynstates : Integer;
+      yykl, yykh,
+      yyml, yymh,
+      yytl, yyth : array [0..max_states-1] of Integer;
+
+  procedure counters;
+    (* compute counters and offsets *)
+    var s, i : Integer;
+    begin
+      yynstates := n_states; yyntrans   := n_trans;
+      yynmarks  := 0;        yynmatches := 0;
+      for s := 0 to n_states-1 do with state_table^[s] do
+        begin
+          yytl[s] := trans_lo;   yyth[s] := trans_hi;
+          yykl[s] := yynmarks+1; yyml[s] := yynmatches+1;
+          for i := 1 to size(state_pos^) do
+            with pos_table^[state_pos^[i]] do
+              if pos_type=mark_pos then
+                if pos=0 then
+                  inc(yynmatches)
+                else if pos=1 then
+                  inc(yynmarks);
+          yykh[s] := yynmarks; yymh[s] := yynmatches;
+        end;
+    end(*counters*);
+
+  procedure writecc(var f : Text; cc : CClass);
+    (* print the given character class *)
+    function charStr(c : Char) : String;
+      begin
+        case c of
+          #0..#31,     (* nonprintable characters *)
+          #127..#255 : charStr := '#'+intStr(ord(c));
+          ''''       : charStr := '''''''''';
+          else         charStr := ''''+c+'''';
+        end;
+      end(*charStr*);
+    const
+      MaxChar = #255;
+    var
+      c1, c2 : Char;
+      col : Integer;
+      tag : String;
+      Quit: Boolean;
+    begin
+      write(f, '[ ');
+      col := 0;
+      c1 := chr(0);
+      Quit := False;
+      while not Quit do begin
+        if c1 in cc then  begin
+          if col>0 then
+            begin
+              write(f, ',');
+              inc(col);
+            end;
+          if col>40 then
+            { insert line break }
+            begin
+              writeln(f);
+              write(f, ' ':12);
+              col := 0;
+            end;
+          c2 := c1;
+          while (c2<MaxChar) and (succ(c2) in cc) do
+            c2 := succ(c2);
+          if c1=c2 then
+            tag := charStr(c1)
+          else if c2=succ(c1) then
+            tag := charStr(c1)+','+charStr(c2)
+          else
+            tag := charStr(c1)+'..'+charStr(c2);
+          write(f, tag);
+          col := col + length(tag);
+          c1 := c2;
+        end;
+        Quit := c1 = MaxChar;
+        if not Quit then
+          c1 := Succ(c1);
+      end; { of while }
+      write(f, ' ]');
+    end(*writecc*);
+
+  procedure tables;
+    (* print tables *)
+    var s, i, count : Integer;
+    begin
+      writeln(yyout);
+      writeln(yyout, 'type YYTRec = record');
+      writeln(yyout, '                cc : set of Char;');
+      writeln(yyout, '                s  : Integer;');
+      writeln(yyout, '              end;');
+      writeln(yyout);
+      writeln(yyout, 'const');
+      (* table sizes: *)
+      writeln(yyout);
+      writeln(yyout, 'yynmarks   = ', yynmarks, ';');
+      writeln(yyout, 'yynmatches = ', yynmatches, ';');
+      writeln(yyout, 'yyntrans   = ', yyntrans, ';');
+      writeln(yyout, 'yynstates  = ', yynstates, ';');
+      (* mark table: *)
+      writeln(yyout);
+      writeln(yyout, 'yyk : array [1..yynmarks] of Integer = (');
+      count := 0;
+      for s := 0 to n_states-1 do with state_table^[s] do
+        begin
+          writeln(yyout, '  { ', s, ': }');
+          for i := 1 to size(state_pos^) do
+            with pos_table^[state_pos^[i]] do
+              if (pos_type=mark_pos) and (pos=1) then
+                begin
+                  write(yyout, '  ', rule); inc(count);
+                  if count<yynmarks then write(yyout, ',');
+                  writeln(yyout);
+                end;
+        end;
+      writeln(yyout, ');');
+      (* match table: *)
+      writeln(yyout);
+      writeln(yyout, 'yym : array [1..yynmatches] of Integer = (');
+      count := 0;
+      for s := 0 to n_states-1 do with state_table^[s] do
+        begin
+          writeln(yyout, '{ ', s, ': }');
+          for i := 1 to size(state_pos^) do
+            with pos_table^[state_pos^[i]] do
+              if (pos_type=mark_pos) and (pos=0) then
+                begin
+                  write(yyout, '  ', rule); inc(count);
+                  if count<yynmatches then write(yyout, ',');
+                  writeln(yyout);
+                end;
+        end;
+      writeln(yyout, ');');
+      (* transition table: *)
+      writeln(yyout);
+      writeln(yyout, 'yyt : array [1..yyntrans] of YYTrec = (');
+      count := 0;
+      for s := 0 to n_states-1 do with state_table^[s] do
+        begin
+          writeln(yyout, '{ ', s, ': }');
+          for i := trans_lo to trans_hi do
+            with trans_table^[i] do
+              begin
+                write(yyout, '  ( cc: ');
+                writecc(yyout, cc^);
+                write(yyout, '; s: ');
+                write(yyout, next_state, ')');
+                inc(count);
+                if count<yyntrans then write(yyout, ',');
+                writeln(yyout);
+              end;
+        end;
+      writeln(yyout, ');');
+      (* offset tables: *)
+      writeln(yyout);
+      writeln(yyout, 'yykl : array [0..yynstates-1] of Integer = (');
+      for s := 0 to n_states-1 do
+        begin
+          write(yyout, '{ ', s, ': } ', yykl[s]);
+          if s<n_states-1 then write(yyout, ',');
+          writeln(yyout);
+        end;
+      writeln(yyout, ');');
+      writeln(yyout);
+      writeln(yyout, 'yykh : array [0..yynstates-1] of Integer = (');
+      for s := 0 to n_states-1 do
+        begin
+          write(yyout, '{ ', s, ': } ', yykh[s]);
+          if s<n_states-1 then write(yyout, ',');
+          writeln(yyout);
+        end;
+      writeln(yyout, ');');
+      writeln(yyout);
+      writeln(yyout, 'yyml : array [0..yynstates-1] of Integer = (');
+      for s := 0 to n_states-1 do
+        begin
+          write(yyout, '{ ', s, ': } ', yyml[s]);
+          if s<n_states-1 then write(yyout, ',');
+          writeln(yyout);
+        end;
+      writeln(yyout, ');');
+      writeln(yyout);
+      writeln(yyout, 'yymh : array [0..yynstates-1] of Integer = (');
+      for s := 0 to n_states-1 do
+        begin
+          write(yyout, '{ ', s, ': } ', yymh[s]);
+          if s<n_states-1 then write(yyout, ',');
+          writeln(yyout);
+        end;
+      writeln(yyout, ');');
+      writeln(yyout);
+      writeln(yyout, 'yytl : array [0..yynstates-1] of Integer = (');
+      for s := 0 to n_states-1 do
+        begin
+          write(yyout, '{ ', s, ': } ', yytl[s]);
+          if s<n_states-1 then write(yyout, ',');
+          writeln(yyout);
+        end;
+      writeln(yyout, ');');
+      writeln(yyout);
+      writeln(yyout, 'yyth : array [0..yynstates-1] of Integer = (');
+      for s := 0 to n_states-1 do
+        begin
+          write(yyout, '{ ', s, ': } ', yyth[s]);
+          if s<n_states-1 then write(yyout, ',');
+          writeln(yyout);
+        end;
+      writeln(yyout, ');');
+      writeln(yyout);
+    end(*tables*);
+
+  begin
+    counters; tables;
+  end(*generate_table*);
+
+(* Parser: *)
+
+const
+
+max_items = 255;
+
+var
+
+itemstr : String;
+itemc   : Integer;
+itempos,
+itemlen : array [1..max_items] of Integer;
+
+procedure split ( str : String; count : Integer );
+  (* split str into at most count whitespace-delimited items
+     (result in itemstr, itemc, itempos, itemlen) *)
+  procedure scan(var act_pos : Integer);
+    (* scan one item *)
+    var l : Integer;
+    begin
+      while (act_pos<=length(itemstr)) and
+            ((itemstr[act_pos]=' ') or (itemstr[act_pos]=tab)) do
+        inc(act_pos);
+      l := 0;
+      while (act_pos+l<=length(itemstr)) and
+            (itemstr[act_pos+l]<>' ') and (itemstr[act_pos+l]<>tab) do
+        inc(l);
+      inc(itemc);
+      itempos[itemc] := act_pos;
+      itemlen[itemc] := l;
+      inc(act_pos, l+1);
+      while (act_pos<=length(itemstr)) and
+            ((itemstr[act_pos]=' ') or (itemstr[act_pos]=tab)) do
+        inc(act_pos);
+    end(*scan*);
+  var act_pos : Integer;
+  begin
+    itemstr := str; act_pos := 1;
+    itemc := 0;
+    while (itemc<count-1) and (act_pos<=length(itemstr)) do scan(act_pos);
+    if act_pos<=length(itemstr) then
+      begin
+        inc(itemc);
+        itempos[itemc] := act_pos;
+        itemlen[itemc] := length(itemstr)-act_pos+1;
+      end;
+  end(*split*);
+
+function itemv ( i : Integer ) : String;
+  (* return ith item in splitted string (whole string for i=0) *)
+  begin
+    if i=0 then
+      itemv := itemstr
+    else if (i<0) or (i>itemc) then
+      itemv := ''
+    else
+      itemv := copy(itemstr, itempos[i], itemlen[i])
+  end(*itemv*);
+
+procedure code;
+  begin
+    while not eof(yyin) do
+      begin
+        get_line;
+        if line='%}' then
+          exit
+        else
+          writeln(yyout, line);
+      end;
+    error(unmatched_lbrace, length(line)+1);
+  end(*code*);
+
+procedure definitions;
+  procedure definition;
+    function check_id ( symbol : String ) : Boolean;
+      var i : Integer;
+      begin
+        if (symbol='') or not (symbol[1] in letters) then
+          check_id := false
+        else
+          begin
+            for i := 2 to length(symbol) do
+              if not (symbol[i] in alphanums) then
+                begin
+                  check_id := false;
+                  exit;
+                end;
+            check_id := true
+          end
+      end(*check_id*);
+    var i : Integer;
+        com : String;
+    begin
+      split(line, 2);
+      com := upper(itemv(1));
+      if (com='%S') or (com='%START') then
+        begin
+          split(line, max_items);
+          for i := 2 to itemc do
+            if check_id(itemv(i)) then
+              define_start_state(itemv(i), itempos[i])
+            else
+              error(syntax_error, itempos[i]);
+        end
+      else if check_id(itemv(1)) then
+        define_macro(itemv(1), itemv(2))
+      else
+        error(syntax_error, 1);
+    end(*definition*);
+  begin
+    while not eof(yyin) do
+      begin
+        get_line;
+        if line='' then
+          writeln(yyout)
+        else if line='%%' then
+          exit
+        else if line='%{' then
+          code
+        else if (line[1]='%') or (line[1] in letters) then
+          definition
+        else
+          writeln(yyout, line)
+      end;
+  end(*definitions*);
+
+procedure rules;
+  begin
+    next_section;
+    if line='%%' then
+      while not eof(yyin) do
+        begin
+          get_line;
+          if line='' then
+            writeln(yyout)
+          else if line='%%' then
+            begin
+              next_section;
+              exit;
+            end
+          else if line='%{' then
+            code
+          else if (line[1]<>' ') and (line[1]<>tab) then
+            begin
+              if n_rules=0 then next_section;
+              inc(n_rules);
+              parse_rule(n_rules);
+              if errors=0 then
+                begin
+                  add_rule;
+                  write(yyout, '  ', n_rules);
+                  if strip(stmt)='|' then
+                    writeln(yyout, ',')
+                  else
+                    begin
+                      writeln(yyout, ':');
+                      writeln(yyout, blankStr(expr), stmt);
+                    end;
+                end
+            end
+          else
+            writeln(yyout, line)
+        end
+    else
+      error(unexpected_eof, length(line)+1);
+    next_section;
+  end(*rules*);
+
+procedure auxiliary_procs;
+  begin
+    if line='%%' then
+      begin
+        writeln(yyout);
+        while not eof(yyin) do
+          begin
+            get_line;
+            writeln(yyout, line);
+          end;
+      end;
+  end(*auxiliary_procs*);
+
+(* Main program: *)
+
+var i : Integer;
+
+begin
+{$ifdef linux}
+  codfilepath:='/usr/lib/fpc/lexyacc/';
+{$else}
+  codfilepath:=path(paramstr(0));
+{$endif}
+
+  (* sign-on: *)
+
+  writeln(sign_on);
+
+  (* parse command line: *)
+
+  if paramCount=0 then
+    begin
+      writeln(usage);
+      writeln(options);
+      halt(0);
+    end;
+
+  lfilename := '';
+  pasfilename := '';
+
+  for i := 1 to paramCount do
+    if copy(paramStr(i), 1, 1)='-' then
+      if upper(paramStr(i))='-V' then
+        verbose := true
+      else if upper(paramStr(i))='-O' then
+        optimize := true
+      else
+        begin
+          writeln(invalid_option, paramStr(i));
+          halt(1);
+        end
+    else if lfilename='' then
+      lfilename := addExt(paramStr(i), 'l')
+    else if pasfilename='' then
+      pasfilename := addExt(paramStr(i), 'pas')
+    else
+      begin
+        writeln(illegal_no_args);
+        halt(1);
+      end;
+
+  if lfilename='' then
+    begin
+      writeln(illegal_no_args);
+      halt(1);
+    end;
+
+  if pasfilename='' then pasfilename := root(lfilename)+'.pas';
+  lstfilename := root(lfilename)+'.lst';
+
+  (* open files: *)
+
+  assign(yyin, lfilename);
+  assign(yyout, pasfilename);
+  assign(yylst, lstfilename);
+
+  reset(yyin);    if ioresult<>0 then fatal(cannot_open_file+lfilename);
+  rewrite(yyout); if ioresult<>0 then fatal(cannot_open_file+pasfilename);
+  rewrite(yylst); if ioresult<>0 then fatal(cannot_open_file+lstfilename);
+
+  (* search code template in current directory, then on path where Lex
+     was executed from: *)
+  codfilename := 'yylex.cod';
+  assign(yycod, codfilename);
+  reset(yycod);
+  if ioresult<>0 then
+    begin
+      codfilename := codfilepath+'yylex.cod';
+      assign(yycod, codfilename);
+      reset(yycod);
+      if ioresult<>0 then fatal(cannot_open_file+codfilename);
+    end;
+
+  (* parse source grammar: *)
+
+  write('parse ... ');
+  lno := 0; n_rules := 0; next_section;
+  first_pos_table^[0] := newIntSet;
+  first_pos_table^[1] := newIntSet;
+  definitions;
+  rules;
+  if n_rules=0 then error(empty_grammar, length(line)+1);
+  if errors=0 then
+    begin
+      (* generate DFA table and listings and write output code: *)
+      write('DFA construction ... ');
+      makeDFATable;
+      if optimize then
+        begin
+          write('DFA optimization ... ');
+          optimizeDFATable;
+        end;
+      write('code generation ... ');
+      if verbose then listDFATable;
+      generate_table; next_section;
+    end;
+  auxiliary_procs;
+  if errors=0 then writeln('DONE');
+
+  (* close files: *)
+
+  close(yyin); close(yyout); close(yylst); close(yycod);
+
+  (* print statistics: *)
+
+  if errors>0 then
+    writeln( lno, ' lines, ',
+             errors, ' errors found.' )
+  else
+    writeln( lno, ' lines, ',
+             n_rules, ' rules, ',
+             n_pos, '/', max_pos, ' p, ',
+             n_states, '/', max_states, ' s, ',
+             n_trans, '/', max_trans, ' t.');
+
+  if warnings>0 then writeln(warnings, ' warnings.');
+
+{$IFNDEF Win32}
+  writeln( n_bytes, '/', max_bytes, ' bytes of memory used.');
+{$ENDIF}
+
+  (* terminate: *)
+
+  if errors>0 then erase(yyout);
+  if file_size(lstfilename)=0 then
+    erase(yylst)
+  else
+    writeln('(see ', lstfilename, ' for more information)');
+
+  halt(errors);
+
+end(*Lex*).

utils/tply/pyacc.pas

@@ -0,0 +1,2530 @@
+
+(* Yacc parser template (TP Yacc V3.0), V1.2 6-17-91 AG *)
+
+(* global definitions: *)
+
+(*
+
+  TP Yacc - Yet Another Compiler Compiler for Turbo Pascal
+
+  Copyright (C) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-08-01 11:24 $
+
+
+Last changes:
+
+  Version 3.0 as of April 91
+  Version 3.0a as of May 92 (bug fixes in precedence and type information
+    updates)
+
+$History: YACC.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+
+
+------------------------- Synopsis ------------------------
+
+   Synopsis   yacc [options] yacc-file[.y] [output-file[.pas]]
+
+   Options
+
+   -v  "Verbose:" Yacc generates a readable description of the generated
+       parser, written to yacc-file with new extension .lst.
+
+   -d  "Debug:" Yacc generates parser with debugging output.
+
+   Description
+
+   This is a reimplementation of the popular UNIX compiler generator
+   Yacc for MS-DOS and Turbo Pascal.
+
+   Differences from UNIX Yacc:
+
+   - Produces output code for Turbo Pascal, rather than for C.
+
+   - Does not support %union definitions. Instead, a value type is declared
+     by specifying the type identifier *itself* as the tag of a %token
+     or %type definition. Yacc will automatically generate an appropriate
+     yylval variable of a variant record type (YYSType) which is capable of
+     holding values of any of the types used in %token and %type.
+
+     Type checking is *very* strict. If you use type definitions, then
+     any symbol referred to in an action *must* have a type introduced
+     in a type definition. Either the symbol must have been assigned a
+     type in the definitions section, or the $<type-identifier> notation
+     must be used. The syntax of the %type definition has been changed
+     slightly to allow definitions of the form
+       %type <type-identifier>
+     (omitting the nonterminals) which may be used to declare types which
+     are not assigned to any grammar symbol, but are used with the
+     $<...> construct.
+
+   - The parse tables constructed by this Yacc version are slightly greater
+     than those constructed by UNIX Yacc, since a reduce action will only be
+     chosen as the default action if it is the *only* action in the state.
+     In difference, UNIX Yacc chooses a reduce action as the default action
+     whenever it is the only *reduce* action of the state (even if there are
+     other shift actions).
+
+     This solves a bug in UNIX Yacc that makes the generated parser start
+     error recovery too late with certain types of error productions (see
+     also Schreiner/Friedman, "Introduction to compiler construction with
+     UNIX," 1985). Also, errors will be caught sooner in most cases where
+     standard Yacc would carry out an additional (default) reduction before
+     detecting the error.
+
+------------------------- Synopsis ------------------------
+
+*)
+
+{$IFDEF MsDos}
+{$M 16384,0,655360}
+{$ENDIF}
+{$IFDEF DPMI}
+{$M 32768}
+{$ENDIF}
+{$IFDEF Windows}
+{$M 32768,0}
+{$ENDIF}
+
+{$X+}
+{$I-}
+program Yacc;
+
+uses
+{$IFDEF Debug}
+{$IFDEF DPMI}
+  YaccChk,
+{$ENDIF}
+{$ENDIF}
+{$IFDEF Windows}
+{$IFNDEF Console}
+  WinCrt,
+{$ENDIF}
+{$ENDIF}
+  YaccLib, YaccBase, YaccMsgs, YaccSem, YaccTabl, YaccPars;
+
+const ID = 257;
+const C_ID = 258;
+const LITERAL = 259;
+const LITID = 260;
+const NUMBER = 261;
+const PTOKEN = 262;
+const PLEFT = 263;
+const PRIGHT = 264;
+const PNONASSOC = 265;
+const PTYPE = 266;
+const PSTART = 267;
+const PPREC = 268;
+const PP = 269;
+const LCURL = 270;
+const RCURL = 271;
+const ILLEGAL = 272;
+
+var yylval : YYSType;
+
+function yylex : Integer; forward;
+
+function yyparse : Integer;
+
+var yystate, yysp, yyn : Integer;
+    yys : array [1..yymaxdepth] of Integer;
+    yyv : array [1..yymaxdepth] of YYSType;
+    yyval : YYSType;
+
+procedure yyaction ( yyruleno : Integer );
+  (* local definitions: *)
+begin
+  (* actions: *)
+  case yyruleno of
+   1 : begin
+         yyval := yyv[yysp-0];
+       end;
+   2 : begin
+         yyval := yyv[yysp-0];
+       end;
+   3 : begin
+         yyval := yyv[yysp-0];
+       end;
+   4 : begin
+         yyval := yyv[yysp-0];
+       end;
+   5 : begin
+         yyval := yyv[yysp-0];
+       end;
+   6 : begin
+         yyerrok;
+       end;
+   7 : begin
+         yyerrok;
+       end;
+   8 : begin
+         yyerrok;
+       end;
+   9 : begin
+         yyerrok;
+       end;
+  10 : begin
+         yyerrok;
+       end;
+  11 : begin
+         yyerrok;
+       end;
+  12 : begin
+         yyval := yyv[yysp-0];
+       end;
+  13 : begin
+         yyerrok;
+       end;
+  14 : begin
+         yyval := yyv[yysp-0];
+       end;
+  15 : begin
+         yyval := yyv[yysp-0];
+       end;
+  16 : begin
+         error(rcurl_expected);
+       end;
+  17 : begin
+         yyval := yyv[yysp-0];
+       end;
+  18 : begin
+         yyerrok;
+       end;
+  19 : begin
+         yyerrok;
+       end;
+  20 : begin
+         yyerrok;
+       end;
+  21 : begin
+         yyval := yyv[yysp-0];
+       end;
+  22 : begin
+         yyval := yyv[yysp-0];
+       end;
+  23 : begin
+         error(rbrace_expected);
+       end;
+  24 : begin
+         yyval := yyv[yysp-0];
+       end;
+  25 : begin
+         yyval := yyv[yysp-0];
+       end;
+  26 : begin
+         error(rangle_expected);
+       end;
+  27 : begin
+         yyval := yyv[yysp-0];
+       end;
+  28 : begin
+         sort_types;
+         definitions;
+         next_section;
+       end;
+  29 : begin
+         next_section;
+         generate_parser;
+         next_section;
+       end;
+  30 : begin
+         yyval := yyv[yysp-5];
+       end;
+  31 : begin
+       end;
+  32 : begin
+         copy_rest_of_file;
+       end;
+  33 : begin
+       end;
+  34 : begin
+         yyerrok;
+       end;
+  35 : begin
+         error(error_in_def);
+       end;
+  36 : begin
+         startnt := ntsym(yyv[yysp-0]);
+       end;
+  37 : begin
+         error(ident_expected);
+       end;
+  38 : begin
+         copy_code;
+       end;
+  39 : begin
+         yyval := yyv[yysp-2];
+       end;
+  40 : begin
+         act_prec := 0;
+       end;
+  41 : begin
+         yyval := yyv[yysp-3];
+       end;
+  42 : begin
+         act_prec := new_prec_level(left);
+       end;
+  43 : begin
+         yyval := yyv[yysp-3];
+       end;
+  44 : begin
+         act_prec := new_prec_level(right);
+       end;
+  45 : begin
+         yyval := yyv[yysp-3];
+       end;
+  46 : begin
+         act_prec := new_prec_level(nonassoc);
+       end;
+  47 : begin
+         yyval := yyv[yysp-3];
+       end;
+  48 : begin
+         yyval := yyv[yysp-2];
+       end;
+  49 : begin
+         yyval := yyv[yysp-1];
+       end;
+  50 : begin
+         act_type := 0;
+       end;
+  51 : begin
+         act_type := yyv[yysp-1]; add_type(yyv[yysp-1]);
+       end;
+  52 : begin
+         yyval := yyv[yysp-0];
+       end;
+  53 : begin
+         yyerrok;
+       end;
+  54 : begin
+         yyerrok;
+       end;
+  55 : begin
+         error(ident_expected);
+       end;
+  56 : begin
+         error(error_in_def);
+       end;
+  57 : begin
+         error(ident_expected);
+       end;
+  58 : begin
+         if act_type<>0 then
+         sym_type^[yyv[yysp-0]] := act_type;
+         if act_prec<>0 then
+         sym_prec^[yyv[yysp-0]] := act_prec;
+       end;
+  59 : begin
+         litsym(yyv[yysp-0], 0);
+         if act_type<>0 then
+         sym_type^[litsym(yyv[yysp-0], 0)] := act_type;
+         if act_prec<>0 then
+         sym_prec^[litsym(yyv[yysp-0], 0)] := act_prec;
+       end;
+  60 : begin
+         litsym(yyv[yysp-0], 0);
+         if act_type<>0 then
+         sym_type^[litsym(yyv[yysp-0], 0)] := act_type;
+         if act_prec<>0 then
+         sym_prec^[litsym(yyv[yysp-0], 0)] := act_prec;
+       end;
+  61 : begin
+         litsym(yyv[yysp-1], 0);
+         if act_type<>0 then
+         sym_type^[litsym(yyv[yysp-1], yyv[yysp-0])] := act_type;
+         if act_prec<>0 then
+         sym_prec^[litsym(yyv[yysp-1], 0)]  := act_prec;
+       end;
+  62 : begin
+         litsym(yyv[yysp-1], 0);
+         if act_type<>0 then
+         sym_type^[litsym(yyv[yysp-1], yyv[yysp-0])] := act_type;
+         if act_prec<>0 then
+         sym_prec^[litsym(yyv[yysp-1], 0)]  := act_prec;
+       end;
+  63 : begin
+         yyval := yyv[yysp-0];
+       end;
+  64 : begin
+         yyerrok;
+       end;
+  65 : begin
+         yyerrok;
+       end;
+  66 : begin
+         error(ident_expected);
+       end;
+  67 : begin
+         error(error_in_def);
+       end;
+  68 : begin
+         error(ident_expected);
+       end;
+  69 : begin
+         if act_type<>0 then
+         sym_type^[ntsym(yyv[yysp-0])] := act_type;
+       end;
+  70 : begin
+         next_section;
+       end;
+  71 : begin
+         yyval := yyv[yysp-1];
+       end;
+  72 : begin
+         copy_code;
+       end;
+  73 : begin
+         next_section;
+       end;
+  74 : begin
+         yyval := yyv[yysp-4];
+       end;
+  75 : begin
+         yyerrok;
+       end;
+  76 : begin
+         error(error_in_rule);
+       end;
+  77 : begin
+         error(error_in_rule);
+       end;
+  78 : begin
+         start_rule(ntsym(yyv[yysp-0]));
+       end;
+  79 : begin
+         start_body;
+       end;
+  80 : begin
+         end_body;
+       end;
+  81 : begin
+         yyval := yyv[yysp-0];
+       end;
+  82 : begin
+         start_body;
+       end;
+  83 : begin
+         end_body;
+       end;
+  84 : begin
+       end;
+  85 : begin
+         add_symbol(yyv[yysp-0]); yyerrok;
+       end;
+  86 : begin
+         add_symbol(sym(yyv[yysp-0])); yyerrok;
+       end;
+  87 : begin
+         add_symbol(sym(yyv[yysp-0])); yyerrok;
+       end;
+  88 : begin
+         add_action; yyerrok;
+       end;
+  89 : begin
+         error(error_in_rule);
+       end;
+  90 : begin
+         copy_action;
+       end;
+  91 : begin
+         yyval := yyv[yysp-2];
+       end;
+  92 : begin
+         copy_single_action;
+       end;
+  93 : begin
+       end;
+  94 : begin
+         add_rule_prec(yyv[yysp-0]);
+       end;
+  95 : begin
+         yyval := yyv[yysp-3];
+       end;
+  96 : begin
+         add_rule_prec(litsym(yyv[yysp-0], 0));
+       end;
+  97 : begin
+         yyval := yyv[yysp-3];
+       end;
+  98 : begin
+         add_rule_prec(litsym(yyv[yysp-0], 0));
+       end;
+  99 : begin
+         yyval := yyv[yysp-3];
+       end;
+ 100 : begin
+         yyval := yyv[yysp-1];
+       end;
+ 101 : begin
+       end;
+ 102 : begin
+         add_action;
+       end;
+  end;
+end(*yyaction*);
+
+(* parse table: *)
+
+type YYARec = record
+                sym, act : Integer;
+              end;
+     YYRRec = record
+                len, sym : Integer;
+              end;
+
+const
+
+yynacts   = 251;
+yyngotos  = 146;
+yynstates = 128;
+yynrules  = 102;
+
+yya : array [1..yynacts] of YYARec = (
+{ 0: }
+{ 1: }
+  ( sym: 256; act: 12 ),
+  ( sym: 262; act: 13 ),
+  ( sym: 263; act: 14 ),
+  ( sym: 264; act: 15 ),
+  ( sym: 265; act: 16 ),
+  ( sym: 266; act: 17 ),
+  ( sym: 267; act: 18 ),
+  ( sym: 269; act: 19 ),
+  ( sym: 270; act: 20 ),
+{ 2: }
+  ( sym: 0; act: 0 ),
+{ 3: }
+{ 4: }
+{ 5: }
+{ 6: }
+  ( sym: 256; act: 24 ),
+  ( sym: 257; act: 25 ),
+{ 7: }
+  ( sym: 60; act: 28 ),
+  ( sym: 256; act: -50 ),
+  ( sym: 257; act: -50 ),
+  ( sym: 262; act: -50 ),
+  ( sym: 263; act: -50 ),
+  ( sym: 264; act: -50 ),
+  ( sym: 265; act: -50 ),
+  ( sym: 266; act: -50 ),
+  ( sym: 267; act: -50 ),
+  ( sym: 269; act: -50 ),
+  ( sym: 270; act: -50 ),
+{ 8: }
+{ 9: }
+{ 10: }
+{ 11: }
+{ 12: }
+{ 13: }
+{ 14: }
+{ 15: }
+{ 16: }
+{ 17: }
+{ 18: }
+{ 19: }
+{ 20: }
+{ 21: }
+  ( sym: 256; act: 34 ),
+  ( sym: 271; act: 35 ),
+{ 22: }
+  ( sym: 256; act: 39 ),
+  ( sym: 270; act: 20 ),
+  ( sym: 258; act: -70 ),
+{ 23: }
+{ 24: }
+{ 25: }
+{ 26: }
+  ( sym: 256; act: 43 ),
+  ( sym: 257; act: 25 ),
+  ( sym: 262; act: -49 ),
+  ( sym: 263; act: -49 ),
+  ( sym: 264; act: -49 ),
+  ( sym: 265; act: -49 ),
+  ( sym: 266; act: -49 ),
+  ( sym: 267; act: -49 ),
+  ( sym: 269; act: -49 ),
+  ( sym: 270; act: -49 ),
+{ 27: }
+  ( sym: 257; act: 25 ),
+{ 28: }
+{ 29: }
+  ( sym: 60; act: 28 ),
+  ( sym: 256; act: -50 ),
+  ( sym: 257; act: -50 ),
+  ( sym: 259; act: -50 ),
+  ( sym: 260; act: -50 ),
+{ 30: }
+  ( sym: 60; act: 28 ),
+  ( sym: 256; act: -50 ),
+  ( sym: 257; act: -50 ),
+  ( sym: 259; act: -50 ),
+  ( sym: 260; act: -50 ),
+{ 31: }
+  ( sym: 60; act: 28 ),
+  ( sym: 256; act: -50 ),
+  ( sym: 257; act: -50 ),
+  ( sym: 259; act: -50 ),
+  ( sym: 260; act: -50 ),
+{ 32: }
+  ( sym: 60; act: 28 ),
+  ( sym: 256; act: -50 ),
+  ( sym: 257; act: -50 ),
+  ( sym: 259; act: -50 ),
+  ( sym: 260; act: -50 ),
+{ 33: }
+{ 34: }
+{ 35: }
+{ 36: }
+  ( sym: 258; act: 51 ),
+{ 37: }
+  ( sym: 124; act: 56 ),
+  ( sym: 256; act: 57 ),
+  ( sym: 258; act: 51 ),
+  ( sym: 0; act: -29 ),
+  ( sym: 269; act: -29 ),
+{ 38: }
+{ 39: }
+{ 40: }
+{ 41: }
+  ( sym: 44; act: 61 ),
+  ( sym: 256; act: 62 ),
+  ( sym: 257; act: 25 ),
+  ( sym: 262; act: -48 ),
+  ( sym: 263; act: -48 ),
+  ( sym: 264; act: -48 ),
+  ( sym: 265; act: -48 ),
+  ( sym: 266; act: -48 ),
+  ( sym: 267; act: -48 ),
+  ( sym: 269; act: -48 ),
+  ( sym: 270; act: -48 ),
+{ 42: }
+{ 43: }
+{ 44: }
+  ( sym: 62; act: 64 ),
+  ( sym: 256; act: 65 ),
+{ 45: }
+  ( sym: 256; act: 71 ),
+  ( sym: 257; act: 25 ),
+  ( sym: 259; act: 72 ),
+  ( sym: 260; act: 73 ),
+{ 46: }
+  ( sym: 256; act: 71 ),
+  ( sym: 257; act: 25 ),
+  ( sym: 259; act: 72 ),
+  ( sym: 260; act: 73 ),
+{ 47: }
+  ( sym: 256; act: 71 ),
+  ( sym: 257; act: 25 ),
+  ( sym: 259; act: 72 ),
+  ( sym: 260; act: 73 ),
+{ 48: }
+  ( sym: 256; act: 71 ),
+  ( sym: 257; act: 25 ),
+  ( sym: 259; act: 72 ),
+  ( sym: 260; act: 73 ),
+{ 49: }
+{ 50: }
+{ 51: }
+{ 52: }
+{ 53: }
+{ 54: }
+  ( sym: 269; act: 19 ),
+  ( sym: 0; act: -31 ),
+{ 55: }
+{ 56: }
+{ 57: }
+{ 58: }
+  ( sym: 256; act: 34 ),
+  ( sym: 271; act: 35 ),
+{ 59: }
+{ 60: }
+  ( sym: 256; act: 83 ),
+  ( sym: 257; act: 25 ),
+{ 61: }
+{ 62: }
+{ 63: }
+{ 64: }
+{ 65: }
+{ 66: }
+{ 67: }
+  ( sym: 44; act: 61 ),
+  ( sym: 256; act: 86 ),
+  ( sym: 257; act: 25 ),
+  ( sym: 259; act: 72 ),
+  ( sym: 260; act: 73 ),
+  ( sym: 262; act: -47 ),
+  ( sym: 263; act: -47 ),
+  ( sym: 264; act: -47 ),
+  ( sym: 265; act: -47 ),
+  ( sym: 266; act: -47 ),
+  ( sym: 267; act: -47 ),
+  ( sym: 269; act: -47 ),
+  ( sym: 270; act: -47 ),
+{ 68: }
+  ( sym: 261; act: 88 ),
+  ( sym: 44; act: -59 ),
+  ( sym: 256; act: -59 ),
+  ( sym: 257; act: -59 ),
+  ( sym: 259; act: -59 ),
+  ( sym: 260; act: -59 ),
+  ( sym: 262; act: -59 ),
+  ( sym: 263; act: -59 ),
+  ( sym: 264; act: -59 ),
+  ( sym: 265; act: -59 ),
+  ( sym: 266; act: -59 ),
+  ( sym: 267; act: -59 ),
+  ( sym: 269; act: -59 ),
+  ( sym: 270; act: -59 ),
+{ 69: }
+{ 70: }
+  ( sym: 261; act: 88 ),
+  ( sym: 44; act: -60 ),
+  ( sym: 256; act: -60 ),
+  ( sym: 257; act: -60 ),
+  ( sym: 259; act: -60 ),
+  ( sym: 260; act: -60 ),
+  ( sym: 262; act: -60 ),
+  ( sym: 263; act: -60 ),
+  ( sym: 264; act: -60 ),
+  ( sym: 265; act: -60 ),
+  ( sym: 266; act: -60 ),
+  ( sym: 267; act: -60 ),
+  ( sym: 269; act: -60 ),
+  ( sym: 270; act: -60 ),
+{ 71: }
+{ 72: }
+{ 73: }
+{ 74: }
+  ( sym: 44; act: 61 ),
+  ( sym: 256; act: 86 ),
+  ( sym: 257; act: 25 ),
+  ( sym: 259; act: 72 ),
+  ( sym: 260; act: 73 ),
+  ( sym: 262; act: -45 ),
+  ( sym: 263; act: -45 ),
+  ( sym: 264; act: -45 ),
+  ( sym: 265; act: -45 ),
+  ( sym: 266; act: -45 ),
+  ( sym: 267; act: -45 ),
+  ( sym: 269; act: -45 ),
+  ( sym: 270; act: -45 ),
+{ 75: }
+  ( sym: 44; act: 61 ),
+  ( sym: 256; act: 86 ),
+  ( sym: 257; act: 25 ),
+  ( sym: 259; act: 72 ),
+  ( sym: 260; act: 73 ),
+  ( sym: 262; act: -43 ),
+  ( sym: 263; act: -43 ),
+  ( sym: 264; act: -43 ),
+  ( sym: 265; act: -43 ),
+  ( sym: 266; act: -43 ),
+  ( sym: 267; act: -43 ),
+  ( sym: 269; act: -43 ),
+  ( sym: 270; act: -43 ),
+{ 76: }
+  ( sym: 44; act: 61 ),
+  ( sym: 256; act: 86 ),
+  ( sym: 257; act: 25 ),
+  ( sym: 259; act: 72 ),
+  ( sym: 260; act: 73 ),
+  ( sym: 262; act: -41 ),
+  ( sym: 263; act: -41 ),
+  ( sym: 264; act: -41 ),
+  ( sym: 265; act: -41 ),
+  ( sym: 266; act: -41 ),
+  ( sym: 267; act: -41 ),
+  ( sym: 269; act: -41 ),
+  ( sym: 270; act: -41 ),
+{ 77: }
+  ( sym: 58; act: 91 ),
+{ 78: }
+{ 79: }
+{ 80: }
+{ 81: }
+{ 82: }
+{ 83: }
+{ 84: }
+{ 85: }
+  ( sym: 256; act: 95 ),
+  ( sym: 257; act: 25 ),
+  ( sym: 259; act: 72 ),
+  ( sym: 260; act: 73 ),
+{ 86: }
+{ 87: }
+{ 88: }
+{ 89: }
+{ 90: }
+{ 91: }
+{ 92: }
+  ( sym: 61; act: 105 ),
+  ( sym: 123; act: 106 ),
+  ( sym: 256; act: 107 ),
+  ( sym: 257; act: 25 ),
+  ( sym: 259; act: 72 ),
+  ( sym: 260; act: 73 ),
+  ( sym: 268; act: 108 ),
+  ( sym: 0; act: -93 ),
+  ( sym: 59; act: -93 ),
+  ( sym: 124; act: -93 ),
+  ( sym: 258; act: -93 ),
+  ( sym: 269; act: -93 ),
+{ 93: }
+  ( sym: 258; act: 51 ),
+{ 94: }
+{ 95: }
+{ 96: }
+{ 97: }
+{ 98: }
+  ( sym: 59; act: 112 ),
+  ( sym: 0; act: -83 ),
+  ( sym: 124; act: -83 ),
+  ( sym: 256; act: -83 ),
+  ( sym: 258; act: -83 ),
+  ( sym: 269; act: -83 ),
+{ 99: }
+{ 100: }
+{ 101: }
+  ( sym: 257; act: 25 ),
+  ( sym: 259; act: 72 ),
+  ( sym: 260; act: 73 ),
+{ 102: }
+{ 103: }
+{ 104: }
+{ 105: }
+{ 106: }
+{ 107: }
+{ 108: }
+{ 109: }
+{ 110: }
+  ( sym: 61; act: 105 ),
+  ( sym: 123; act: 106 ),
+  ( sym: 256; act: 107 ),
+  ( sym: 257; act: 25 ),
+  ( sym: 259; act: 72 ),
+  ( sym: 260; act: 73 ),
+  ( sym: 268; act: 108 ),
+  ( sym: 0; act: -93 ),
+  ( sym: 59; act: -93 ),
+  ( sym: 124; act: -93 ),
+  ( sym: 258; act: -93 ),
+  ( sym: 269; act: -93 ),
+{ 111: }
+{ 112: }
+{ 113: }
+  ( sym: 125; act: 119 ),
+  ( sym: 256; act: 120 ),
+{ 114: }
+{ 115: }
+{ 116: }
+{ 117: }
+  ( sym: 59; act: 112 ),
+  ( sym: 0; act: -80 ),
+  ( sym: 124; act: -80 ),
+  ( sym: 256; act: -80 ),
+  ( sym: 258; act: -80 ),
+  ( sym: 269; act: -80 ),
+{ 118: }
+{ 119: }
+{ 120: }
+{ 121: }
+  ( sym: 61; act: 105 ),
+  ( sym: 123; act: 106 ),
+  ( sym: 0; act: -101 ),
+  ( sym: 59; act: -101 ),
+  ( sym: 124; act: -101 ),
+  ( sym: 256; act: -101 ),
+  ( sym: 258; act: -101 ),
+  ( sym: 269; act: -101 ),
+{ 122: }
+  ( sym: 61; act: 105 ),
+  ( sym: 123; act: 106 ),
+  ( sym: 0; act: -101 ),
+  ( sym: 59; act: -101 ),
+  ( sym: 124; act: -101 ),
+  ( sym: 256; act: -101 ),
+  ( sym: 258; act: -101 ),
+  ( sym: 269; act: -101 ),
+{ 123: }
+  ( sym: 61; act: 105 ),
+  ( sym: 123; act: 106 ),
+  ( sym: 0; act: -101 ),
+  ( sym: 59; act: -101 ),
+  ( sym: 124; act: -101 ),
+  ( sym: 256; act: -101 ),
+  ( sym: 258; act: -101 ),
+  ( sym: 269; act: -101 )
+{ 124: }
+{ 125: }
+{ 126: }
+{ 127: }
+);
+
+yyg : array [1..yyngotos] of YYARec = (
+{ 0: }
+  ( sym: -27; act: 1 ),
+  ( sym: -2; act: 2 ),
+{ 1: }
+  ( sym: -32; act: 3 ),
+  ( sym: -16; act: 4 ),
+  ( sym: -15; act: 5 ),
+  ( sym: -13; act: 6 ),
+  ( sym: -12; act: 7 ),
+  ( sym: -11; act: 8 ),
+  ( sym: -10; act: 9 ),
+  ( sym: -9; act: 10 ),
+  ( sym: -8; act: 11 ),
+{ 2: }
+{ 3: }
+{ 4: }
+  ( sym: -33; act: 21 ),
+{ 5: }
+  ( sym: -29; act: 22 ),
+{ 6: }
+  ( sym: -3; act: 23 ),
+{ 7: }
+  ( sym: -34; act: 26 ),
+  ( sym: -24; act: 27 ),
+{ 8: }
+  ( sym: -39; act: 29 ),
+{ 9: }
+  ( sym: -38; act: 30 ),
+{ 10: }
+  ( sym: -37; act: 31 ),
+{ 11: }
+  ( sym: -35; act: 32 ),
+{ 12: }
+{ 13: }
+{ 14: }
+{ 15: }
+{ 16: }
+{ 17: }
+{ 18: }
+{ 19: }
+{ 20: }
+{ 21: }
+  ( sym: -17; act: 33 ),
+{ 22: }
+  ( sym: -44; act: 36 ),
+  ( sym: -28; act: 37 ),
+  ( sym: -16; act: 38 ),
+{ 23: }
+{ 24: }
+{ 25: }
+{ 26: }
+  ( sym: -42; act: 40 ),
+  ( sym: -40; act: 41 ),
+  ( sym: -3; act: 42 ),
+{ 27: }
+  ( sym: -3; act: 44 ),
+{ 28: }
+{ 29: }
+  ( sym: -34; act: 45 ),
+  ( sym: -24; act: 27 ),
+{ 30: }
+  ( sym: -34; act: 46 ),
+  ( sym: -24; act: 27 ),
+{ 31: }
+  ( sym: -34; act: 47 ),
+  ( sym: -24; act: 27 ),
+{ 32: }
+  ( sym: -34; act: 48 ),
+  ( sym: -24; act: 27 ),
+{ 33: }
+{ 34: }
+{ 35: }
+{ 36: }
+  ( sym: -43; act: 49 ),
+  ( sym: -4; act: 50 ),
+{ 37: }
+  ( sym: -47; act: 52 ),
+  ( sym: -43; act: 53 ),
+  ( sym: -31; act: 54 ),
+  ( sym: -21; act: 55 ),
+  ( sym: -4; act: 50 ),
+{ 38: }
+  ( sym: -45; act: 58 ),
+{ 39: }
+{ 40: }
+{ 41: }
+  ( sym: -42; act: 59 ),
+  ( sym: -18; act: 60 ),
+  ( sym: -3; act: 42 ),
+{ 42: }
+{ 43: }
+{ 44: }
+  ( sym: -25; act: 63 ),
+{ 45: }
+  ( sym: -41; act: 66 ),
+  ( sym: -36; act: 67 ),
+  ( sym: -6; act: 68 ),
+  ( sym: -5; act: 69 ),
+  ( sym: -3; act: 70 ),
+{ 46: }
+  ( sym: -41; act: 66 ),
+  ( sym: -36; act: 74 ),
+  ( sym: -6; act: 68 ),
+  ( sym: -5; act: 69 ),
+  ( sym: -3; act: 70 ),
+{ 47: }
+  ( sym: -41; act: 66 ),
+  ( sym: -36; act: 75 ),
+  ( sym: -6; act: 68 ),
+  ( sym: -5; act: 69 ),
+  ( sym: -3; act: 70 ),
+{ 48: }
+  ( sym: -41; act: 66 ),
+  ( sym: -36; act: 76 ),
+  ( sym: -6; act: 68 ),
+  ( sym: -5; act: 69 ),
+  ( sym: -3; act: 70 ),
+{ 49: }
+{ 50: }
+  ( sym: -48; act: 77 ),
+{ 51: }
+{ 52: }
+{ 53: }
+{ 54: }
+  ( sym: -30; act: 78 ),
+  ( sym: -15; act: 79 ),
+{ 55: }
+  ( sym: -52; act: 80 ),
+{ 56: }
+{ 57: }
+{ 58: }
+  ( sym: -17; act: 81 ),
+{ 59: }
+{ 60: }
+  ( sym: -42; act: 82 ),
+  ( sym: -3; act: 42 ),
+{ 61: }
+{ 62: }
+{ 63: }
+{ 64: }
+{ 65: }
+{ 66: }
+{ 67: }
+  ( sym: -41; act: 84 ),
+  ( sym: -18; act: 85 ),
+  ( sym: -6; act: 68 ),
+  ( sym: -5; act: 69 ),
+  ( sym: -3; act: 70 ),
+{ 68: }
+  ( sym: -7; act: 87 ),
+{ 69: }
+{ 70: }
+  ( sym: -7; act: 89 ),
+{ 71: }
+{ 72: }
+{ 73: }
+{ 74: }
+  ( sym: -41; act: 84 ),
+  ( sym: -18; act: 85 ),
+  ( sym: -6; act: 68 ),
+  ( sym: -5; act: 69 ),
+  ( sym: -3; act: 70 ),
+{ 75: }
+  ( sym: -41; act: 84 ),
+  ( sym: -18; act: 85 ),
+  ( sym: -6; act: 68 ),
+  ( sym: -5; act: 69 ),
+  ( sym: -3; act: 70 ),
+{ 76: }
+  ( sym: -41; act: 84 ),
+  ( sym: -18; act: 85 ),
+  ( sym: -6; act: 68 ),
+  ( sym: -5; act: 69 ),
+  ( sym: -3; act: 70 ),
+{ 77: }
+  ( sym: -19; act: 90 ),
+{ 78: }
+{ 79: }
+{ 80: }
+  ( sym: -49; act: 92 ),
+{ 81: }
+  ( sym: -46; act: 93 ),
+{ 82: }
+{ 83: }
+{ 84: }
+{ 85: }
+  ( sym: -41; act: 94 ),
+  ( sym: -6; act: 68 ),
+  ( sym: -5; act: 69 ),
+  ( sym: -3; act: 70 ),
+{ 86: }
+{ 87: }
+{ 88: }
+{ 89: }
+{ 90: }
+  ( sym: -50; act: 96 ),
+{ 91: }
+{ 92: }
+  ( sym: -53; act: 97 ),
+  ( sym: -51; act: 98 ),
+  ( sym: -26; act: 99 ),
+  ( sym: -22; act: 100 ),
+  ( sym: -14; act: 101 ),
+  ( sym: -6; act: 102 ),
+  ( sym: -5; act: 103 ),
+  ( sym: -3; act: 104 ),
+{ 93: }
+  ( sym: -43; act: 109 ),
+  ( sym: -4; act: 50 ),
+{ 94: }
+{ 95: }
+{ 96: }
+  ( sym: -49; act: 110 ),
+{ 97: }
+{ 98: }
+  ( sym: -20; act: 111 ),
+{ 99: }
+{ 100: }
+  ( sym: -54; act: 113 ),
+{ 101: }
+  ( sym: -6; act: 114 ),
+  ( sym: -5; act: 115 ),
+  ( sym: -3; act: 116 ),
+{ 102: }
+{ 103: }
+{ 104: }
+{ 105: }
+{ 106: }
+{ 107: }
+{ 108: }
+{ 109: }
+{ 110: }
+  ( sym: -53; act: 97 ),
+  ( sym: -51; act: 117 ),
+  ( sym: -26; act: 99 ),
+  ( sym: -22; act: 100 ),
+  ( sym: -14; act: 101 ),
+  ( sym: -6; act: 102 ),
+  ( sym: -5; act: 103 ),
+  ( sym: -3; act: 104 ),
+{ 111: }
+{ 112: }
+{ 113: }
+  ( sym: -23; act: 118 ),
+{ 114: }
+  ( sym: -57; act: 121 ),
+{ 115: }
+  ( sym: -56; act: 122 ),
+{ 116: }
+  ( sym: -58; act: 123 ),
+{ 117: }
+  ( sym: -20; act: 111 ),
+{ 118: }
+{ 119: }
+{ 120: }
+{ 121: }
+  ( sym: -55; act: 124 ),
+  ( sym: -53; act: 125 ),
+  ( sym: -26; act: 99 ),
+  ( sym: -22; act: 100 ),
+{ 122: }
+  ( sym: -55; act: 126 ),
+  ( sym: -53; act: 125 ),
+  ( sym: -26; act: 99 ),
+  ( sym: -22; act: 100 ),
+{ 123: }
+  ( sym: -55; act: 127 ),
+  ( sym: -53; act: 125 ),
+  ( sym: -26; act: 99 ),
+  ( sym: -22; act: 100 )
+{ 124: }
+{ 125: }
+{ 126: }
+{ 127: }
+);
+
+yyd : array [0..yynstates-1] of Integer = (
+{ 0: } -33,
+{ 1: } 0,
+{ 2: } 0,
+{ 3: } -34,
+{ 4: } -38,
+{ 5: } -28,
+{ 6: } 0,
+{ 7: } 0,
+{ 8: } -46,
+{ 9: } -44,
+{ 10: } -42,
+{ 11: } -40,
+{ 12: } -35,
+{ 13: } -6,
+{ 14: } -7,
+{ 15: } -8,
+{ 16: } -9,
+{ 17: } -10,
+{ 18: } -11,
+{ 19: } -13,
+{ 20: } -14,
+{ 21: } 0,
+{ 22: } 0,
+{ 23: } -36,
+{ 24: } -37,
+{ 25: } -1,
+{ 26: } 0,
+{ 27: } 0,
+{ 28: } -24,
+{ 29: } 0,
+{ 30: } 0,
+{ 31: } 0,
+{ 32: } 0,
+{ 33: } -39,
+{ 34: } -16,
+{ 35: } -15,
+{ 36: } 0,
+{ 37: } 0,
+{ 38: } -72,
+{ 39: } -76,
+{ 40: } -63,
+{ 41: } 0,
+{ 42: } -69,
+{ 43: } -66,
+{ 44: } 0,
+{ 45: } 0,
+{ 46: } 0,
+{ 47: } 0,
+{ 48: } 0,
+{ 49: } -71,
+{ 50: } -78,
+{ 51: } -2,
+{ 52: } -75,
+{ 53: } -81,
+{ 54: } 0,
+{ 55: } -82,
+{ 56: } -20,
+{ 57: } -77,
+{ 58: } 0,
+{ 59: } -64,
+{ 60: } 0,
+{ 61: } -17,
+{ 62: } -67,
+{ 63: } -51,
+{ 64: } -25,
+{ 65: } -26,
+{ 66: } -52,
+{ 67: } 0,
+{ 68: } 0,
+{ 69: } -58,
+{ 70: } 0,
+{ 71: } -55,
+{ 72: } -3,
+{ 73: } -4,
+{ 74: } 0,
+{ 75: } 0,
+{ 76: } 0,
+{ 77: } 0,
+{ 78: } -30,
+{ 79: } -32,
+{ 80: } -84,
+{ 81: } -73,
+{ 82: } -65,
+{ 83: } -68,
+{ 84: } -53,
+{ 85: } 0,
+{ 86: } -56,
+{ 87: } -61,
+{ 88: } -5,
+{ 89: } -62,
+{ 90: } -79,
+{ 91: } -18,
+{ 92: } 0,
+{ 93: } 0,
+{ 94: } -54,
+{ 95: } -57,
+{ 96: } -84,
+{ 97: } -88,
+{ 98: } 0,
+{ 99: } -92,
+{ 100: } -90,
+{ 101: } 0,
+{ 102: } -86,
+{ 103: } -85,
+{ 104: } -87,
+{ 105: } -27,
+{ 106: } -21,
+{ 107: } -89,
+{ 108: } -12,
+{ 109: } -74,
+{ 110: } 0,
+{ 111: } -100,
+{ 112: } -19,
+{ 113: } 0,
+{ 114: } -96,
+{ 115: } -94,
+{ 116: } -98,
+{ 117: } 0,
+{ 118: } -91,
+{ 119: } -22,
+{ 120: } -23,
+{ 121: } 0,
+{ 122: } 0,
+{ 123: } 0,
+{ 124: } -97,
+{ 125: } -102,
+{ 126: } -95,
+{ 127: } -99
+);
+
+yyal : array [0..yynstates-1] of Integer = (
+{ 0: } 1,
+{ 1: } 1,
+{ 2: } 10,
+{ 3: } 11,
+{ 4: } 11,
+{ 5: } 11,
+{ 6: } 11,
+{ 7: } 13,
+{ 8: } 24,
+{ 9: } 24,
+{ 10: } 24,
+{ 11: } 24,
+{ 12: } 24,
+{ 13: } 24,
+{ 14: } 24,
+{ 15: } 24,
+{ 16: } 24,
+{ 17: } 24,
+{ 18: } 24,
+{ 19: } 24,
+{ 20: } 24,
+{ 21: } 24,
+{ 22: } 26,
+{ 23: } 29,
+{ 24: } 29,
+{ 25: } 29,
+{ 26: } 29,
+{ 27: } 39,
+{ 28: } 40,
+{ 29: } 40,
+{ 30: } 45,
+{ 31: } 50,
+{ 32: } 55,
+{ 33: } 60,
+{ 34: } 60,
+{ 35: } 60,
+{ 36: } 60,
+{ 37: } 61,
+{ 38: } 66,
+{ 39: } 66,
+{ 40: } 66,
+{ 41: } 66,
+{ 42: } 77,
+{ 43: } 77,
+{ 44: } 77,
+{ 45: } 79,
+{ 46: } 83,
+{ 47: } 87,
+{ 48: } 91,
+{ 49: } 95,
+{ 50: } 95,
+{ 51: } 95,
+{ 52: } 95,
+{ 53: } 95,
+{ 54: } 95,
+{ 55: } 97,
+{ 56: } 97,
+{ 57: } 97,
+{ 58: } 97,
+{ 59: } 99,
+{ 60: } 99,
+{ 61: } 101,
+{ 62: } 101,
+{ 63: } 101,
+{ 64: } 101,
+{ 65: } 101,
+{ 66: } 101,
+{ 67: } 101,
+{ 68: } 114,
+{ 69: } 128,
+{ 70: } 128,
+{ 71: } 142,
+{ 72: } 142,
+{ 73: } 142,
+{ 74: } 142,
+{ 75: } 155,
+{ 76: } 168,
+{ 77: } 181,
+{ 78: } 182,
+{ 79: } 182,
+{ 80: } 182,
+{ 81: } 182,
+{ 82: } 182,
+{ 83: } 182,
+{ 84: } 182,
+{ 85: } 182,
+{ 86: } 186,
+{ 87: } 186,
+{ 88: } 186,
+{ 89: } 186,
+{ 90: } 186,
+{ 91: } 186,
+{ 92: } 186,
+{ 93: } 198,
+{ 94: } 199,
+{ 95: } 199,
+{ 96: } 199,
+{ 97: } 199,
+{ 98: } 199,
+{ 99: } 205,
+{ 100: } 205,
+{ 101: } 205,
+{ 102: } 208,
+{ 103: } 208,
+{ 104: } 208,
+{ 105: } 208,
+{ 106: } 208,
+{ 107: } 208,
+{ 108: } 208,
+{ 109: } 208,
+{ 110: } 208,
+{ 111: } 220,
+{ 112: } 220,
+{ 113: } 220,
+{ 114: } 222,
+{ 115: } 222,
+{ 116: } 222,
+{ 117: } 222,
+{ 118: } 228,
+{ 119: } 228,
+{ 120: } 228,
+{ 121: } 228,
+{ 122: } 236,
+{ 123: } 244,
+{ 124: } 252,
+{ 125: } 252,
+{ 126: } 252,
+{ 127: } 252
+);
+
+yyah : array [0..yynstates-1] of Integer = (
+{ 0: } 0,
+{ 1: } 9,
+{ 2: } 10,
+{ 3: } 10,
+{ 4: } 10,
+{ 5: } 10,
+{ 6: } 12,
+{ 7: } 23,
+{ 8: } 23,
+{ 9: } 23,
+{ 10: } 23,
+{ 11: } 23,
+{ 12: } 23,
+{ 13: } 23,
+{ 14: } 23,
+{ 15: } 23,
+{ 16: } 23,
+{ 17: } 23,
+{ 18: } 23,
+{ 19: } 23,
+{ 20: } 23,
+{ 21: } 25,
+{ 22: } 28,
+{ 23: } 28,
+{ 24: } 28,
+{ 25: } 28,
+{ 26: } 38,
+{ 27: } 39,
+{ 28: } 39,
+{ 29: } 44,
+{ 30: } 49,
+{ 31: } 54,
+{ 32: } 59,
+{ 33: } 59,
+{ 34: } 59,
+{ 35: } 59,
+{ 36: } 60,
+{ 37: } 65,
+{ 38: } 65,
+{ 39: } 65,
+{ 40: } 65,
+{ 41: } 76,
+{ 42: } 76,
+{ 43: } 76,
+{ 44: } 78,
+{ 45: } 82,
+{ 46: } 86,
+{ 47: } 90,
+{ 48: } 94,
+{ 49: } 94,
+{ 50: } 94,
+{ 51: } 94,
+{ 52: } 94,
+{ 53: } 94,
+{ 54: } 96,
+{ 55: } 96,
+{ 56: } 96,
+{ 57: } 96,
+{ 58: } 98,
+{ 59: } 98,
+{ 60: } 100,
+{ 61: } 100,
+{ 62: } 100,
+{ 63: } 100,
+{ 64: } 100,
+{ 65: } 100,
+{ 66: } 100,
+{ 67: } 113,
+{ 68: } 127,
+{ 69: } 127,
+{ 70: } 141,
+{ 71: } 141,
+{ 72: } 141,
+{ 73: } 141,
+{ 74: } 154,
+{ 75: } 167,
+{ 76: } 180,
+{ 77: } 181,
+{ 78: } 181,
+{ 79: } 181,
+{ 80: } 181,
+{ 81: } 181,
+{ 82: } 181,
+{ 83: } 181,
+{ 84: } 181,
+{ 85: } 185,
+{ 86: } 185,
+{ 87: } 185,
+{ 88: } 185,
+{ 89: } 185,
+{ 90: } 185,
+{ 91: } 185,
+{ 92: } 197,
+{ 93: } 198,
+{ 94: } 198,
+{ 95: } 198,
+{ 96: } 198,
+{ 97: } 198,
+{ 98: } 204,
+{ 99: } 204,
+{ 100: } 204,
+{ 101: } 207,
+{ 102: } 207,
+{ 103: } 207,
+{ 104: } 207,
+{ 105: } 207,
+{ 106: } 207,
+{ 107: } 207,
+{ 108: } 207,
+{ 109: } 207,
+{ 110: } 219,
+{ 111: } 219,
+{ 112: } 219,
+{ 113: } 221,
+{ 114: } 221,
+{ 115: } 221,
+{ 116: } 221,
+{ 117: } 227,
+{ 118: } 227,
+{ 119: } 227,
+{ 120: } 227,
+{ 121: } 235,
+{ 122: } 243,
+{ 123: } 251,
+{ 124: } 251,
+{ 125: } 251,
+{ 126: } 251,
+{ 127: } 251
+);
+
+yygl : array [0..yynstates-1] of Integer = (
+{ 0: } 1,
+{ 1: } 3,
+{ 2: } 12,
+{ 3: } 12,
+{ 4: } 12,
+{ 5: } 13,
+{ 6: } 14,
+{ 7: } 15,
+{ 8: } 17,
+{ 9: } 18,
+{ 10: } 19,
+{ 11: } 20,
+{ 12: } 21,
+{ 13: } 21,
+{ 14: } 21,
+{ 15: } 21,
+{ 16: } 21,
+{ 17: } 21,
+{ 18: } 21,
+{ 19: } 21,
+{ 20: } 21,
+{ 21: } 21,
+{ 22: } 22,
+{ 23: } 25,
+{ 24: } 25,
+{ 25: } 25,
+{ 26: } 25,
+{ 27: } 28,
+{ 28: } 29,
+{ 29: } 29,
+{ 30: } 31,
+{ 31: } 33,
+{ 32: } 35,
+{ 33: } 37,
+{ 34: } 37,
+{ 35: } 37,
+{ 36: } 37,
+{ 37: } 39,
+{ 38: } 44,
+{ 39: } 45,
+{ 40: } 45,
+{ 41: } 45,
+{ 42: } 48,
+{ 43: } 48,
+{ 44: } 48,
+{ 45: } 49,
+{ 46: } 54,
+{ 47: } 59,
+{ 48: } 64,
+{ 49: } 69,
+{ 50: } 69,
+{ 51: } 70,
+{ 52: } 70,
+{ 53: } 70,
+{ 54: } 70,
+{ 55: } 72,
+{ 56: } 73,
+{ 57: } 73,
+{ 58: } 73,
+{ 59: } 74,
+{ 60: } 74,
+{ 61: } 76,
+{ 62: } 76,
+{ 63: } 76,
+{ 64: } 76,
+{ 65: } 76,
+{ 66: } 76,
+{ 67: } 76,
+{ 68: } 81,
+{ 69: } 82,
+{ 70: } 82,
+{ 71: } 83,
+{ 72: } 83,
+{ 73: } 83,
+{ 74: } 83,
+{ 75: } 88,
+{ 76: } 93,
+{ 77: } 98,
+{ 78: } 99,
+{ 79: } 99,
+{ 80: } 99,
+{ 81: } 100,
+{ 82: } 101,
+{ 83: } 101,
+{ 84: } 101,
+{ 85: } 101,
+{ 86: } 105,
+{ 87: } 105,
+{ 88: } 105,
+{ 89: } 105,
+{ 90: } 105,
+{ 91: } 106,
+{ 92: } 106,
+{ 93: } 114,
+{ 94: } 116,
+{ 95: } 116,
+{ 96: } 116,
+{ 97: } 117,
+{ 98: } 117,
+{ 99: } 118,
+{ 100: } 118,
+{ 101: } 119,
+{ 102: } 122,
+{ 103: } 122,
+{ 104: } 122,
+{ 105: } 122,
+{ 106: } 122,
+{ 107: } 122,
+{ 108: } 122,
+{ 109: } 122,
+{ 110: } 122,
+{ 111: } 130,
+{ 112: } 130,
+{ 113: } 130,
+{ 114: } 131,
+{ 115: } 132,
+{ 116: } 133,
+{ 117: } 134,
+{ 118: } 135,
+{ 119: } 135,
+{ 120: } 135,
+{ 121: } 135,
+{ 122: } 139,
+{ 123: } 143,
+{ 124: } 147,
+{ 125: } 147,
+{ 126: } 147,
+{ 127: } 147
+);
+
+yygh : array [0..yynstates-1] of Integer = (
+{ 0: } 2,
+{ 1: } 11,
+{ 2: } 11,
+{ 3: } 11,
+{ 4: } 12,
+{ 5: } 13,
+{ 6: } 14,
+{ 7: } 16,
+{ 8: } 17,
+{ 9: } 18,
+{ 10: } 19,
+{ 11: } 20,
+{ 12: } 20,
+{ 13: } 20,
+{ 14: } 20,
+{ 15: } 20,
+{ 16: } 20,
+{ 17: } 20,
+{ 18: } 20,
+{ 19: } 20,
+{ 20: } 20,
+{ 21: } 21,
+{ 22: } 24,
+{ 23: } 24,
+{ 24: } 24,
+{ 25: } 24,
+{ 26: } 27,
+{ 27: } 28,
+{ 28: } 28,
+{ 29: } 30,
+{ 30: } 32,
+{ 31: } 34,
+{ 32: } 36,
+{ 33: } 36,
+{ 34: } 36,
+{ 35: } 36,
+{ 36: } 38,
+{ 37: } 43,
+{ 38: } 44,
+{ 39: } 44,
+{ 40: } 44,
+{ 41: } 47,
+{ 42: } 47,
+{ 43: } 47,
+{ 44: } 48,
+{ 45: } 53,
+{ 46: } 58,
+{ 47: } 63,
+{ 48: } 68,
+{ 49: } 68,
+{ 50: } 69,
+{ 51: } 69,
+{ 52: } 69,
+{ 53: } 69,
+{ 54: } 71,
+{ 55: } 72,
+{ 56: } 72,
+{ 57: } 72,
+{ 58: } 73,
+{ 59: } 73,
+{ 60: } 75,
+{ 61: } 75,
+{ 62: } 75,
+{ 63: } 75,
+{ 64: } 75,
+{ 65: } 75,
+{ 66: } 75,
+{ 67: } 80,
+{ 68: } 81,
+{ 69: } 81,
+{ 70: } 82,
+{ 71: } 82,
+{ 72: } 82,
+{ 73: } 82,
+{ 74: } 87,
+{ 75: } 92,
+{ 76: } 97,
+{ 77: } 98,
+{ 78: } 98,
+{ 79: } 98,
+{ 80: } 99,
+{ 81: } 100,
+{ 82: } 100,
+{ 83: } 100,
+{ 84: } 100,
+{ 85: } 104,
+{ 86: } 104,
+{ 87: } 104,
+{ 88: } 104,
+{ 89: } 104,
+{ 90: } 105,
+{ 91: } 105,
+{ 92: } 113,
+{ 93: } 115,
+{ 94: } 115,
+{ 95: } 115,
+{ 96: } 116,
+{ 97: } 116,
+{ 98: } 117,
+{ 99: } 117,
+{ 100: } 118,
+{ 101: } 121,
+{ 102: } 121,
+{ 103: } 121,
+{ 104: } 121,
+{ 105: } 121,
+{ 106: } 121,
+{ 107: } 121,
+{ 108: } 121,
+{ 109: } 121,
+{ 110: } 129,
+{ 111: } 129,
+{ 112: } 129,
+{ 113: } 130,
+{ 114: } 131,
+{ 115: } 132,
+{ 116: } 133,
+{ 117: } 134,
+{ 118: } 134,
+{ 119: } 134,
+{ 120: } 134,
+{ 121: } 138,
+{ 122: } 142,
+{ 123: } 146,
+{ 124: } 146,
+{ 125: } 146,
+{ 126: } 146,
+{ 127: } 146
+);
+
+yyr : array [1..yynrules] of YYRRec = (
+{ 1: } ( len: 1; sym: -3 ),
+{ 2: } ( len: 1; sym: -4 ),
+{ 3: } ( len: 1; sym: -5 ),
+{ 4: } ( len: 1; sym: -6 ),
+{ 5: } ( len: 1; sym: -7 ),
+{ 6: } ( len: 1; sym: -8 ),
+{ 7: } ( len: 1; sym: -9 ),
+{ 8: } ( len: 1; sym: -10 ),
+{ 9: } ( len: 1; sym: -11 ),
+{ 10: } ( len: 1; sym: -12 ),
+{ 11: } ( len: 1; sym: -13 ),
+{ 12: } ( len: 1; sym: -14 ),
+{ 13: } ( len: 1; sym: -15 ),
+{ 14: } ( len: 1; sym: -16 ),
+{ 15: } ( len: 1; sym: -17 ),
+{ 16: } ( len: 1; sym: -17 ),
+{ 17: } ( len: 1; sym: -18 ),
+{ 18: } ( len: 1; sym: -19 ),
+{ 19: } ( len: 1; sym: -20 ),
+{ 20: } ( len: 1; sym: -21 ),
+{ 21: } ( len: 1; sym: -22 ),
+{ 22: } ( len: 1; sym: -23 ),
+{ 23: } ( len: 1; sym: -23 ),
+{ 24: } ( len: 1; sym: -24 ),
+{ 25: } ( len: 1; sym: -25 ),
+{ 26: } ( len: 1; sym: -25 ),
+{ 27: } ( len: 1; sym: -26 ),
+{ 28: } ( len: 0; sym: -29 ),
+{ 29: } ( len: 0; sym: -31 ),
+{ 30: } ( len: 6; sym: -2 ),
+{ 31: } ( len: 0; sym: -30 ),
+{ 32: } ( len: 1; sym: -30 ),
+{ 33: } ( len: 0; sym: -27 ),
+{ 34: } ( len: 2; sym: -27 ),
+{ 35: } ( len: 2; sym: -27 ),
+{ 36: } ( len: 2; sym: -32 ),
+{ 37: } ( len: 2; sym: -32 ),
+{ 38: } ( len: 0; sym: -33 ),
+{ 39: } ( len: 3; sym: -32 ),
+{ 40: } ( len: 0; sym: -35 ),
+{ 41: } ( len: 4; sym: -32 ),
+{ 42: } ( len: 0; sym: -37 ),
+{ 43: } ( len: 4; sym: -32 ),
+{ 44: } ( len: 0; sym: -38 ),
+{ 45: } ( len: 4; sym: -32 ),
+{ 46: } ( len: 0; sym: -39 ),
+{ 47: } ( len: 4; sym: -32 ),
+{ 48: } ( len: 3; sym: -32 ),
+{ 49: } ( len: 2; sym: -32 ),
+{ 50: } ( len: 0; sym: -34 ),
+{ 51: } ( len: 3; sym: -34 ),
+{ 52: } ( len: 1; sym: -36 ),
+{ 53: } ( len: 2; sym: -36 ),
+{ 54: } ( len: 3; sym: -36 ),
+{ 55: } ( len: 1; sym: -36 ),
+{ 56: } ( len: 2; sym: -36 ),
+{ 57: } ( len: 3; sym: -36 ),
+{ 58: } ( len: 1; sym: -41 ),
+{ 59: } ( len: 1; sym: -41 ),
+{ 60: } ( len: 1; sym: -41 ),
+{ 61: } ( len: 2; sym: -41 ),
+{ 62: } ( len: 2; sym: -41 ),
+{ 63: } ( len: 1; sym: -40 ),
+{ 64: } ( len: 2; sym: -40 ),
+{ 65: } ( len: 3; sym: -40 ),
+{ 66: } ( len: 1; sym: -40 ),
+{ 67: } ( len: 2; sym: -40 ),
+{ 68: } ( len: 3; sym: -40 ),
+{ 69: } ( len: 1; sym: -42 ),
+{ 70: } ( len: 0; sym: -44 ),
+{ 71: } ( len: 2; sym: -28 ),
+{ 72: } ( len: 0; sym: -45 ),
+{ 73: } ( len: 0; sym: -46 ),
+{ 74: } ( len: 5; sym: -28 ),
+{ 75: } ( len: 2; sym: -28 ),
+{ 76: } ( len: 1; sym: -28 ),
+{ 77: } ( len: 2; sym: -28 ),
+{ 78: } ( len: 0; sym: -48 ),
+{ 79: } ( len: 0; sym: -50 ),
+{ 80: } ( len: 6; sym: -43 ),
+{ 81: } ( len: 1; sym: -47 ),
+{ 82: } ( len: 0; sym: -52 ),
+{ 83: } ( len: 4; sym: -47 ),
+{ 84: } ( len: 0; sym: -49 ),
+{ 85: } ( len: 2; sym: -49 ),
+{ 86: } ( len: 2; sym: -49 ),
+{ 87: } ( len: 2; sym: -49 ),
+{ 88: } ( len: 2; sym: -49 ),
+{ 89: } ( len: 2; sym: -49 ),
+{ 90: } ( len: 0; sym: -54 ),
+{ 91: } ( len: 3; sym: -53 ),
+{ 92: } ( len: 1; sym: -53 ),
+{ 93: } ( len: 0; sym: -51 ),
+{ 94: } ( len: 0; sym: -56 ),
+{ 95: } ( len: 4; sym: -51 ),
+{ 96: } ( len: 0; sym: -57 ),
+{ 97: } ( len: 4; sym: -51 ),
+{ 98: } ( len: 0; sym: -58 ),
+{ 99: } ( len: 4; sym: -51 ),
+{ 100: } ( len: 2; sym: -51 ),
+{ 101: } ( len: 0; sym: -55 ),
+{ 102: } ( len: 1; sym: -55 )
+);
+
+
+const _error = 256; (* error token *)
+
+function yyact(state, sym : Integer; var act : Integer) : Boolean;
+  (* search action table *)
+  var k : Integer;
+  begin
+    k := yyal[state];
+    while (k<=yyah[state]) and (yya[k].sym<>sym) do inc(k);
+    if k>yyah[state] then
+      yyact := false
+    else
+      begin
+        act := yya[k].act;
+        yyact := true;
+      end;
+  end(*yyact*);
+
+function yygoto(state, sym : Integer; var nstate : Integer) : Boolean;
+  (* search goto table *)
+  var k : Integer;
+  begin
+    k := yygl[state];
+    while (k<=yygh[state]) and (yyg[k].sym<>sym) do inc(k);
+    if k>yygh[state] then
+      yygoto := false
+    else
+      begin
+        nstate := yyg[k].act;
+        yygoto := true;
+      end;
+  end(*yygoto*);
+
+label parse, next, error, errlab, shift, reduce, accept, abort;
+
+begin(*yyparse*)
+
+  (* initialize: *)
+
+  yystate := 0; yychar := -1; yynerrs := 0; yyerrflag := 0; yysp := 0;
+
+{$ifdef yydebug}
+  yydebug := true;
+{$else}
+  yydebug := false;
+{$endif}
+
+parse:
+
+  (* push state and value: *)
+
+  inc(yysp);
+  if yysp>yymaxdepth then
+    begin
+      yyerror('yyparse stack overflow');
+      goto abort;
+    end;
+  yys[yysp] := yystate; yyv[yysp] := yyval;
+
+next:
+
+  if (yyd[yystate]=0) and (yychar=-1) then
+    (* get next symbol *)
+    begin
+      yychar := yylex; if yychar<0 then yychar := 0;
+    end;
+
+  if yydebug then writeln('state ', yystate, ', char ', yychar);
+
+  (* determine parse action: *)
+
+  yyn := yyd[yystate];
+  if yyn<>0 then goto reduce; (* simple state *)
+
+  (* no default action; search parse table *)
+
+  if not yyact(yystate, yychar, yyn) then goto error
+  else if yyn>0 then                      goto shift
+  else if yyn<0 then                      goto reduce
+  else                                    goto accept;
+
+error:
+
+  (* error; start error recovery: *)
+
+  if yyerrflag=0 then yyerror('syntax error');
+
+errlab:
+
+  if yyerrflag=0 then inc(yynerrs);     (* new error *)
+
+  if yyerrflag<=2 then                  (* incomplete recovery; try again *)
+    begin
+      yyerrflag := 3;
+      (* uncover a state with shift action on error token *)
+      while (yysp>0) and not ( yyact(yys[yysp], _error, yyn) and
+                               (yyn>0) ) do
+        begin
+          if yydebug then
+            if yysp>1 then
+              writeln('error recovery pops state ', yys[yysp], ', uncovers ',
+                      yys[yysp-1])
+            else
+              writeln('error recovery fails ... abort');
+          dec(yysp);
+        end;
+      if yysp=0 then goto abort; (* parser has fallen from stack; abort *)
+      yystate := yyn;            (* simulate shift on error *)
+      goto parse;
+    end
+  else                                  (* no shift yet; discard symbol *)
+    begin
+      if yydebug then writeln('error recovery discards char ', yychar);
+      if yychar=0 then goto abort; (* end of input; abort *)
+      yychar := -1; goto next;     (* clear lookahead char and try again *)
+    end;
+
+shift:
+
+  (* go to new state, clear lookahead character: *)
+
+  yystate := yyn; yychar := -1; yyval := yylval;
+  if yyerrflag>0 then dec(yyerrflag);
+
+  goto parse;
+
+reduce:
+
+  (* execute action, pop rule from stack, and go to next state: *)
+
+  if yydebug then writeln('reduce ', -yyn);
+
+  yyflag := yyfnone; yyaction(-yyn);
+  dec(yysp, yyr[-yyn].len);
+  if yygoto(yys[yysp], yyr[-yyn].sym, yyn) then yystate := yyn;
+
+  (* handle action calls to yyaccept, yyabort and yyerror: *)
+
+  case yyflag of
+    yyfaccept : goto accept;
+    yyfabort  : goto abort;
+    yyferror  : goto errlab;
+  end;
+
+  goto parse;
+
+accept:
+
+  yyparse := 0; exit;
+
+abort:
+
+  yyparse := 1; exit;
+
+end(*yyparse*);
+
+
+(* Lexical analyzer (implemented in Turbo Pascal for maximum efficiency): *)
+
+function yylex : integer;
+  function end_of_input : boolean;
+    begin
+      end_of_input := (cno>length(line)) and eof(yyin)
+    end(*end_of_input*);
+  procedure scan;
+    (* scan for nonempty character, skip comments *)
+    procedure scan_comment;
+      var p : integer;
+      begin
+        p := pos('*/', copy(line, cno, length(line)));
+        if p>0 then
+          cno := cno+succ(p)
+        else
+          begin
+            while (p=0) and not eof(yyin) do
+              begin
+                readln(yyin, line);
+                inc(lno);
+                p := pos('*/', line)
+              end;
+            if p=0 then
+              begin
+                cno := succ(length(line));
+                error(open_comment_at_eof);
+              end
+            else
+              cno := succ(succ(p))
+          end
+      end(*scan_comment*);
+    begin
+      while not end_of_input do
+        if cno<=length(line) then
+          case line[cno] of
+            ' ', tab : inc(cno);
+            '/' :
+              if (cno<length(line)) and (line[succ(cno)]='*') then
+                begin
+                  inc(cno, 2);
+                  scan_comment
+                end
+              else
+                exit
+            else
+              exit
+          end
+        else
+          begin
+            readln(yyin, line);
+            inc(lno); cno := 1;
+          end
+    end(*scan*);
+  function scan_ident : integer;
+    (* scan an identifier *)
+    var
+      idstr : String;
+    begin
+      idstr := line[cno];
+      inc(cno);
+      while (cno<=length(line)) and (
+            ('A'<=upCase(line[cno])) and (upCase(line[cno])<='Z') or
+            ('0'<=line[cno]) and (line[cno]<='9') or
+            (line[cno]='_') or
+            (line[cno]='.') ) do
+        begin
+          idstr := idstr+line[cno];
+          inc(cno)
+        end;
+      yylval := get_key(idstr);
+      scan;
+      if not end_of_input and (line[cno]=':') then
+        scan_ident := C_ID
+      else
+        scan_ident := ID
+    end(*scan_ident*);
+  function scan_literal: integer;
+    (* scan a literal, i.e. string *)
+    var
+      idstr : String;
+      oct_val : Byte;
+    begin
+      idstr := line[cno];
+      inc(cno);
+      while (cno<=length(line)) and (line[cno]<>idstr[1]) do
+        if line[cno]='\' then
+          if cno<length(line) then
+            begin
+              inc(cno);
+              case line[cno] of
+                'n' :
+                  begin
+                    idstr := idstr+nl;
+                    inc(cno)
+                  end;
+                'r' :
+                  begin
+                    idstr := idstr+cr;
+                    inc(cno)
+                  end;
+                't' :
+                  begin
+                    idstr := idstr+tab;
+                    inc(cno)
+                  end;
+                'b' :
+                  begin
+                    idstr := idstr+bs;
+                    inc(cno)
+                  end;
+                'f' :
+                  begin
+                    idstr := idstr+ff;
+                    inc(cno)
+                  end;
+                '0'..'7' :
+                  begin
+                    oct_val := ord(line[cno])-ord('0');
+                    inc(cno);
+                    while (cno<=length(line)) and
+                          ('0'<=line[cno]) and
+                          (line[cno]<='7') do
+                      begin
+                        oct_val := oct_val*8+ord(line[cno])-ord('0');
+                        inc(cno)
+                      end;
+                    idstr := idstr+chr(oct_val)
+                  end
+                else
+                  begin
+                    idstr := idstr+line[cno];
+                    inc(cno)
+                  end
+              end
+            end
+          else
+            inc(cno)
+        else
+          begin
+            idstr := idstr+line[cno];
+            inc(cno)
+          end;
+      if cno>length(line) then
+        error(missing_string_terminator)
+      else
+        inc(cno);
+      if length(idstr)=2 then
+        begin
+          yylval := ord(idstr[2]);
+          scan_literal := LITERAL;
+        end
+      else if length(idstr)>1 then
+        begin
+          yylval := get_key(''''+copy(idstr, 2, pred(length(idstr)))+'''');
+          scan_literal := LITID;
+        end
+      else
+        scan_literal := ILLEGAL;
+    end(*scan_literal*);
+  function scan_num : integer;
+    (* scan an unsigned integer *)
+    var
+      numstr : String;
+      code : integer;
+    begin
+      numstr := line[cno];
+      inc(cno);
+      while (cno<=length(line)) and
+            ('0'<=line[cno]) and (line[cno]<='9') do
+        begin
+          numstr := numstr+line[cno];
+          inc(cno)
+        end;
+      val(numstr, yylval, code);
+      if code=0 then
+        scan_num := NUMBER
+      else
+        scan_num := ILLEGAL;
+    end(*scan_num*);
+  function scan_keyword : integer;
+    (* scan %xy *)
+    function lookup(key : String; var tok : integer) : boolean;
+      (* table of Yacc keywords (unstropped): *)
+      const
+        no_of_entries = 11;
+        max_entry_length = 8;
+        keys : array [1..no_of_entries] of String[max_entry_length] = (
+          '0', '2', 'binary', 'left', 'nonassoc', 'prec', 'right',
+          'start', 'term', 'token', 'type');
+        toks : array [1..no_of_entries] of integer = (
+          PTOKEN, PNONASSOC, PNONASSOC, PLEFT, PNONASSOC, PPREC, PRIGHT,
+          PSTART, PTOKEN, PTOKEN, PTYPE);
+      var m, n, k : integer;
+      begin
+        (* binary search: *)
+        m := 1; n := no_of_entries;
+        lookup := true;
+        while m<=n do
+          begin
+            k := m+(n-m) div 2;
+            if key=keys[k] then
+              begin
+                tok := toks[k];
+                exit
+              end
+            else if key>keys[k] then
+              m := k+1
+            else
+              n := k-1
+          end;
+        lookup := false
+      end(*lookup*);
+    var
+      keywstr : String;
+      tok : integer;
+    begin
+      inc(cno);
+      if cno<=length(line) then
+        case line[cno] of
+          '<' :
+            begin
+              scan_keyword := PLEFT;
+              inc(cno)
+            end;
+          '>' :
+            begin
+              scan_keyword := PRIGHT;
+              inc(cno)
+            end;
+          '=' :
+            begin
+              scan_keyword := PPREC;
+              inc(cno)
+            end;
+          '%', '\' :
+            begin
+              scan_keyword := PP;
+              inc(cno)
+            end;
+          '{' :
+            begin
+              scan_keyword := LCURL;
+              inc(cno)
+            end;
+          '}' :
+            begin
+              scan_keyword := RCURL;
+              inc(cno)
+            end;
+          'A'..'Z', 'a'..'z', '0'..'9' :
+            begin
+              keywstr := line[cno];
+              inc(cno);
+              while (cno<=length(line)) and (
+                    ('A'<=upCase(line[cno])) and (upCase(line[cno])<='Z') or
+                    ('0'<=line[cno]) and (line[cno]<='Z') ) do
+                begin
+                  keywstr := keywstr+line[cno];
+                  inc(cno)
+                end;
+              if lookup(keywstr, tok) then
+                scan_keyword := tok
+              else
+                scan_keyword := ILLEGAL
+            end;
+          else scan_keyword := ILLEGAL
+        end
+      else
+        scan_keyword := ILLEGAL;
+    end(*scan_keyword*);
+  function scan_char : integer;
+    (* scan any single character *)
+    begin
+      scan_char := ord(line[cno]);
+      inc(cno)
+    end(*scan_char*);
+  var lno0, cno0 : integer;
+  begin
+    tokleng := 0;
+    scan;
+    lno0 := lno; cno0 := cno;
+    if end_of_input then
+      yylex := 0
+    else
+      case line[cno] of
+        'A'..'Z', 'a'..'z', '_' : yylex := scan_ident;
+        '''', '"' : yylex := scan_literal;
+        '0'..'9' : yylex := scan_num;
+        '%', '\' : yylex := scan_keyword;
+        '=' :
+          if (cno<length(line)) and (line[succ(cno)]='{') then
+            begin
+              inc(cno);
+              yylex := scan_char
+            end
+          else
+            yylex := scan_char;
+        else yylex := scan_char;
+      end;
+    if lno=lno0 then
+      tokleng := cno-cno0
+  end(*yylex*);
+
+(* Main program: *)
+
+var i : Integer;
+
+begin
+{$ifdef linux}
+  codfilepath:='/usr/lib/fpc/lexyacc/';
+{$else}
+  codfilepath:=path(paramstr(0));
+{$endif}
+
+  (* sign-on: *)
+
+  writeln(sign_on);
+
+  (* parse command line: *)
+
+  if paramCount=0 then
+    begin
+      writeln(usage);
+      writeln(options);
+      halt(0);
+    end;
+
+  yfilename := '';
+  pasfilename := '';
+
+  for i := 1 to paramCount do
+    if copy(paramStr(i), 1, 1)='-' then
+      if upper(paramStr(i))='-V' then
+        verbose := true
+      else if upper(paramStr(i))='-D' then
+        debug := true
+      else
+        begin
+          writeln(invalid_option, paramStr(i));
+          halt(1);
+        end
+    else if yfilename='' then
+      yfilename := addExt(paramStr(i), 'y')
+    else if pasfilename='' then
+      pasfilename := addExt(paramStr(i), 'pas')
+    else
+      begin
+        writeln(illegal_no_args);
+        halt(1);
+      end;
+
+  if yfilename='' then
+    begin
+      writeln(illegal_no_args);
+      halt(1);
+    end;
+
+  if pasfilename='' then pasfilename := root(yfilename)+'.pas';
+  lstfilename := root(yfilename)+'.lst';
+
+  (* open files: *)
+
+  assign(yyin, yfilename);
+  assign(yyout, pasfilename);
+  assign(yylst, lstfilename);
+
+  reset(yyin);    if ioresult<>0 then fatal(cannot_open_file+yfilename);
+  rewrite(yyout); if ioresult<>0 then fatal(cannot_open_file+pasfilename);
+  rewrite(yylst); if ioresult<>0 then fatal(cannot_open_file+lstfilename);
+
+  (* search code template in current directory, then on path where Yacc
+     was executed from: *)
+  codfilename := 'yyparse.cod';
+  assign(yycod, codfilename);
+  reset(yycod);
+  if ioresult<>0 then
+    begin
+      codfilename := codfilepath+'yyparse.cod';
+      assign(yycod, codfilename);
+      reset(yycod);
+      if ioresult<>0 then fatal(cannot_open_file+codfilename);
+    end;
+
+  (* parse source grammar: *)
+
+  write('parse ... ');
+
+  lno := 0; cno := 1; line := '';
+
+  next_section;
+  if debug then writeln(yyout, '{$define yydebug}');
+
+  if yyparse=0 then
+    { done }
+  else if yychar=0 then
+    error(unexpected_eof)
+  else
+    error(syntax_error);
+
+  if errors=0 then writeln('DONE');
+
+  (* close files: *)
+
+  close(yyin); close(yyout); close(yylst); close(yycod);
+
+  (* print statistics: *)
+
+  if errors>0 then
+    writeln( lno, ' lines, ',
+             errors, ' errors found.' )
+  else
+    begin
+      writeln( lno, ' lines, ',
+               n_rules-1, '/', max_rules-1, ' rules, ',
+               n_states, '/', max_states, ' s, ',
+               n_items, '/', max_items, ' i, ',
+               n_trans, '/', max_trans, ' t, ',
+               n_redns, '/', max_redns, ' r.');
+      if shift_reduce>0 then
+        writeln(shift_reduce, ' shift/reduce conflicts.');
+      if reduce_reduce>0 then
+        writeln(reduce_reduce, ' reduce/reduce conflicts.');
+      if never_reduced>0 then
+        writeln(never_reduced, ' rules never reduced.');
+    end;
+
+  if warnings>0 then writeln(warnings, ' warnings.');
+
+{$IFNDEF Win32}
+  writeln( n_bytes, '/', max_bytes, ' bytes of memory used.');
+{$ENDIF}
+
+  (* terminate: *)
+
+  if errors>0 then
+    begin
+      erase(yyout);
+      if ioresult<>0 then ;
+    end;
+
+  if file_size(lstfilename)=0 then
+    erase(yylst)
+  else
+    writeln('(see ', lstfilename, ' for more information)');
+
+  halt(errors);
+
+end(*Yacc*).

utils/tply/pyacc.y

@@ -0,0 +1,866 @@
+
+/* YACC.Y: Yacc grammar for Yacc main program. 2-17-91, 4-30-91 AG
+   To bootstrap Yacc, use Yacc iself to compile this grammar, then
+   run tpc on the generated program.
+
+   Note:
+
+   This is not entirely the `official' syntax introduced by Johnson, but it
+   should be compatible with UNIX Yacc (except for the differences specified
+   in the program header, below), as described in the UNIX manual, including
+   the language elements entitled as "old features supported but not
+   encouraged."
+
+   Bugs:
+
+   - Processes $$'s, $i's, %} and } inside of comments in Turbo Pascal code
+     (instead of ignoring them).
+
+   Shift/reduce conflicts:
+
+   This grammar will produce a number of shift/reduce conflicts caused by
+   the error productions, since it does not specify unambigiously whether
+   errors are to be handled in global structures (definitions and rules)
+   or by enclosed syntactic constructs (e.g. symbols). Yacc will resolve
+   these conflicts in favour of shift, which is o.k. (it means that
+   errors will be caught in the innermost constructs with error handling,
+   thus reducing the amount of skipped symbols in resynchronization).
+
+   Error handling is done using the general method of Schreiner/Friedman
+   (see Schreiner/Friedman, "Introduction to compiler construction with
+   UNIX," 1985).
+
+*/
+
+%{
+(*
+
+  TP Yacc - Yet Another Compiler Compiler for Turbo Pascal
+
+  Copyright (C) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-08-01 11:24 $
+
+
+Last changes:
+
+  Version 3.0 as of April 91
+  Version 3.0a as of May 92 (bug fixes in precedence and type information
+    updates)
+
+$History: YACC.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+
+
+------------------------- Synopsis ------------------------
+
+   Synopsis   yacc [options] yacc-file[.y] [output-file[.pas]]
+
+   Options
+
+   -v  "Verbose:" Yacc generates a readable description of the generated
+       parser, written to yacc-file with new extension .lst.
+
+   -d  "Debug:" Yacc generates parser with debugging output.
+
+   Description
+
+   This is a reimplementation of the popular UNIX compiler generator
+   Yacc for MS-DOS and Turbo Pascal.
+
+   Differences from UNIX Yacc:
+
+   - Produces output code for Turbo Pascal, rather than for C.
+
+   - Does not support %union definitions. Instead, a value type is declared
+     by specifying the type identifier *itself* as the tag of a %token
+     or %type definition. Yacc will automatically generate an appropriate
+     yylval variable of a variant record type (YYSType) which is capable of
+     holding values of any of the types used in %token and %type.
+
+     Type checking is *very* strict. If you use type definitions, then
+     any symbol referred to in an action *must* have a type introduced
+     in a type definition. Either the symbol must have been assigned a
+     type in the definitions section, or the $<type-identifier> notation
+     must be used. The syntax of the %type definition has been changed
+     slightly to allow definitions of the form
+       %type <type-identifier>
+     (omitting the nonterminals) which may be used to declare types which
+     are not assigned to any grammar symbol, but are used with the
+     $<...> construct.
+
+   - The parse tables constructed by this Yacc version are slightly greater
+     than those constructed by UNIX Yacc, since a reduce action will only be
+     chosen as the default action if it is the *only* action in the state.
+     In difference, UNIX Yacc chooses a reduce action as the default action
+     whenever it is the only *reduce* action of the state (even if there are
+     other shift actions).
+
+     This solves a bug in UNIX Yacc that makes the generated parser start
+     error recovery too late with certain types of error productions (see
+     also Schreiner/Friedman, "Introduction to compiler construction with
+     UNIX," 1985). Also, errors will be caught sooner in most cases where
+     standard Yacc would carry out an additional (default) reduction before
+     detecting the error.
+
+------------------------- Synopsis ------------------------
+
+*)
+
+{$IFDEF MsDos}
+{$M 16384,0,655360}
+{$ENDIF}
+{$IFDEF DPMI}
+{$M 32768}
+{$ENDIF}
+{$IFDEF Windows}
+{$M 32768,0}
+{$ENDIF}
+
+{$X+}
+{$I-}
+program Yacc;
+
+uses
+{$IFDEF Debug}
+{$IFDEF DPMI}
+  YaccChk,
+{$ENDIF}
+{$ENDIF}
+{$IFDEF Windows}
+{$IFNDEF Console}
+  WinCrt,
+{$ENDIF}
+{$ENDIF}
+  YaccLib, YaccBase, YaccMsgs, YaccSem, YaccTabl, YaccPars;
+
+%}
+
+/* Lexical part of the Yacc language: */
+
+%token
+  ID            /* identifiers: {letter}{letter_or_digit}* */
+  C_ID          /* identifier which forms left side of rule, i.e. is
+                   followed by a colon */
+  LITERAL       /* single character literal */
+  LITID         /* multiple character literal */
+  NUMBER        /* nonnegative integers: {digit}+ */
+  PTOKEN PLEFT PRIGHT PNONASSOC PTYPE PSTART PPREC
+                /* reserved words: PTOKEN=%token, etc. */
+  PP            /* source sections separator %% */
+  LCURL         /* curly braces: %{ and %} */
+  RCURL
+  ',' ':' ';' '|' '{' '}' '<' '>' '='
+                /* literals */
+  ILLEGAL       /* illegal input character */
+
+%start grammar
+
+%%
+
+/* Lexical entities, those that may give rise to syntax errors are augmented
+   with error productions, and important symbols call yyerrok. */
+
+id              : ID
+c_id            : C_ID
+literal         : LITERAL
+litid           : LITID
+number          : NUMBER
+ptoken          : PTOKEN        { yyerrok; }
+pleft           : PLEFT         { yyerrok; }
+pright          : PRIGHT        { yyerrok; }
+pnonassoc       : PNONASSOC     { yyerrok; }
+ptype           : PTYPE         { yyerrok; }
+pstart          : PSTART        { yyerrok; }
+pprec           : PPREC
+pp              : PP            { yyerrok; }
+lcurl           : LCURL
+rcurl           : RCURL
+                | error         { error(rcurl_expected); }
+comma           : ','
+colon           : ':'           { yyerrok; }
+semicolon       : ';'           { yyerrok; }
+bar             : '|'           { yyerrok; }
+lbrace          : '{'
+rbrace          : '}'
+                | error         { error(rbrace_expected); }
+langle          : '<'
+rangle          : '>'
+                | error         { error(rangle_expected); }
+eq              : '='
+
+/* Syntax and semantic routines: */
+
+grammar         : defs pp
+                                { sort_types;
+                                  definitions;
+                                  next_section; }
+                  rules
+                                { next_section;
+                                  generate_parser;
+                                  next_section; }
+                  aux_procs
+                ;
+
+aux_procs       : /* empty: aux_procs is optional */
+
+                | pp { copy_rest_of_file; }
+
+                ;
+
+
+defs            : /* empty */
+                | defs def      { yyerrok; }
+                | defs error    { error(error_in_def); }
+                ;
+
+def             : pstart id
+                                { startnt := ntsym($2); }
+                | pstart error
+                                { error(ident_expected); }
+                | lcurl { copy_code; } rcurl
+
+                | ptoken
+                                { act_prec := 0; }
+                  tag token_list
+
+                | pleft
+                                { act_prec := new_prec_level(left); }
+                  tag token_list
+
+                | pright
+                                { act_prec := new_prec_level(right); }
+                  tag token_list
+
+                | pnonassoc
+                                { act_prec := new_prec_level(nonassoc); }
+                  tag token_list
+
+                | ptype tag nonterm_list
+
+                | ptype tag
+
+                ;
+
+tag             : /* empty: type tag is optional */
+                                { act_type := 0; }
+                | langle id rangle
+                                { act_type := $2; add_type($2); }
+                ;
+
+token_list      : token_num
+
+                | token_list token_num
+                                { yyerrok; }
+                | token_list comma token_num
+                                { yyerrok; }
+                | error
+                                { error(ident_expected); }
+                | token_list error
+                                { error(error_in_def); }
+                | token_list comma error
+                                { error(ident_expected); }
+                ;
+
+token_num       : literal
+                                { if act_type<>0 then
+                                    sym_type^[$1] := act_type;
+                                  if act_prec<>0 then
+                                    sym_prec^[$1] := act_prec; }
+                | litid
+                                { litsym($1, 0);
+                                  if act_type<>0 then
+                                    sym_type^[litsym($1, 0)] := act_type;
+                                  if act_prec<>0 then
+                                    sym_prec^[litsym($1, 0)] := act_prec; }
+                | id
+                                { litsym($1, 0);
+                                  if act_type<>0 then
+                                    sym_type^[litsym($1, 0)] := act_type;
+                                  if act_prec<>0 then
+                                    sym_prec^[litsym($1, 0)] := act_prec; }
+                | litid number
+                                { litsym($1, 0);
+                                  if act_type<>0 then
+                                    sym_type^[litsym($1, $2)] := act_type;
+                                  if act_prec<>0 then
+                                    sym_prec^[litsym($1, 0)]  := act_prec; }
+                | id number
+                                { litsym($1, 0);
+                                  if act_type<>0 then
+                                    sym_type^[litsym($1, $2)] := act_type;
+                                  if act_prec<>0 then
+                                    sym_prec^[litsym($1, 0)]  := act_prec; }
+                ;
+
+nonterm_list    : nonterm
+                | nonterm_list nonterm
+                                { yyerrok; }
+                | nonterm_list comma nonterm
+                                { yyerrok; }
+                | error
+                                { error(ident_expected); }
+                | nonterm_list error
+                                { error(error_in_def); }
+                | nonterm_list comma error
+                                { error(ident_expected); }
+                ;
+
+nonterm         : id
+                                { if act_type<>0 then
+                                    sym_type^[ntsym($1)] := act_type; }
+                ;
+
+
+rules           :               { next_section; }
+                  rule1
+
+                | lcurl { copy_code; } rcurl
+                                { next_section; }
+                  rule1
+                                        /* rules section may be prefixed
+                                           with `local' Turbo Pascal
+                                           declarations */
+                | rules rule
+                                { yyerrok; }
+                | error
+                                { error(error_in_rule); }
+                | rules error
+                                { error(error_in_rule); }
+                ;
+
+rule1           : c_id
+                                { start_rule(ntsym($1)); }
+                  colon
+                                { start_body; }
+                  body prec
+                                { end_body; }
+                ;
+
+rule            : rule1
+
+                | bar
+                                { start_body; }
+                  body prec
+                                { end_body; }
+                ;
+
+body            : /* empty */
+
+                | body literal
+                                { add_symbol($2); yyerrok; }
+                | body litid
+                                { add_symbol(sym($2)); yyerrok; }
+                | body id
+                                { add_symbol(sym($2)); yyerrok; }
+                | body action
+                                { add_action; yyerrok; }
+                | body error
+                                { error(error_in_rule); }
+                ;
+
+action          : lbrace { copy_action; } rbrace
+
+                | eq { copy_single_action; }
+                                /* old language feature; code must be
+                                   single statement ending with `;' */
+                ;
+
+prec            : /* empty */
+
+                | pprec literal
+                                { add_rule_prec($2); }
+                  opt_action
+
+                | pprec litid
+                                { add_rule_prec(litsym($2, 0)); }
+                  opt_action
+
+                | pprec id
+                                { add_rule_prec(litsym($2, 0)); }
+                  opt_action
+
+                | prec semicolon
+
+                ;
+
+opt_action      : /* empty */
+
+                | action
+                                { add_action; }
+                ;
+
+
+%%
+
+(* Lexical analyzer (implemented in Turbo Pascal for maximum efficiency): *)
+
+function yylex : integer;
+  function end_of_input : boolean;
+    begin
+      end_of_input := (cno>length(line)) and eof(yyin)
+    end(*end_of_input*);
+  procedure scan;
+    (* scan for nonempty character, skip comments *)
+    procedure scan_comment;
+      var p : integer;
+      begin
+        p := pos('*/', copy(line, cno, length(line)));
+        if p>0 then
+          cno := cno+succ(p)
+        else
+          begin
+            while (p=0) and not eof(yyin) do
+              begin
+                readln(yyin, line);
+                inc(lno);
+                p := pos('*/', line)
+              end;
+            if p=0 then
+              begin
+                cno := succ(length(line));
+                error(open_comment_at_eof);
+              end
+            else
+              cno := succ(succ(p))
+          end
+      end(*scan_comment*);
+    begin
+      while not end_of_input do
+        if cno<=length(line) then
+          case line[cno] of
+            ' ', tab : inc(cno);
+            '/' :
+              if (cno<length(line)) and (line[succ(cno)]='*') then
+                begin
+                  inc(cno, 2);
+                  scan_comment
+                end
+              else
+                exit
+            else
+              exit
+          end
+        else
+          begin
+            readln(yyin, line);
+            inc(lno); cno := 1;
+          end
+    end(*scan*);
+  function scan_ident : integer;
+    (* scan an identifier *)
+    var
+      idstr : String;
+    begin
+      idstr := line[cno];
+      inc(cno);
+      while (cno<=length(line)) and (
+            ('A'<=upCase(line[cno])) and (upCase(line[cno])<='Z') or
+            ('0'<=line[cno]) and (line[cno]<='9') or
+            (line[cno]='_') or
+            (line[cno]='.') ) do
+        begin
+          idstr := idstr+line[cno];
+          inc(cno)
+        end;
+      yylval := get_key(idstr);
+      scan;
+      if not end_of_input and (line[cno]=':') then
+        scan_ident := C_ID
+      else
+        scan_ident := ID
+    end(*scan_ident*);
+  function scan_literal: integer;
+    (* scan a literal, i.e. string *)
+    var
+      idstr : String;
+      oct_val : Byte;
+    begin
+      idstr := line[cno];
+      inc(cno);
+      while (cno<=length(line)) and (line[cno]<>idstr[1]) do
+        if line[cno]='\' then
+          if cno<length(line) then
+            begin
+              inc(cno);
+              case line[cno] of
+                'n' :
+                  begin
+                    idstr := idstr+nl;
+                    inc(cno)
+                  end;
+                'r' :
+                  begin
+                    idstr := idstr+cr;
+                    inc(cno)
+                  end;
+                't' :
+                  begin
+                    idstr := idstr+tab;
+                    inc(cno)
+                  end;
+                'b' :
+                  begin
+                    idstr := idstr+bs;
+                    inc(cno)
+                  end;
+                'f' :
+                  begin
+                    idstr := idstr+ff;
+                    inc(cno)
+                  end;
+                '0'..'7' :
+                  begin
+                    oct_val := ord(line[cno])-ord('0');
+                    inc(cno);
+                    while (cno<=length(line)) and
+                          ('0'<=line[cno]) and
+                          (line[cno]<='7') do
+                      begin
+                        oct_val := oct_val*8+ord(line[cno])-ord('0');
+                        inc(cno)
+                      end;
+                    idstr := idstr+chr(oct_val)
+                  end
+                else
+                  begin
+                    idstr := idstr+line[cno];
+                    inc(cno)
+                  end
+              end
+            end
+          else
+            inc(cno)
+        else
+          begin
+            idstr := idstr+line[cno];
+            inc(cno)
+          end;
+      if cno>length(line) then
+        error(missing_string_terminator)
+      else
+        inc(cno);
+      if length(idstr)=2 then
+        begin
+          yylval := ord(idstr[2]);
+          scan_literal := LITERAL;
+        end
+      else if length(idstr)>1 then
+        begin
+          yylval := get_key(''''+copy(idstr, 2, pred(length(idstr)))+'''');
+          scan_literal := LITID;
+        end
+      else
+        scan_literal := ILLEGAL;
+    end(*scan_literal*);
+  function scan_num : integer;
+    (* scan an unsigned integer *)
+    var
+      numstr : String;
+      code : integer;
+    begin
+      numstr := line[cno];
+      inc(cno);
+      while (cno<=length(line)) and
+            ('0'<=line[cno]) and (line[cno]<='9') do
+        begin
+          numstr := numstr+line[cno];
+          inc(cno)
+        end;
+      val(numstr, yylval, code);
+      if code=0 then
+        scan_num := NUMBER
+      else
+        scan_num := ILLEGAL;
+    end(*scan_num*);
+  function scan_keyword : integer;
+    (* scan %xy *)
+    function lookup(key : String; var tok : integer) : boolean;
+      (* table of Yacc keywords (unstropped): *)
+      const
+        no_of_entries = 11;
+        max_entry_length = 8;
+        keys : array [1..no_of_entries] of String[max_entry_length] = (
+          '0', '2', 'binary', 'left', 'nonassoc', 'prec', 'right',
+          'start', 'term', 'token', 'type');
+        toks : array [1..no_of_entries] of integer = (
+          PTOKEN, PNONASSOC, PNONASSOC, PLEFT, PNONASSOC, PPREC, PRIGHT,
+          PSTART, PTOKEN, PTOKEN, PTYPE);
+      var m, n, k : integer;
+      begin
+        (* binary search: *)
+        m := 1; n := no_of_entries;
+        lookup := true;
+        while m<=n do
+          begin
+            k := m+(n-m) div 2;
+            if key=keys[k] then
+              begin
+                tok := toks[k];
+                exit
+              end
+            else if key>keys[k] then
+              m := k+1
+            else
+              n := k-1
+          end;
+        lookup := false
+      end(*lookup*);
+    var
+      keywstr : String;
+      tok : integer;
+    begin
+      inc(cno);
+      if cno<=length(line) then
+        case line[cno] of
+          '<' :
+            begin
+              scan_keyword := PLEFT;
+              inc(cno)
+            end;
+          '>' :
+            begin
+              scan_keyword := PRIGHT;
+              inc(cno)
+            end;
+          '=' :
+            begin
+              scan_keyword := PPREC;
+              inc(cno)
+            end;
+          '%', '\' :
+            begin
+              scan_keyword := PP;
+              inc(cno)
+            end;
+          '{' :
+            begin
+              scan_keyword := LCURL;
+              inc(cno)
+            end;
+          '}' :
+            begin
+              scan_keyword := RCURL;
+              inc(cno)
+            end;
+          'A'..'Z', 'a'..'z', '0'..'9' :
+            begin
+              keywstr := line[cno];
+              inc(cno);
+              while (cno<=length(line)) and (
+                    ('A'<=upCase(line[cno])) and (upCase(line[cno])<='Z') or
+                    ('0'<=line[cno]) and (line[cno]<='Z') ) do
+                begin
+                  keywstr := keywstr+line[cno];
+                  inc(cno)
+                end;
+              if lookup(keywstr, tok) then
+                scan_keyword := tok
+              else
+                scan_keyword := ILLEGAL
+            end;
+          else scan_keyword := ILLEGAL
+        end
+      else
+        scan_keyword := ILLEGAL;
+    end(*scan_keyword*);
+  function scan_char : integer;
+    (* scan any single character *)
+    begin
+      scan_char := ord(line[cno]);
+      inc(cno)
+    end(*scan_char*);
+  var lno0, cno0 : integer;
+  begin
+    tokleng := 0;
+    scan;
+    lno0 := lno; cno0 := cno;
+    if end_of_input then
+      yylex := 0
+    else
+      case line[cno] of
+        'A'..'Z', 'a'..'z', '_' : yylex := scan_ident;
+        '''', '"' : yylex := scan_literal;
+        '0'..'9' : yylex := scan_num;
+        '%', '\' : yylex := scan_keyword;
+        '=' :
+          if (cno<length(line)) and (line[succ(cno)]='{') then
+            begin
+              inc(cno);
+              yylex := scan_char
+            end
+          else
+            yylex := scan_char;
+        else yylex := scan_char;
+      end;
+    if lno=lno0 then
+      tokleng := cno-cno0
+  end(*yylex*);
+
+(* Main program: *)
+
+var i : Integer;
+
+begin
+{$ifdef linux}
+  codfilepath:='/usr/lib/fpc/lexyacc/';
+{$else}
+  codfilepath:=path(paramstr(0));
+{$endif}
+
+  (* sign-on: *)
+
+  writeln(sign_on);
+
+  (* parse command line: *)
+
+  if paramCount=0 then
+    begin
+      writeln(usage);
+      writeln(options);
+      halt(0);
+    end;
+
+  yfilename := '';
+  pasfilename := '';
+
+  for i := 1 to paramCount do
+    if copy(paramStr(i), 1, 1)='-' then
+      if upper(paramStr(i))='-V' then
+        verbose := true
+      else if upper(paramStr(i))='-D' then
+        debug := true
+      else
+        begin
+          writeln(invalid_option, paramStr(i));
+          halt(1);
+        end
+    else if yfilename='' then
+      yfilename := addExt(paramStr(i), 'y')
+    else if pasfilename='' then
+      pasfilename := addExt(paramStr(i), 'pas')
+    else
+      begin
+        writeln(illegal_no_args);
+        halt(1);
+      end;
+
+  if yfilename='' then
+    begin
+      writeln(illegal_no_args);
+      halt(1);
+    end;
+
+  if pasfilename='' then pasfilename := root(yfilename)+'.pas';
+  lstfilename := root(yfilename)+'.lst';
+
+  (* open files: *)
+
+  assign(yyin, yfilename);
+  assign(yyout, pasfilename);
+  assign(yylst, lstfilename);
+
+  reset(yyin);    if ioresult<>0 then fatal(cannot_open_file+yfilename);
+  rewrite(yyout); if ioresult<>0 then fatal(cannot_open_file+pasfilename);
+  rewrite(yylst); if ioresult<>0 then fatal(cannot_open_file+lstfilename);
+
+  (* search code template in current directory, then on path where Yacc
+     was executed from: *)
+  codfilename := 'yyparse.cod';
+  assign(yycod, codfilename);
+  reset(yycod);
+  if ioresult<>0 then
+    begin
+      codfilename := codfilepath+'yyparse.cod';
+      assign(yycod, codfilename);
+      reset(yycod);
+      if ioresult<>0 then fatal(cannot_open_file+codfilename);
+    end;
+
+  (* parse source grammar: *)
+
+  write('parse ... ');
+
+  lno := 0; cno := 1; line := '';
+
+  next_section;
+  if debug then writeln(yyout, '{$define yydebug}');
+
+  if yyparse=0 then
+    { done }
+  else if yychar=0 then
+    error(unexpected_eof)
+  else
+    error(syntax_error);
+
+  if errors=0 then writeln('DONE');
+
+  (* close files: *)
+
+  close(yyin); close(yyout); close(yylst); close(yycod);
+
+  (* print statistics: *)
+
+  if errors>0 then
+    writeln( lno, ' lines, ',
+             errors, ' errors found.' )
+  else
+    begin
+      writeln( lno, ' lines, ',
+               n_rules-1, '/', max_rules-1, ' rules, ',
+               n_states, '/', max_states, ' s, ',
+               n_items, '/', max_items, ' i, ',
+               n_trans, '/', max_trans, ' t, ',
+               n_redns, '/', max_redns, ' r.');
+      if shift_reduce>0 then
+        writeln(shift_reduce, ' shift/reduce conflicts.');
+      if reduce_reduce>0 then
+        writeln(reduce_reduce, ' reduce/reduce conflicts.');
+      if never_reduced>0 then
+        writeln(never_reduced, ' rules never reduced.');
+    end;
+
+  if warnings>0 then writeln(warnings, ' warnings.');
+
+{$IFNDEF Win32}
+  writeln( n_bytes, '/', max_bytes, ' bytes of memory used.');
+{$ENDIF}
+
+  (* terminate: *)
+
+  if errors>0 then
+    begin
+      erase(yyout);
+      if ioresult<>0 then ;
+    end;
+
+  if file_size(lstfilename)=0 then
+    erase(yylst)
+  else
+    writeln('(see ', lstfilename, ' for more information)');
+
+  halt(errors);
+
+end(*Yacc*).

utils/tply/tply.doc

@@ -0,0 +1,1544 @@
+
+
+      TP Lex and Yacc - The Compiler Writer's Tools for Turbo Pascal
+      == === === ==== = === ======== ======== ===== === ===== ======
+
+                     Version 4.1 User Manual
+                     ======= === ==== ======
+
+                         Albert Graef
+                 Department of Musicinformatics
+               Johannes Gutenberg-University Mainz
+
+               [email protected]
+
+                          April 1998
+
+
+Introduction
+============
+
+This document describes the TP Lex and Yacc compiler generator toolset. These
+tools are designed especially to help you prepare compilers and similar
+programs like text processing utilities and command language interpreters with
+the Turbo Pascal (TM) programming language.
+
+TP Lex and Yacc are Turbo Pascal adaptions of the well-known UNIX (TM)
+utilities Lex and Yacc, which were written by M.E. Lesk and S.C. Johnson at
+Bell Laboratories, and are used with the C programming language. TP Lex and
+Yacc are intended to be approximately "compatible" with these programs.
+However, they are an independent development of the author, based on the
+techniques described in the famous "dragon book" of Aho, Sethi and Ullman
+(Aho, Sethi, Ullman: "Compilers : principles, techniques and tools," Reading
+(Mass.), Addison-Wesley, 1986).
+
+Version 4.1 of TP Lex and Yacc works with all recent flavours of Turbo/Borland
+Pascal, including Delphi, and with the Free Pascal Compiler, a free Turbo
+Pascal-compatible compiler which currently runs on DOS and Linux (other ports
+are under development). Recent information about TP Lex/Yacc, and the sources
+are available from the TPLY homepage:
+
+   http://www.musikwissenschaft.uni-mainz.de/~ag/tply
+
+For information about the Free Pascal Compiler, please refer to:
+
+   http://tfdec1.fys.kuleuven.ac.be/~michael/fpc/fpc.html
+
+TP Lex and Yacc, like any other tools of this kind, are not intended for
+novices or casual programmers; they require extensive programming experience
+as well as a thorough understanding of the principles of parser design and
+implementation to be put to work successfully. But if you are a seasoned Turbo
+Pascal programmer with some background in compiler design and formal language
+theory, you will almost certainly find TP Lex and Yacc to be a powerful
+extension of your Turbo Pascal toolset.
+
+This manual tells you how to get started with the TP Lex and Yacc programs and
+provides a short description of these programs. Some knowledge about the C
+versions of Lex and Yacc will be useful, although not strictly necessary. For
+further reading, you may also refer to:
+
+- Aho, Sethi and Ullman: "Compilers : principles, techniques and tools."
+  Reading (Mass.), Addison-Wesley, 1986.
+
+- Johnson, S.C.: "Yacc - yet another compiler-compiler." CSTR-32, Bell
+  Telephone Laboratories, 1974.
+
+- Lesk, M.E.: "Lex - a lexical analyser generator." CSTR-39, Bell Telephone
+  Laboratories, 1975.
+
+- Schreiner, Friedman: "Introduction to compiler construction with UNIX."
+  Prentice-Hall, 1985.
+
+- The Unix Programmer's Manual, Sections `Lex' and `Yacc'.
+
+
+Credits
+-------
+
+I would like to thank Berend de Boer ([email protected]), who adapted TP Lex
+and Yacc to take advantage of the large memory models in Borland Pascal 7.0
+and Delphi, and Michael Van Canneyt ([email protected]),
+the maintainer of the Linux version of the Free Pascal compiler, who is
+responsible for the Free Pascal port. And of course thanks are due to the many
+TP Lex/Yacc users all over the world for their support and comments which
+helped to improve these programs.
+
+
+Getting Started
+---------------
+
+Instructions on how to compile and install TP Lex and Yacc on all supported
+platforms can be found in the README file contained in the distribution.
+
+Once you have installed TP Lex and Yacc on your system, you can compile your
+first TP Lex and Yacc program expr. Expr is a simple desktop calculator
+program contained in the distribution, which consists of a lexical analyzer in
+the TP Lex source file exprlex.l and the parser and main program in the TP
+Yacc source file expr.y. To compile these programs, issue the commands
+
+   lex exprlex
+   yacc expr
+
+That's it! You now have the Turbo Pascal sources (exprlex.pas and expr.pas)
+for the expr program. Use the Turbo Pascal compiler to compile these programs
+as usual:
+
+   tpc expr
+
+(Of course, the precise compilation command depends on the type of compiler
+you are using. Thus you may have to replace tpc with bpc, dcc or dcc32,
+depending on the version of the Turbo/Borland/Delphi compiler you have, and
+with ppc386 for the Free Pascal compiler. If you are using TP Lex and Yacc
+with Free Pascal under Linux, the corresponding commands are:
+
+   plex exprlex
+   pyacc expr
+   ppc386 expr
+
+Note that in the Linux version, the programs are named plex and pyacc to
+avoid name clashes with the corresponding UNIX utilities.)
+
+Having compiled expr.pas, you can execute the expr program and type some
+expressions to see it work (terminate the program with an empty line). There
+is a number of other sample TP Lex and Yacc programs (.l and .y files) in the
+distribution, including a TP Yacc cross reference utility and a complete
+parser for Standard Pascal.
+
+The TP Lex and Yacc programs recognize some options which may be specified
+anywhere on the command line. E.g.,
+
+   lex -o exprlex
+
+runs TP Lex with "DFA optimization" and
+
+   yacc -v expr
+
+runs TP Yacc in "verbose" mode (TP Yacc generates a readable description of
+the generated parser).
+
+The TP Lex and Yacc programs use the following default filename extensions:
+- .l:   TP Lex input files
+- .y:   TP Yacc input files
+- .pas: TP Lex and Yacc output files
+
+As usual, you may overwrite default filename extensions by explicitly
+specifying suffixes.
+
+If you ever forget how to run TP Lex and Yacc, you can issue the command lex
+or yacc (resp. plex or pyacc) without arguments to get a short summary of the
+command line syntax.
+
+
+
+TP Lex
+======
+
+This section describes the TP Lex lexical analyzer generator.
+
+
+Usage
+-----
+
+lex [options] lex-file[.l] [output-file[.pas]]
+
+
+Options
+-------
+
+-v  "Verbose:" Lex generates a readable description of the generated
+    lexical analyzer, written to lex-file with new extension `.lst'.
+
+-o  "Optimize:" Lex optimizes DFA tables to produce a minimal DFA.
+
+
+Description
+-----------
+
+TP Lex is a program generator that is used to generate the Turbo Pascal source
+code for a lexical analyzer subroutine from the specification of an input
+language by a regular expression grammar.
+
+TP Lex parses the source grammar contained in lex-file (with default suffix
+.l) and writes the constructed lexical analyzer subroutine to the specified
+output-file (with default suffix .pas); if no output file is specified, output
+goes to lex-file with new suffix .pas. If any errors are found during
+compilation, error messages are written to the list file (lex-file with new
+suffix .lst).
+
+The generated output file contains a lexical analyzer routine, yylex,
+implemented as:
+
+  function yylex : Integer;
+
+This routine has to be called by your main program to execute the lexical
+analyzer. The return value of the yylex routine usually denotes the number
+of a token recognized by the lexical analyzer (see the return routine in the
+LexLib unit). At end-of-file the yylex routine normally returns 0.
+
+The code template for the yylex routine may be found in the yylex.cod
+file. This file is needed by TP Lex when it constructs the output file. It
+must be present either in the current directory or in the directory from which
+TP Lex was executed (TP Lex searches these directories in the indicated
+order). (NB: For the Linux/Free Pascal version, the code template is searched
+in some directory defined at compile-time instead of the execution path,
+usually /usr/lib/fpc/lexyacc.)
+
+The TP Lex library (LexLib) unit is required by programs using Lex-generated
+lexical analyzers; you will therefore have to put an appropriate uses clause
+into your program or unit that contains the lexical analyzer routine. The
+LexLib unit also provides various useful utility routines; see the file
+lexlib.pas for further information.
+
+
+Lex Source
+----------
+
+A TP Lex program consists of three sections separated with the %% delimiter:
+
+definitions
+%%
+rules
+%%
+auxiliary procedures
+
+All sections may be empty. The TP Lex language is line-oriented; definitions
+and rules are separated by line breaks. There is no special notation for
+comments, but (Turbo Pascal style) comments may be included as Turbo Pascal
+fragments (see below).
+
+The definitions section may contain the following elements:
+
+- regular definitions in the format:
+
+     name   substitution
+
+  which serve to abbreviate common subexpressions. The {name} notation
+  causes the corresponding substitution from the definitions section to
+  be inserted into a regular expression. The name must be a legal
+  identifier (letter followed by a sequence of letters and digits;
+  the underscore counts as a letter; upper- and lowercase are distinct).
+  Regular definitions must be non-recursive.
+
+- start state definitions in the format:
+
+     %start name ...
+
+  which are used in specifying start conditions on rules (described
+  below). The %start keyword may also be abbreviated as %s or %S.
+
+- Turbo Pascal declarations enclosed between %{ and %}. These will be
+  inserted into the output file (at global scope). Also, any line that
+  does not look like a Lex definition (e.g., starts with blank or tab)
+  will be treated as Turbo Pascal code. (In particular, this also allows
+  you to include Turbo Pascal comments in your Lex program.)
+
+The rules section of a TP Lex program contains the actual specification of
+the lexical analyzer routine. It may be thought of as a big CASE statement
+discriminating over the different patterns to be matched and listing the
+corresponding statements (actions) to be executed. Each rule consists of a
+regular expression describing the strings to be matched in the input, and a
+corresponding action, a Turbo Pascal statement to be executed when the
+expression matches. Expression and statement are delimited with whitespace
+(blanks and/or tabs). Thus the format of a Lex grammar rule is:
+
+   expression      statement;
+
+Note that the action must be a single Turbo Pascal statement terminated
+with a semicolon (use begin ... end for compound statements). The statement
+may span multiple lines if the successor lines are indented with at least
+one blank or tab. The action may also be replaced by the | character,
+indicating that the action for this rule is the same as that for the next
+one.
+
+The TP Lex library unit provides various variables and routines which are
+useful in the programming of actions. In particular, the yytext string
+variable holds the text of the matched string, and the yyleng Byte variable
+its length.
+
+Regular expressions are used to describe the strings to be matched in a
+grammar rule. They are built from the usual constructs describing character
+classes and sequences, and operators specifying repetitions and alternatives.
+The precise format of regular expressions is described in the next section.
+
+The rules section may also start with some Turbo Pascal declarations
+(enclosed in %{ %}) which are treated as local declarations of the
+actions routine.
+
+Finally, the auxiliary procedures section may contain arbitrary Turbo
+Pascal code (such as supporting routines or a main program) which is
+simply tacked on to the end of the output file. The auxiliary procedures
+section is optional.
+
+
+Regular Expressions
+-------------------
+
+The following table summarizes the format of the regular expressions
+recognized by TP Lex (also compare Aho, Sethi, Ullman 1986, fig. 3.48).
+c stands for a single character, s for a string, r for a regular expression,
+and n,m for nonnegative integers.
+
+expression   matches                        example
+----------   ----------------------------   -------
+c            any non-operator character c   a
+\c           character c literally          \*
+"s"          string s literally             "**"
+.            any character but newline      a.*b
+^            beginning of line              ^abc
+$            end of line                    abc$
+[s]          any character in s             [abc]
+[^s]         any character not in s         [^abc]
+r*           zero or more r's               a*
+r+           one or more r's                a+
+r?           zero or one r                  a?
+r{m,n}       m to n occurrences of r        a{1,5}
+r{m}         m occurrences of r             a{5}
+r1r2         r1 then r2                     ab
+r1|r2        r1 or r2                       a|b
+(r)          r                              (a|b)
+r1/r2        r1 when followed by r2         a/b
+<x>r         r when in start condition x    <x>abc
+---------------------------------------------------
+
+The operators *, +, ? and {} have highest precedence, followed by
+concatenation. The | operator has lowest precedence. Parentheses ()
+may be used to group expressions and overwrite default precedences.
+The <> and / operators may only occur once in an expression.
+
+The usual C-like escapes are recognized:
+
+\n     denotes newline
+\r     denotes carriage return
+\t     denotes tab
+\b     denotes backspace
+\f     denotes form feed
+\NNN   denotes character no. NNN in octal base
+
+You can also use the \ character to quote characters which would otherwise
+be interpreted as operator symbols. In character classes, you may use
+the - character to denote ranges of characters. For instance, [a-z]
+denotes the class of all lowercase letters.
+
+The expressions in a TP Lex program may be ambigious, i.e. there may be inputs
+which match more than one rule. In such a case, the lexical analyzer prefers
+the longest match and, if it still has the choice between different rules,
+it picks the first of these. If no rule matches, the lexical analyzer
+executes a default action which consists of copying the input character
+to the output unchanged. Thus, if the purpose of a lexical analyzer is
+to translate some parts of the input, and leave the rest unchanged, you
+only have to specify the patterns which have to be treated specially. If,
+however, the lexical analyzer has to absorb its whole input, you will have
+to provide rules that match everything. E.g., you might use the rules
+
+   .   |
+   \n  ;
+
+which match "any other character" (and ignore it).
+
+Sometimes certain patterns have to be analyzed differently depending on some
+amount of context in which the pattern appears. In such a case the / operator
+is useful. For instance, the expression a/b matches a, but only if followed
+by b. Note that the b does not belong to the match; rather, the lexical
+analyzer, when matching an a, will look ahead in the input to see whether
+it is followed by a b, before it declares that it has matched an a. Such
+lookahead may be arbitrarily complex (up to the size of the LexLib input
+buffer). E.g., the pattern a/.*b matches an a which is followed by a b
+somewhere on the same input line. TP Lex also has a means to specify left
+context which is described in the next section.
+
+
+Start Conditions
+----------------
+
+TP Lex provides some features which make it possible to handle left context.
+The ^ character at the beginning of a regular expression may be used to
+denote the beginning of the line. More distant left context can be described
+conveniently by using start conditions on rules.
+
+Any rule which is prefixed with the <> construct is only valid if the lexical
+analyzer is in the denoted start state. For instance, the expression <x>a
+can only be matched if the lexical analyzer is in start state x. You can have
+multiple start states in a rule; e.g., <x,y>a can be matched in start states
+x or y.
+
+Start states have to be declared in the definitions section by means of
+one or more start state definitions (see above). The lexical analyzer enters
+a start state through a call to the LexLib routine start. E.g., you may
+write:
+
+%start x y
+%%
+<x>a    start(y);
+<y>b    start(x);
+%%
+begin
+  start(x); if yylex=0 then ;
+end.
+
+Upon initialization, the lexical analyzer is put into state x. It then
+proceeds in state x until it matches an a which puts it into state y.
+In state y it may match a b which puts it into state x again, etc.
+
+Start conditions are useful when certain constructs have to be analyzed
+differently depending on some left context (such as a special character
+at the beginning of the line), and if multiple lexical analyzers have to
+work in concert. If a rule is not prefixed with a start condition, it is
+valid in all user-defined start states, as well as in the lexical analyzer's
+default start state.
+
+
+Lex Library
+-----------
+
+The TP Lex library (LexLib) unit provides various variables and routines
+which are used by Lex-generated lexical analyzers and application programs.
+It provides the input and output streams and other internal data structures
+used by the lexical analyzer routine, and supplies some variables and utility
+routines which may be used by actions and application programs. Refer to
+the file lexlib.pas for a closer description.
+
+You can also modify the Lex library unit (and/or the code template in the
+yylex.cod file) to customize TP Lex to your target applications. E.g.,
+you might wish to optimize the code of the lexical analyzer for some
+special application, make the analyzer read from/write to memory instead
+of files, etc.
+
+
+Implementation Restrictions
+---------------------------
+
+Internal table sizes and the main memory available limit the complexity of
+source grammars that TP Lex can handle. There is currently no possibility to
+change internal table sizes (apart from modifying the sources of TP Lex
+itself), but the maximum table sizes provided by TP Lex seem to be large
+enough to handle most realistic applications. The actual table sizes depend on
+the particular implementation (they are much larger than the defaults if TP
+Lex has been compiled with one of the 32 bit compilers such as Delphi 2 or
+Free Pascal), and are shown in the statistics printed by TP Lex when a
+compilation is finished. The units given there are "p" (positions, i.e. items
+in the position table used to construct the DFA), "s" (DFA states) and "t"
+(transitions of the generated DFA).
+
+As implemented, the generated DFA table is stored as a typed array constant
+which is inserted into the yylex.cod code template. The transitions in each
+state are stored in order. Of course it would have been more efficient to
+generate a big CASE statement instead, but I found that this may cause
+problems with the encoding of large DFA tables because Turbo Pascal has
+a quite rigid limit on the code size of individual procedures. I decided to
+use a scheme in which transitions on different symbols to the same state are
+merged into one single transition (specifying a character set and the
+corresponding next state). This keeps the number of transitions in each state
+quite small and still allows a fairly efficient access to the transition
+table.
+
+The TP Lex program has an option (-o) to optimize DFA tables. This causes a
+minimal DFA to be generated, using the algorithm described in Aho, Sethi,
+Ullman (1986). Although the absolute limit on the number of DFA states that TP
+Lex can handle is at least 300, TP Lex poses an additional restriction (100)
+on the number of states in the initial partition of the DFA optimization
+algorithm. Thus, you may get a fatal `integer set overflow' message when using
+the -o option even when TP Lex is able to generate an unoptimized DFA. In such
+cases you will just have to be content with the unoptimized DFA. (Hopefully,
+this will be fixed in a future version. Anyhow, using the merged transitions
+scheme described above, TP Lex usually constructs unoptimized DFA's which are
+not far from being optimal, and thus in most cases DFA optimization won't have
+a great impact on DFA table sizes.)
+
+
+Differences from UNIX Lex
+-------------------------
+
+Major differences between TP Lex and UNIX Lex are listed below.
+
+- TP Lex produces output code for Turbo Pascal, rather than for C.
+
+- Character tables (%T) are not supported; neither are any directives
+  to determine internal table sizes (%p, %n, etc.).
+
+- Library routines are named differently from the UNIX version (e.g.,
+  the `start' routine takes the place of the `BEGIN' macro of UNIX
+  Lex), and, of course, all macros of UNIX Lex (ECHO, REJECT, etc.) had
+  to be implemented as procedures.
+
+- The TP Lex library unit starts counting line numbers at 0, incrementing
+  the count BEFORE a line is read (in contrast, UNIX Lex initializes
+  yylineno to 1 and increments it AFTER the line end has been read). This
+  is motivated by the way in which TP Lex maintains the current line,
+  and will not affect your programs unless you explicitly reset the
+  yylineno value (e.g., when opening a new input file). In such a case
+  you should set yylineno to 0 rather than 1.
+
+
+
+
+TP Yacc
+=======
+
+This section describes the TP Yacc compiler compiler.
+
+
+Usage
+-----
+
+yacc [options] yacc-file[.y] [output-file[.pas]]
+
+
+Options
+-------
+
+-v  "Verbose:" TP Yacc generates a readable description of the generated
+    parser, written to yacc-file with new extension .lst.
+
+-d  "Debug:" TP Yacc generates parser with debugging output.
+
+
+Description
+-----------
+
+TP Yacc is a program that lets you prepare parsers from the description
+of input languages by BNF-like grammars. You simply specify the grammar
+for your target language, augmented with the Turbo Pascal code necessary
+to process the syntactic constructs, and TP Yacc translates your grammar
+into the Turbo Pascal code for a corresponding parser subroutine named
+yyparse.
+
+TP Yacc parses the source grammar contained in yacc-file (with default
+suffix .y) and writes the constructed parser subroutine to the specified
+output-file (with default suffix .pas); if no output file is specified,
+output goes to yacc-file with new suffix .pas. If any errors are found
+during compilation, error messages are written to the list file (yacc-file
+with new suffix .lst).
+
+The generated parser routine, yyparse, is declared as:
+
+   function yyparse : Integer;
+
+This routine may be called by your main program to execute the parser.
+The return value of the yyparse routine denotes success or failure of
+the parser (possible return values: 0 = success, 1 = unrecoverable syntax
+error or parse stack overflow).
+
+Similar to TP Lex, the code template for the yyparse routine may be found in
+the yyparse.cod file. The rules for locating this file are analogous to those
+of TP Lex (see Section `TP Lex').
+
+The TP Yacc library (YaccLib) unit is required by programs using Yacc-
+generated parsers; you will therefore have to put an appropriate uses clause
+into your program or unit that contains the parser routine. The YaccLib unit
+also provides some routines which may be used to control the actions of the
+parser. See the file yacclib.pas for further information.
+
+
+Yacc Source
+-----------
+
+A TP Yacc program consists of three sections separated with the %% delimiter:
+
+definitions
+%%
+rules
+%%
+auxiliary procedures
+
+
+The TP Yacc language is free-format: whitespace (blanks, tabs and newlines)
+is ignored, except if it serves as a delimiter. Comments have the C-like
+format /* ... */. They are treated as whitespace. Grammar symbols are denoted
+by identifiers which have the usual form (letter, including underscore,
+followed by a sequence of letters and digits; upper- and lowercase is
+distinct). The TP Yacc language also has some keywords which always start
+with the % character. Literals are denoted by characters enclosed in single
+quotes. The usual C-like escapes are recognized:
+
+\n     denotes newline
+\r     denotes carriage return
+\t     denotes tab
+\b     denotes backspace
+\f     denotes form feed
+\NNN   denotes character no. NNN in octal base
+
+
+Definitions
+-----------
+
+The first section of a TP Yacc grammar serves to define the symbols used in
+the grammar. It may contain the following types of definitions:
+
+- start symbol definition: A definition of the form
+
+     %start symbol
+
+  declares the start nonterminal of the grammar (if this definition is
+  omitted, TP Yacc assumes the left-hand side nonterminal of the first
+  grammar rule as the start symbol of the grammar).
+
+- terminal definitions: Definitions of the form
+
+     %token symbol ...
+
+  are used to declare the terminal symbols ("tokens") of the target
+  language. Any identifier not introduced in a %token definition will
+  be treated as a nonterminal symbol.
+
+  As far as TP Yacc is concerned, tokens are atomic symbols which do not
+  have an innert structure. A lexical analyzer must be provided which
+  takes on the task of tokenizing the input stream and return the
+  individual tokens and literals to the parser (see Section `Lexical
+  Analysis').
+
+- precedence definitions: Operator symbols (terminals) may be associated
+  with a precedence by means of a precedence definition which may have
+  one of the following forms
+
+     %left symbol ...
+     %right symbol ...
+     %nonassoc symbol ...
+
+  which are used to declare left-, right- and nonassociative operators,
+  respectively. Each precedence definition introduces a new precedence
+  level, lowest precedence first. E.g., you may write:
+
+     %nonassoc '<' '>' '=' GEQ LEQ NEQ  /* relational operators */
+     %left     '+' '-'  OR              /* addition operators */
+     %left     '*' '/' AND              /* multiplication operators */
+     %right    NOT UMINUS               /* unary operators */
+
+  A terminal identifier introduced in a precedence definition may, but
+  need not, appear in a %token definition as well.
+
+- type definitions: Any (terminal or nonterminal) grammar symbol may be
+  associated with a type identifier which is used in the processing of
+  semantic values. Type tags of the form <name> may be used in token and
+  precedence definitions to declare the type of a terminal symbol, e.g.:
+
+     %token <Real>  NUM
+     %left  <AddOp> '+' '-'
+
+  To declare the type of a nonterminal symbol, use a type definition of
+  the form:
+
+     %type <name> symbol ...
+
+  e.g.:
+
+     %type <Real> expr
+
+  In a %type definition, you may also omit the nonterminals, i.e. you
+  may write:
+
+     %type <name>
+
+  This is useful when a given type is only used with type casts (see
+  Section `Grammar Rules and Actions'), and is not associated with a
+  specific nonterminal.
+
+- Turbo Pascal declarations: You may also include arbitrary Turbo Pascal
+  code in the definitions section, enclosed in %{ %}. This code will be
+  inserted as global declarations into the output file, unchanged.
+
+
+Grammar Rules and Actions
+-------------------------
+
+The second part of a TP Yacc grammar contains the grammar rules for the
+target language. Grammar rules have the format
+
+   name : symbol ... ;
+
+The left-hand side of a rule must be an identifier (which denotes a
+nonterminal symbol). The right-hand side may be an arbitrary (possibly
+empty) sequence of nonterminal and terminal symbols (including literals
+enclosed in single quotes). The terminating semicolon may also be omitted.
+Different rules for the same left-hand side symbols may be written using
+the | character to separate the different alternatives:
+
+   name : symbol ...
+        | symbol ...
+        ...
+        ;
+
+For instance, to specify a simple grammar for arithmetic expressions, you
+may write:
+
+%left '+' '-'
+%left '*' '/'
+%token NUM
+%%
+expr : expr '+' expr
+     | expr '-' expr
+     | expr '*' expr
+     | expr '/' expr
+     | '(' expr ')'
+     | NUM
+     ;
+
+(The %left definitions at the beginning of the grammar are needed to specify
+the precedence and associativity of the operator symbols. This will be
+discussed in more detail in Section `Ambigious Grammars'.)
+
+Grammar rules may contain actions - Turbo Pascal statements enclosed in
+{ } - to be executed as the corresponding rules are recognized. Furthermore,
+rules may return values, and access values returned by other rules. These
+"semantic" values are written as $$ (value of the left-hand side nonterminal)
+and $i (value of the ith right-hand side symbol). They are kept on a special
+value stack which is maintained automatically by the parser.
+
+Values associated with terminal symbols must be set by the lexical analyzer
+(more about this in Section `Lexical Analysis'). Actions of the form $$ := $1
+can frequently be omitted, since it is the default action assumed by TP Yacc
+for any rule that does not have an explicit action.
+
+By default, the semantic value type provided by Yacc is Integer. You can
+also put a declaration like
+
+   %{
+   type YYSType = Real;
+   %}
+
+into the definitions section of your Yacc grammar to change the default value
+type. However, if you have different value types, the preferred method is to
+use type definitions as discussed in Section `Definitions'. When such type
+definitions are given, TP Yacc handles all the necessary details of the
+YYSType definition and also provides a fair amount of type checking which
+makes it easier to find type errors in the grammar.
+
+For instance, we may declare the symbols NUM and expr in the example above
+to be of type Real, and then use these values to evaluate an expression as
+it is parsed.
+
+%left '+' '-'
+%left '*' '/'
+%token <Real> NUM
+%type  <Real> expr
+%%
+expr : expr '+' expr   { $$ := $1+$3; }
+     | expr '-' expr   { $$ := $1-$3; }
+     | expr '*' expr   { $$ := $1*$3; }
+     | expr '/' expr   { $$ := $1/$3; }
+     | '(' expr ')'    { $$ := $2;    }
+     | NUM
+     ;
+
+(Note that we omitted the action of the last rule. The "copy action"
+$$ := $1 required by this rule is automatically added by TP Yacc.)
+
+Actions may not only appear at the end, but also in the middle of a rule
+which is useful to perform some processing before a rule is fully parsed.
+Such actions inside a rule are treated as special nonterminals which are
+associated with an empty right-hand side. Thus, a rule like
+
+   x : y { action; } z
+
+will be treated as:
+
+  x : y $act z
+  $act : { action; }
+
+Actions inside a rule may also access values to the left of the action,
+and may return values by assigning to the $$ value. The value returned
+by such an action can then be accessed by other actions using the usual $i
+notation. E.g., we may write:
+
+   x : y { $$ := 2*$1; } z { $$ := $2+$3; }
+
+which has the effect of setting the value of x to
+
+   2*(the value of y)+(the value of z).
+
+Sometimes it is desirable to access values in enclosing rules. This can be
+done using the notation $i with i<=0. $0 refers to the first value "to the
+left" of the current rule, $-1 to the second, and so on. Note that in this
+case the referenced value depends on the actual contents of the parse stack,
+so you have to make sure that the requested values are always where you
+expect them.
+
+There are some situations in which TP Yacc cannot easily determine the
+type of values (when a typed parser is used). This is true, in particular,
+for values in enclosing rules and for the $$ value in an action inside a
+rule. In such cases you may use a type cast to explicitly specify the type
+of a value. The format for such type casts is $<name>$ (for left-hand side
+values) and $<name>i (for right-hand side values) where name is a type
+identifier (which must occur in a %token, precedence or %type definition).
+
+
+Auxiliary Procedures
+--------------------
+
+The third section of a TP Yacc program is optional. If it is present, it
+may contain any Turbo Pascal code (such as supporting routines or a main
+program) which is tacked on to the end of the output file.
+
+
+Lexical Analysis
+----------------
+
+For any TP Yacc-generated parser, the programmer must supply a lexical
+analyzer routine named yylex which performs the lexical analysis for
+the parser. This routine must be declared as
+
+   function yylex : Integer;
+
+The yylex routine may either be prepared by hand, or by using the lexical
+analyzer generator TP Lex (see Section `TP Lex').
+
+The lexical analyzer must be included in your main program behind the
+parser subroutine (the yyparse code template includes a forward
+definition of the yylex routine such that the parser can access the
+lexical analyzer). For instance, you may put the lexical analyzer
+routine into the auxiliary procedures section of your TP Yacc grammar,
+either directly, or by using the the Turbo Pascal include directive
+($I).
+
+The parser repeatedly calls the yylex routine to tokenize the input
+stream and obtain the individual lexical items in the input. For any
+literal character, the yylex routine has to return the corresponding
+character code. For the other, symbolic, terminals of the input language,
+the lexical analyzer must return corresponding Integer codes. These are
+assigned automatically by TP Yacc in the order in which token definitions
+appear in the definitions section of the source grammar. The lexical
+analyzer can access these values through corresponding Integer constants
+which are declared by TP Yacc in the output file.
+
+For instance, if
+
+   %token NUM
+
+is the first definition in the Yacc grammar, then TP Yacc will create
+a corresponding constant declaration
+
+   const NUM = 257;
+
+in the output file (TP Yacc automatically assigns symbolic token numbers
+starting at 257; 1 thru 255 are reserved for character literals, 0 denotes
+end-of-file, and 256 is reserved for the special error token which will be
+discussed in Section `Error Handling'). This definition may then be used,
+e.g., in a corresponding TP Lex program as follows:
+
+   [0-9]+   return(NUM);
+
+You can also explicitly assign token numbers in the grammar. For this
+purpose, the first occurrence of a token identifier in the definitions
+section may be followed by an unsigned integer. E.g. you may write:
+
+   %token NUM 299
+
+Besides the return value of yylex, the lexical analyzer routine may also
+return an additional semantic value for the recognized token. This value
+is assigned to a variable named "yylval" and may then be accessed in actions
+through the $i notation (see above, Section `Grammar Rules and Actions').
+The yylval variable is of type YYSType (the semantic value type, Integer
+by default); its declaration may be found in the yyparse.cod file.
+
+For instance, to assign an Integer value to a NUM token in the above
+example, we may write:
+
+   [0-9]+   begin
+              val(yytext, yylval, code);
+              return(NUM);
+            end;
+
+This assigns yylval the value of the NUM token (using the Turbo Pascal
+standard procedure val).
+
+If a parser uses tokens of different types (via a %token <name> definition),
+then the yylval variable will not be of type Integer, but instead of a
+corresponding variant record type which is capable of holding all the
+different value types declared in the TP Yacc grammar. In this case, the
+lexical analyzer must assign a semantic value to the corresponding record
+component which is named yy<name> (where <name> stands for the corresponding
+type identifier).
+
+E.g., if token NUM is declared Real:
+
+   %token <Real> NUM
+
+then the value for token NUM must be assigned to yylval.yyReal.
+
+
+How The Parser Works
+--------------------
+
+TP Yacc uses the LALR(1) technique developed by Donald E. Knuth and F.
+DeRemer to construct a simple, efficient, non-backtracking bottom-up
+parser for the source grammar. The LALR parsing technique is described
+in detail in Aho/Sethi/Ullman (1986). It is quite instructive to take a
+look at the parser description TP Yacc generates from a small sample
+grammar, to get an idea of how the LALR parsing algorithm works. We
+consider the following simplified version of the arithmetic expression
+grammar:
+
+%token NUM
+%left '+'
+%left '*'
+%%
+expr : expr '+' expr
+     | expr '*' expr
+     | '(' expr ')'
+     | NUM
+     ;
+
+When run with the -v option on the above grammar, TP Yacc generates the
+parser description listed below.
+
+state 0:
+
+	$accept : _ expr $end
+
+	'('	shift 2
+	NUM	shift 3
+	.	error
+
+	expr	goto 1
+
+state 1:
+
+	$accept : expr _ $end
+	expr : expr _ '+' expr
+	expr : expr _ '*' expr
+
+	$end	accept
+	'*'	shift 4
+	'+'	shift 5
+	.	error
+
+state 2:
+
+	expr : '(' _ expr ')'
+
+	'('	shift 2
+	NUM	shift 3
+	.	error
+
+	expr	goto 6
+
+state 3:
+
+	expr : NUM _	(4)
+
+	.	reduce 4
+
+state 4:
+
+	expr : expr '*' _ expr
+
+	'('	shift 2
+	NUM	shift 3
+	.	error
+
+	expr	goto 7
+
+state 5:
+
+	expr : expr '+' _ expr
+
+	'('	shift 2
+	NUM	shift 3
+	.	error
+
+	expr	goto 8
+
+state 6:
+
+	expr : '(' expr _ ')'
+	expr : expr _ '+' expr
+	expr : expr _ '*' expr
+
+	')'	shift 9
+	'*'	shift 4
+	'+'	shift 5
+	.	error
+
+state 7:
+
+	expr : expr '*' expr _	(2)
+	expr : expr _ '+' expr
+	expr : expr _ '*' expr
+
+	.	reduce 2
+
+state 8:
+
+	expr : expr '+' expr _	(1)
+	expr : expr _ '+' expr
+	expr : expr _ '*' expr
+
+	'*'	shift 4
+	$end	reduce 1
+	')'	reduce 1
+	'+'	reduce 1
+	.	error
+
+state 9:
+
+	expr : '(' expr ')' _	(3)
+
+	.	reduce 3
+
+
+Each state of the parser corresponds to a certain prefix of the input
+which has already been seen. The parser description lists the grammar
+rules wich are parsed in each state, and indicates the portion of each
+rule which has already been parsed by an underscore. In state 0, the
+start state of the parser, the parsed rule is
+
+	$accept : expr $end
+
+This is not an actual grammar rule, but a starting rule automatically
+added by TP Yacc. In general, it has the format
+
+	$accept : X $end
+
+where X is the start nonterminal of the grammar, and $end is a pseudo
+token denoting end-of-input (the $end symbol is used by the parser to
+determine when it has successfully parsed the input).
+
+The description of the start rule in state 0,
+
+	$accept : _ expr $end
+
+with the underscore positioned before the expr symbol, indicates that
+we are at the beginning of the parse and are ready to parse an expression
+(nonterminal expr).
+
+The parser maintains a stack to keep track of states visited during the
+parse. There are two basic kinds of actions in each state: "shift", which
+reads an input symbol and pushes the corresponding next state on top of
+the stack, and "reduce" which pops a number of states from the stack
+(corresponding to the number of right-hand side symbols of the rule used
+in the reduction) and consults the "goto" entries of the uncovered state
+to find the transition corresponding to the left-hand side symbol of the
+reduced rule.
+
+In each step of the parse, the parser is in a given state (the state on
+top of its stack) and may consult the current "lookahead symbol", the
+next symbol in the input, to determine the parse action - shift or reduce -
+to perform. The parser terminates as soon as it reaches state 1 and reads
+in the endmarker, indicated by the "accept" action on $end in state 1.
+
+Sometimes the parser may also carry out an action without inspecting the
+current lookahead token. This is the case, e.g., in state 3 where the
+only action is reduction by rule 4:
+
+	.	reduce 4
+
+The default action in a state can also be "error" indicating that any
+other input represents a syntax error. (In case of such an error the
+parser will start syntactic error recovery, as described in Section
+`Error Handling'.)
+
+Now let us see how the parser responds to a given input. We consider the
+input string 2+5*3 which is presented to the parser as the token sequence:
+
+   NUM + NUM * NUM
+
+The following table traces the corresponding actions of the parser. We also
+show the current state in each move, and the remaining states on the stack.
+
+State  Stack         Lookahead  Action
+-----  ------------  ---------  --------------------------------------------
+
+0                    NUM        shift state 3
+
+3      0                        reduce rule 4 (pop 1 state, uncovering state
+                                0, then goto state 1 on symbol expr)
+
+1      0             +          shift state 5
+
+5      1 0           NUM        shift state 3
+
+3      5 1 0                    reduce rule 4 (pop 1 state, uncovering state
+                                5, then goto state 8 on symbol expr)
+
+8      5 1 0         *          shift 4
+
+4      8 5 1 0       NUM        shift 3
+
+3      4 8 5 1 0                reduce rule 4 (pop 1 state, uncovering state
+                                4, then goto state 7 on symbol expr)
+
+7      4 8 5 1 0                reduce rule 2 (pop 3 states, uncovering state
+                                5, then goto state 8 on symbol expr)
+
+8      5 1 0         $end       reduce rule 1 (pop 3 states, uncovering state
+                                0, then goto state 1 on symbol expr)
+
+1      0             $end       accept
+
+It is also instructive to see how the parser responds to illegal inputs.
+E.g., you may try to figure out what the parser does when confronted with:
+
+   NUM + )
+
+or:
+
+   ( NUM * NUM
+
+You will find that the parser, sooner or later, will always run into an
+error action when confronted with errorneous inputs. An LALR parser will
+never shift an invalid symbol and thus will always find syntax errors as
+soon as it is possible during a left-to-right scan of the input.
+
+TP Yacc provides a debugging option (-d) that may be used to trace the
+actions performed by the parser. When a grammar is compiled with the
+-d option, the generated parser will print out the actions as it parses
+its input.
+
+
+Ambigious Grammars
+------------------
+
+There are situations in which TP Yacc will not produce a valid parser for
+a given input language. LALR(1) parsers are restricted to one-symbol
+lookahead on which they have to base their parsing decisions. If a
+grammar is ambigious, or cannot be parsed unambigiously using one-symbol
+lookahead, TP Yacc will generate parsing conflicts when constructing the
+parse table. There are two types of such conflicts: shift/reduce conflicts
+(when there is both a shift and a reduce action for a given input symbol
+in a given state), and reduce/reduce conflicts (if there is more than
+one reduce action for a given input symbol in a given state). Note that
+there never will be a shift/shift conflict.
+
+When a grammar generates parsing conflicts, TP Yacc prints out the number
+of shift/reduce and reduce/reduce conflicts it encountered when constructing
+the parse table. However, TP Yacc will still generate the output code for the
+parser. To resolve parsing conflicts, TP Yacc uses the following built-in
+disambiguating rules:
+
+- in a shift/reduce conflict, TP Yacc chooses the shift action.
+
+- in a reduce/reduce conflict, TP Yacc chooses reduction of the first
+  grammar rule.
+
+The shift/reduce disambiguating rule correctly resolves a type of
+ambiguity known as the "dangling-else ambiguity" which arises in the
+syntax of conditional statements of many programming languages (as in
+Pascal):
+
+%token IF THEN ELSE
+%%
+stmt : IF expr THEN stmt
+     | IF expr THEN stmt ELSE stmt
+     ;
+
+This grammar is ambigious, because a nested construct like
+
+   IF expr-1 THEN IF expr-2 THEN stmt-1 ELSE stmt-2
+
+can be parsed two ways, either as:
+
+   IF expr-1 THEN ( IF expr-2 THEN stmt-1 ELSE stmt-2 )
+
+or as:
+
+   IF expr-1 THEN ( IF expr-2 THEN stmt-1 ) ELSE stmt-2
+
+The first interpretation makes an ELSE belong to the last unmatched
+IF which also is the interpretation chosen in most programming languages.
+This is also the way that a TP Yacc-generated parser will parse the construct
+since the shift/reduce disambiguating rule has the effect of neglecting the
+reduction of IF expr-2 THEN stmt-1; instead, the parser will shift the ELSE
+symbol which eventually leads to the reduction of IF expr-2 THEN stmt-1 ELSE
+stmt-2.
+
+The reduce/reduce disambiguating rule is used to resolve conflicts that
+arise when there is more than one grammar rule matching a given construct.
+Such ambiguities are often caused by "special case constructs" which may be
+given priority by simply listing the more specific rules ahead of the more
+general ones.
+
+For instance, the following is an excerpt from the grammar describing the
+input language of the UNIX equation formatter EQN:
+
+%right SUB SUP
+%%
+expr : expr SUB expr SUP expr
+     | expr SUB expr
+     | expr SUP expr
+     ;
+
+Here, the SUB and SUP operator symbols denote sub- and superscript,
+respectively. The rationale behind this example is that an expression
+involving both sub- and superscript is often set differently from a
+superscripted subscripted expression. This special case is therefore
+caught by the first rule in the above example which causes a reduce/reduce
+conflict with rule 3 in expressions like expr-1 SUB expr-2 SUP expr-3.
+The conflict is resolved in favour of the first rule.
+
+In both cases discussed above, the ambiguities could also be eliminated
+by rewriting the grammar accordingly (although this yields more complicated
+and less readable grammars). This may not always be the case. Often
+ambiguities are also caused by design errors in the grammar. Hence, if
+TP Yacc reports any parsing conflicts when constructing the parser, you
+should use the -v option to generate the parser description (.lst file)
+and check whether TP Yacc resolved the conflicts correctly.
+
+There is one type of syntactic constructs for which one often deliberately
+uses an ambigious grammar as a more concise representation for a language
+that could also be specified unambigiously: the syntax of expressions.
+For instance, the following is an unambigious grammar for simple arithmetic
+expressions:
+
+%token NUM
+
+%%
+
+expr	: term
+	| expr '+' term
+        ;
+
+term	: factor
+	| term '*' factor
+        ;
+
+factor	: '(' expr ')'
+	| NUM
+        ;
+
+You may check yourself that this grammar gives * a higher precedence than
++ and makes both operators left-associative. The same effect can be achieved
+with the following ambigious grammar using precedence definitions:
+
+%token NUM
+%left '+'
+%left '*'
+%%
+expr : expr '+' expr
+     | expr '*' expr
+     | '(' expr ')'
+     | NUM
+     ;
+
+Without the precedence definitions, this is an ambigious grammar causing
+a number of shift/reduce conflicts. The precedence definitions are used
+to correctly resolve these conflicts (conflicts resolved using precedence
+will not be reported by TP Yacc).
+
+Each precedence definition introduces a new precedence level (lowest
+precedence first) and specifies whether the corresponding operators
+should be left-, right- or nonassociative (nonassociative operators
+cannot be combined at all; example: relational operators in Pascal).
+
+TP Yacc uses precedence information to resolve shift/reduce conflicts as
+follows. Precedences are associated with each terminal occuring in a
+precedence definition. Furthermore, each grammar rule is given the
+precedence of its rightmost terminal (this default choice can be
+overwritten using a %prec tag; see below). To resolve a shift/reduce
+conflict using precedence, both the symbol and the rule involved must
+have been assigned precedences. TP Yacc then chooses the parse action
+as follows:
+
+- If the symbol has higher precedence than the rule: shift.
+
+- If the rule has higher precedence than the symbol: reduce.
+
+- If symbol and rule have the same precedence, the associativity of the
+  symbol determines the parse action: if the symbol is left-associative:
+  reduce; if the symbol is right-associative: shift; if the symbol is
+  non-associative: error.
+
+To give you an idea of how this works, let us consider our ambigious
+arithmetic expression grammar (without precedences):
+
+%token NUM
+%%
+expr : expr '+' expr
+     | expr '*' expr
+     | '(' expr ')'
+     | NUM
+     ;
+
+This grammar generates four shift/reduce conflicts. The description
+of state 8 reads as follows:
+
+state 8:
+
+	*** conflicts:
+
+	shift 4, reduce 1 on '*'
+	shift 5, reduce 1 on '+'
+
+	expr : expr '+' expr _	(1)
+	expr : expr _ '+' expr
+	expr : expr _ '*' expr
+
+	'*'	shift 4
+	'+'	shift 5
+	$end	reduce 1
+	')'	reduce 1
+	.	error
+
+In this state, we have successfully parsed a + expression (rule 1). When
+the next symbol is + or *, we have the choice between the reduction and
+shifting the symbol. Using the default shift/reduce disambiguating rule,
+TP Yacc has resolved these conflicts in favour of shift.
+
+Now let us assume the above precedence definition:
+
+   %left '+'
+   %left '*'
+
+which gives * higher precedence than + and makes both operators left-
+associative. The rightmost terminal in rule 1 is +. Hence, given these
+precedence definitions, the first conflict will be resolved in favour
+of shift (* has higher precedence than +), while the second one is resolved
+in favour of reduce (+ is left-associative).
+
+Similar conflicts arise in state 7:
+
+state 7:
+
+	*** conflicts:
+
+	shift 4, reduce 2 on '*'
+	shift 5, reduce 2 on '+'
+
+	expr : expr '*' expr _	(2)
+	expr : expr _ '+' expr
+	expr : expr _ '*' expr
+
+	'*'	shift 4
+	'+'	shift 5
+	$end	reduce 2
+	')'	reduce 2
+	.	error
+
+Here, we have successfully parsed a * expression which may be followed
+by another + or * operator. Since * is left-associative and has higher
+precedence than +, both conflicts will be resolved in favour of reduce.
+
+Of course, you can also have different operators on the same precedence
+level. For instance, consider the following extended version of the
+arithmetic expression grammar:
+
+%token NUM
+%left '+' '-'
+%left '*' '/'
+%%
+expr	: expr '+' expr
+	| expr '-' expr
+        | expr '*' expr
+        | expr '/' expr
+        | '(' expr ')'
+        | NUM
+        ;
+
+This puts all "addition" operators on the first and all "multiplication"
+operators on the second precedence level. All operators are left-associative;
+for instance, 5+3-2 will be parsed as (5+3)-2.
+
+By default, TP Yacc assigns each rule the precedence of its rightmost
+terminal. This is a sensible decision in most cases. Occasionally, it
+may be necessary to overwrite this default choice and explicitly assign
+a precedence to a rule. This can be done by putting a precedence tag
+of the form
+
+   %prec symbol
+
+at the end of the corresponding rule which gives the rule the precedence
+of the specified symbol. For instance, to extend the expression grammar
+with a unary minus operator, giving it highest precedence, you may write:
+
+%token NUM
+%left '+' '-'
+%left '*' '/'
+%right UMINUS
+%%
+expr	: expr '+' expr
+	| expr '-' expr
+        | expr '*' expr
+        | expr '/' expr
+        | '-' expr      %prec UMINUS
+        | '(' expr ')'
+        | NUM
+        ;
+
+Note the use of the UMINUS token which is not an actual input symbol but
+whose sole purpose it is to give unary minus its proper precedence. If
+we omitted the precedence tag, both unary and binary minus would have the
+same precedence because they are represented by the same input symbol.
+
+
+Error Handling
+--------------
+
+Syntactic error handling is a difficult area in the design of user-friendly
+parsers. Usually, you will not like to have the parser give up upon the
+first occurrence of an errorneous input symbol. Instead, the parser should
+recover from a syntax error, that is, it should try to find a place in the
+input where it can resume the parse.
+
+TP Yacc provides a general mechanism to implement parsers with error
+recovery. A special predefined "error" token may be used in grammar rules
+to indicate positions where syntax errors might occur. When the parser runs
+into an error action (i.e., reads an errorneous input symbol) it prints out
+an error message and starts error recovery by popping its stack until it
+uncovers a state in which there is a shift action on the error token. If
+there is no such state, the parser terminates with return value 1, indicating
+an unrecoverable syntax error. If there is such a state, the parser takes the
+shift on the error token (pretending it has seen an imaginary error token in
+the input), and resumes parsing in a special "error mode."
+
+While in error mode, the parser quietly skips symbols until it can again
+perform a legal shift action. To prevent a cascade of error messages, the
+parser returns to its normal mode of operation only after it has seen
+and shifted three legal input symbols. Any additional error found after
+the first shifted symbol restarts error recovery, but no error message
+is printed. The TP Yacc library routine yyerrok may be used to reset the
+parser to its normal mode of operation explicitly.
+
+For a simple example, consider the rule
+
+stmt	: error ';' { yyerrok; }
+
+and assume a syntax error occurs while a statement (nonterminal stmt) is
+parsed. The parser prints an error message, then pops its stack until it
+can shift the token error of the error rule. Proceeding in error mode, it
+will skip symbols until it finds a semicolon, then reduces by the error
+rule. The call to yyerrok tells the parser that we have recovered from
+the error and that it should proceed with the normal parse. This kind of
+"panic mode" error recovery scheme works well when statements are always
+terminated with a semicolon. The parser simply skips the "bad" statement
+and then resumes the parse.
+
+Implementing a good error recovery scheme can be a difficult task; see
+Aho/Sethi/Ullman (1986) for a more comprehensive treatment of this topic.
+Schreiner and Friedman have developed a systematic technique to implement
+error recovery with Yacc which I found quite useful (I used it myself
+to implement error recovery in the TP Yacc parser); see Schreiner/Friedman
+(1985).
+
+
+Yacc Library
+------------
+
+The TP Yacc library (YaccLib) unit provides some global declarations used
+by the parser routine yyparse, and some variables and utility routines
+which may be used to control the actions of the parser and to implement
+error recovery. See the file yacclib.pas for a description of these
+variables and routines.
+
+You can also modify the Yacc library unit (and/or the code template in the
+yyparse.cod file) to customize TP Yacc to your target applications.
+
+
+Other Features
+--------------
+
+TP Yacc supports all additional language elements entitled as "Old Features
+Supported But not Encouraged" in the UNIX manual, which are provided for
+backward compatibility with older versions of (UNIX) Yacc:
+
+- literals delimited by double quotes.
+
+- multiple-character literals. Note that these are not treated as character
+  sequences but represent single tokens which are given a symbolic integer
+  code just like any other token identifier. However, they will not be
+  declared in the output file, so you have to make sure yourself that
+  the lexical analyzer returns the correct codes for these symbols. E.g.,
+  you might explicitly assign token numbers by using a definition like
+
+     %token ':=' 257
+
+  at the beginning of the Yacc grammar.
+
+- \ may be used instead of %, i.e. \\ means %%, \left is the same as %left,
+  etc.
+
+- other synonyms:
+  %<             for %left
+  %>             for %right
+  %binary or %2  for %nonassoc
+  %term or %0    for %token
+  %=             for %prec
+
+- actions may also be written as = { ... } or = single-statement;
+
+- Turbo Pascal declarations (%{ ... %}) may be put at the beginning of the
+  rules section. They will be treated as local declarations of the actions
+  routine.
+
+
+Implementation Restrictions
+---------------------------
+
+As with TP Lex, internal table sizes and the main memory available limit the
+complexity of source grammars that TP Yacc can handle. However, the maximum
+table sizes provided by TP Yacc are large enough to handle quite complex
+grammars (such as the Pascal grammar in the TP Yacc distribution). The actual
+table sizes are shown in the statistics printed by TP Yacc when a compilation
+is finished. The given figures are "s" (states), "i" (LR0 kernel items), "t"
+(shift and goto transitions) and "r" (reductions).
+
+The default stack size of the generated parsers is yymaxdepth = 1024, as
+declared in the TP Yacc library unit. This should be sufficient for any
+average application, but you can change the stack size by including a
+corresponding declaration in the definitions part of the Yacc grammar
+(or change the value in the YaccLib unit). Note that right-recursive
+grammar rules may increase stack space requirements, so it is a good
+idea to use left-recursive rules wherever possible.
+
+
+Differences from UNIX Yacc
+--------------------------
+
+Major differences between TP Yacc and UNIX Yacc are listed below.
+
+- TP Yacc produces output code for Turbo Pascal, rather than for C.
+
+- TP Yacc does not support %union definitions. Instead, a value type is
+  declared by specifying the type identifier itself as the tag of a %token
+  or %type definition. TP Yacc will automatically generate an appropriate
+  variant record type (YYSType) which is capable of holding values of any
+  of the types used in %token and %type.
+
+  Type checking is very strict. If you use type definitions, then
+  any symbol referred to in an action must have a type introduced
+  in a type definition. Either the symbol must have been assigned a
+  type in the definitions section, or the $<type-identifier> notation
+  must be used. The syntax of the %type definition has been changed
+  slightly to allow definitions of the form
+     %type <type-identifier>
+  (omitting the nonterminals) which may be used to declare types which
+  are not assigned to any grammar symbol, but are used with the
+  $<...> construct.
+
+- The parse tables constructed by this Yacc version are slightly greater
+  than those constructed by UNIX Yacc, since a reduce action will only be
+  chosen as the default action if it is the only action in the state.
+  In difference, UNIX Yacc chooses a reduce action as the default action
+  whenever it is the only reduce action of the state (even if there are
+  other shift actions).
+
+  This solves a bug in UNIX Yacc that makes the generated parser start
+  error recovery too late with certain types of error productions (see
+  also Schreiner/Friedman, "Introduction to compiler construction with
+  UNIX," 1985). Also, errors will be caught sooner in most cases where
+  UNIX Yacc would carry out an additional (default) reduction before
+  detecting the error.
+
+- Library routines are named differently from the UNIX version (e.g.,
+  the `yyerrlab' routine takes the place of the `YYERROR' macro of UNIX
+  Yacc), and, of course, all macros of UNIX Yacc (YYERROR, YYACCEPT, etc.)
+  had to be implemented as procedures.
+
+

utils/tply/tply.tex

@@ -0,0 +1,1642 @@
+
+\documentstyle[11pt]{article}
+
+\title{TP Lex and Yacc -- The Compiler Writer's Tools for Turbo Pascal\\
+       Version 4.1 User Manual}
+
+\author{Albert Gr\"af\\
+        Department of Musicinformatics\\
+        Johannes Gutenberg-University Mainz\\
+        \\
+        [email protected]}
+
+\date{April 1998}
+
+\setlength{\topmargin}{0cm}
+\setlength{\oddsidemargin}{0cm}
+\setlength{\evensidemargin}{0cm}
+\setlength{\textwidth}{16cm}
+\setlength{\textheight}{21cm}
+%\setlength{\parindent}{0pt}
+\parskip=4pt plus 1pt minus 1pt
+\itemsep=0pt
+\renewcommand{\baselinestretch}{1.1}
+\unitlength=1mm
+%\tolerance=500
+%\parskip=0.1cm
+\leftmargini 1.5em
+\leftmarginii 1.5em \leftmarginiii 1.5em \leftmarginiv 1.5em \leftmarginv 1.5em
+\leftmarginvi 1.5em
+
+\begin{document}
+
+\maketitle
+
+\tableofcontents
+
+\section{Introduction}
+
+This document describes the TP Lex and Yacc compiler generator toolset.
+These tools are designed especially to help you prepare compilers and
+similar programs like text processing utilities and command language
+interpreters with the Turbo Pascal (TM) programming language.
+
+TP Lex and Yacc are Turbo Pascal adaptions of the well-known UNIX (TM)
+utilities Lex and Yacc, which were written by M.E. Lesk and S.C. Johnson
+at Bell Laboratories, and are used with the C programming language. TP Lex
+and Yacc are intended to be approximately ``compatible'' with these programs.
+However, they are an independent development of the author, based on the
+techniques described in the famous ``dragon book'' of Aho, Sethi and Ullman
+(Aho, Sethi, Ullman: {\em Compilers : principles, techniques and tools,\/}
+Reading (Mass.), Addison-Wesley, 1986).
+
+Version 4.1 of TP Lex and Yacc works with all recent flavours of Turbo/Borland
+Pascal, including Delphi, and with the Free Pascal Compiler, a free Turbo
+Pascal-compatible compiler which currently runs on DOS and Linux (other ports
+are under development). Recent information about TP Lex/Yacc, and the sources
+are available from the TPLY homepage:
+\begin{quote}\begin{verbatim}
+   http://www.musikwissenschaft.uni-mainz.de/~ag/tply
+\end{verbatim}\end{quote}
+For information about the Free Pascal Compiler, please refer to:
+\begin{quote}\begin{verbatim}
+   http://tfdec1.fys.kuleuven.ac.be/~michael/fpc/fpc.html
+\end{verbatim}\end{quote}
+
+TP Lex and Yacc, like any other tools of this kind, are not intended for
+novices or casual programmers; they require extensive programming experience
+as well as a thorough understanding of the principles of parser design and
+implementation to be put to work successfully. But if you are a seasoned
+Turbo Pascal programmer with some background in compiler design and formal
+language theory, you will almost certainly find TP Lex and Yacc to be a
+powerful extension of your Turbo Pascal toolset.
+
+This manual tells you how to get started with the TP Lex and Yacc programs
+and provides a short description of these programs. Some knowledge about
+the C versions of Lex and Yacc will be useful, although not strictly
+necessary. For further reading, you may also refer to:
+
+\begin{itemize}
+   \item
+      Aho, Sethi and Ullman: {\em Compilers : principles, techniques and
+      tools.\/} Reading (Mass.), Addison-Wesley, 1986.
+   \item
+      Johnson, S.C.: {\em Yacc -- yet another compiler-compiler.\/} CSTR-32,
+      Bell Telephone Laboratories, 1974.
+   \item
+      Lesk, M.E.: {\em Lex -- a lexical analyser generator.\/} CSTR-39, Bell
+      Telephone Laboratories, 1975.
+   \item
+      Schreiner, Friedman: {\em Introduction to compiler construction with
+      UNIX.\/} Prentice-Hall, 1985.
+   \item
+      The Unix Programmer's Manual, Sections `Lex' and `Yacc'.
+\end{itemize}
+
+
+\subsection*{Credits}
+
+I would like to thank Berend de Boer ([email protected]), who adapted TP Lex
+and Yacc to take advantage of the large memory models in Borland Pascal 7.0
+and Delphi, and Michael Van Canneyt ([email protected]),
+the maintainer of the Linux version of the Free Pascal compiler, who is
+responsible for the Free Pascal port. And of course thanks are due to the many
+TP Lex/Yacc users all over the world for their support and comments which
+helped to improve these programs.
+
+
+\subsection*{Getting Started}
+
+Instructions on how to compile and install TP Lex and Yacc on all supported
+platforms can be found in the \verb"README" file contained in the
+distribution.
+
+Once you have installed TP Lex and Yacc on your system, you can compile your
+first TP Lex and Yacc program \verb"expr". \verb"Expr" is a simple desktop
+calculator program contained in the distribution, which consists of a lexical
+analyzer in the TP Lex source file \verb"exprlex.l" and the parser and main
+program in the TP Yacc source file \verb"expr.y". To compile these programs,
+issue the commands
+\begin{quote}\begin{verbatim}
+   lex exprlex
+   yacc expr
+\end{verbatim}\end{quote}
+That's it! You now have the Turbo Pascal sources (\verb"exprlex.pas" and
+\verb"expr.pas") for the \verb"expr" program. Use the Turbo Pascal
+compiler to compile these programs as follows:
+\begin{quote}\begin{verbatim}
+   tpc expr
+\end{verbatim}\end{quote}
+
+(Of course, the precise compilation command depends on the type of compiler
+you are using. Thus you may have to replace \verb"tpc" with \verb"bpc",
+\verb"dcc" or \verb"dcc32", depending on the version of the
+Turbo/Borland/Delphi compiler you have, and with \verb"ppc386" for the Free
+Pascal compiler. If you are using TP Lex and Yacc with Free Pascal under
+Linux, the corresponding commands are:
+\begin{quote}\begin{verbatim}
+   plex exprlex
+   pyacc expr
+   ppc386 expr
+\end{verbatim}\end{quote}
+Note that in the Linux version, the programs are named \verb"plex" and
+\verb"pyacc" to avoid name clashes with the corresponding UNIX utilities.)
+
+Having compiled \verb"expr.pas", you can execute the \verb"expr" program and
+type some expressions to see it work (terminate the program with an empty
+line).  There is a number of other sample TP Lex and Yacc programs (\verb".l"
+and \verb".y" files) in the distribution, including a TP Yacc cross reference
+utility and a complete parser for Standard Pascal.
+
+The TP Lex and Yacc programs recognize some options which may be specified
+anywhere on the command line. E.g.,
+\begin{quote}\begin{verbatim}
+   lex -o exprlex
+\end{verbatim}\end{quote}
+runs TP Lex with ``DFA optimization'' and
+\begin{quote}\begin{verbatim}
+   yacc -v expr
+\end{verbatim}\end{quote}
+runs TP Yacc in ``verbose'' mode (TP Yacc generates a readable description
+of the generated parser).
+
+The TP Lex and Yacc programs use the following default filename extensions:
+\begin{itemize}
+   \item \verb".l": TP Lex input files
+   \item \verb".y": TP Yacc input files
+   \item \verb".pas": TP Lex and Yacc output files
+\end{itemize}
+As usual, you may overwrite default filename extensions by explicitly
+specifying suffixes.
+
+If you ever forget how to run TP Lex and Yacc, you can issue the command
+\verb"lex" or \verb"yacc" (resp.\ \verb"plex" or \verb"pyacc")
+without arguments to get a short summary of the command line syntax.
+
+\section{TP Lex}
+
+This section describes the TP Lex lexical analyzer generator.
+
+\subsection{Usage}
+
+\begin{quote}\begin{verbatim}
+lex [options] lex-file[.l] [output-file[.pas]]
+\end{verbatim}\end{quote}
+
+\subsection{Options}
+
+\begin{description}
+   \item[\verb"-v"]
+      ``Verbose:'' Lex generates a readable description of the generated
+      lexical analyzer, written to lex-file with new extension \verb".lst".
+   \item[\verb"-o"]
+      ``Optimize:'' Lex optimizes DFA tables to produce a minimal DFA.
+\end{description}
+
+\subsection{Description}
+
+TP Lex is a program generator that is used to generate the Turbo Pascal
+source code for a lexical analyzer subroutine from the specification
+of an input language by a regular expression grammar.
+
+TP Lex parses the source grammar contained in \verb"lex-file" (with default
+suffix \verb".l") and writes the constructed lexical analyzer subroutine
+to the specified \verb"output-file" (with default suffix \verb".pas"); if no
+output file is specified, output goes to \verb"lex-file" with new suffix
+\verb".pas." If any errors are found during compilation, error messages are
+written to the list file (\verb"lex-file" with new suffix \verb".lst").
+
+The generated output file contains a lexical analyzer routine, \verb"yylex",
+implemented as:
+\begin{quote}\begin{verbatim}
+   function yylex : Integer;
+\end{verbatim}\end{quote}
+
+This routine has to be called by your main program to execute the lexical
+analyzer. The return value of the \verb"yylex" routine usually denotes the
+number of a token recognized by the lexical analyzer (see the \verb"return"
+routine in the \verb"LexLib" unit). At end-of-file the \verb"yylex" routine
+normally returns \verb"0".
+
+The code template for the \verb"yylex" routine may be found in the
+\verb"yylex.cod" file. This file is needed by TP Lex when it constructs the
+output file. It must be present either in the current directory or in the
+directory from which TP Lex was executed (TP Lex searches these directories in
+the indicated order). (NB: For the Linux/Free Pascal version, the code
+template is searched in some directory defined at compile-time instead of the
+execution path, usually /usr/lib/fpc/lexyacc.)
+
+The TP Lex library (\verb"LexLib") unit is required by programs using
+Lex-generated lexical analyzers; you will therefore have to put an appropriate
+\verb"uses" clause into your program or unit that contains the lexical
+analyzer routine. The \verb"LexLib" unit also provides various useful utility
+routines; see the file \verb"lexlib.pas" for further information.
+
+\subsection{Lex Source}
+
+A TP Lex program consists of three sections separated with the \verb"%%"
+delimiter:
+
+\begin{quote}\begin{verbatim}
+definitions
+%%
+rules
+%%
+auxiliary procedures
+\end{verbatim}\end{quote}
+
+All sections may be empty. The TP Lex language is line-oriented; definitions
+and rules are separated by line breaks. There is no special notation for
+comments, but (Turbo Pascal style) comments may be included as Turbo Pascal
+fragments (see below).
+
+The definitions section may contain the following elements:
+\begin{itemize}
+   \item
+      regular definitions in the format:
+      \begin{quote}\begin{verbatim}
+   name   substitution
+      \end{verbatim}\end{quote}
+      which serve to abbreviate common subexpressions. The \verb"{name}"
+      notation causes the corresponding substitution from the definitions
+      section to be inserted into a regular expression. The name must be
+      a legal identifier (letter followed by a sequence of letters and digits;
+      the underscore counts as a letter; upper- and lowercase are distinct).
+      Regular definitions must be non-recursive.
+   \item
+      start state definitions in the format:
+      \begin{quote}\begin{verbatim}
+   %start name ...
+      \end{verbatim}\end{quote}
+      which are used in specifying start conditions on rules (described
+      below). The \verb"%start" keyword may also be abbreviated as \verb"%s"
+      or \verb"%S".
+   \item
+      Turbo Pascal declarations enclosed between \verb"%{" and \verb"%}".
+      These will be inserted into the output file (at global scope). Also,
+      any line that does not look like a Lex definition (e.g., starts with
+      blank or tab) will be treated as Turbo Pascal code. (In particular,
+      this also allows you to include Turbo Pascal comments in your Lex
+      program.)
+\end{itemize}
+
+The rules section of a TP Lex program contains the actual specification of
+the lexical analyzer routine. It may be thought of as a big \verb"CASE"
+statement discriminating over the different patterns to be matched and listing the
+corresponding statements (actions) to be executed. Each rule consists of a
+regular expression describing the strings to be matched in the input, and a
+corresponding action, a Turbo Pascal statement to be executed when the
+expression matches. Expression and statement are delimited with whitespace
+(blanks and/or tabs). Thus the format of a Lex grammar rule is:
+
+\begin{quote}\begin{verbatim}
+   expression      statement;
+\end{verbatim}\end{quote}
+
+Note that the action must be a single Turbo Pascal statement terminated
+with a semicolon (use \verb"begin ... end" for compound statements). The
+statement may span multiple lines if the successor lines are indented with
+at least one blank or tab. The action may also be replaced by the \verb"|"
+character, indicating that the action for this rule is the same as that for
+the next one.
+
+The TP Lex library unit provides various variables and routines which are
+useful in the programming of actions. In particular, the \verb"yytext" string
+variable holds the text of the matched string, and the \verb"yyleng" Byte
+variable its length.
+
+Regular expressions are used to describe the strings to be matched in a
+grammar rule. They are built from the usual constructs describing character
+classes and sequences, and operators specifying repetitions and alternatives.
+The precise format of regular expressions is described in the next section.
+
+The rules section may also start with some Turbo Pascal declarations
+(enclosed in \verb"%{ %}") which are treated as local declarations of the
+actions routine.
+
+Finally, the auxiliary procedures section may contain arbitrary Turbo
+Pascal code (such as supporting routines or a main program) which is
+simply tacked on to the end of the output file. The auxiliary procedures
+section is optional.
+
+\subsection{Regular Expressions}
+
+Table \ref{tab1} summarizes the format of the regular expressions
+recognized by TP Lex (also compare Aho, Sethi, Ullman 1986, fig.\ 3.48).
+$c$ stands for a single character, $s$ for a string, $r$ for a regular
+expression, and $n,m$ for nonnegative integers.
+
+\begin{table*}\centering
+   \begin{tabular}{c|c|c}
+      \hline\hline
+      {\sc Expression}& {\sc Matches}& {\sc Example}\\
+      \hline
+      $c$& any non-operator character $c$& \verb"a"\\
+      \verb"\"$c$& character $c$ literally& \verb"\*"\\
+      \verb'"'$s$\verb'"'& string $s$ literally& \verb'"**"'\\
+      \verb"."& any character but newline& \verb"a.*b"\\
+      \verb"^"& beginning of line& \verb"^abc"\\
+      \verb"$"& end of line& \verb"abc$"\\
+      \verb"["$s$\verb"]"& any character in $s$& \verb"[abc]"\\
+      \verb"[^"$s$\verb"]"& any character not in $s$& \verb"[^abc]"\\
+      $r$\verb"*"& zero or more $r$'s& \verb"a*"\\
+      $r$\verb"+"& one or more $r$'s& \verb"a+"\\
+      $r$\verb"?"& zero or one $r$& \verb"a?"\\
+      $r$\verb"{"$m$\verb","$n$\verb"}"& $m$ to $n$ occurrences of $r$& \verb"a{1,5}"\\
+      $r$\verb"{"$m$\verb"}"& $m$ occurrences of $r$& \verb"a{5}"\\
+      $r_1r_2$& $r_1$ then $r_2$& \verb"ab"\\
+      $r_1$\verb"|"$r_2$& $r_1$ or $r_2$& \verb"a|b"\\
+      \verb"("$r$\verb")"& $r$& \verb"(a|b)"\\
+      $r_1$\verb"/"$r_2$& $r_1$ when followed by $r_2$& \verb"a/b"\\
+      \verb"<"$x$\verb">"$r$& $r$ when in start condition $x$& \verb"<x>abc"\\
+      \hline
+   \end{tabular}
+   \caption{Regular expressions.}
+   \label{tab1}
+\end{table*}
+
+The operators \verb"*", \verb"+", \verb"?" and \verb"{}" have highest
+precedence, followed by concatenation. The \verb"|" operator has lowest
+precedence. Parentheses \verb"()" may be used to group expressions and
+overwrite default precedences. The \verb"<>" and \verb"/" operators may only
+occur once in an expression.
+
+The usual C-like escapes are recognized:
+\begin{itemize}
+   \item \verb"\n"     denotes newline
+   \item \verb"\r"     denotes carriage return
+   \item \verb"\t"     denotes tab
+   \item \verb"\b"     denotes backspace
+   \item \verb"\f"     denotes form feed
+   \item \verb"\"$nnn$ denotes character no.\ $nnn$ in octal base
+\end{itemize}
+
+You can also use the \verb"\" character to quote characters which would
+otherwise be interpreted as operator symbols. In character classes, you may
+use the \verb"-" character to denote ranges of characters. For instance,
+\verb"[a-z]" denotes the class of all lowercase letters.
+
+The expressions in a TP Lex program may be ambigious, i.e. there may be inputs
+which match more than one rule. In such a case, the lexical analyzer prefers
+the longest match and, if it still has the choice between different rules,
+it picks the first of these. If no rule matches, the lexical analyzer
+executes a default action which consists of copying the input character
+to the output unchanged. Thus, if the purpose of a lexical analyzer is
+to translate some parts of the input, and leave the rest unchanged, you
+only have to specify the patterns which have to be treated specially. If,
+however, the lexical analyzer has to absorb its whole input, you will have
+to provide rules that match everything. E.g., you might use the rules
+\begin{quote}\begin{verbatim}
+   .   |
+   \n  ;
+\end{verbatim}\end{quote}
+which match ``any other character'' (and ignore it).
+
+Sometimes certain patterns have to be analyzed differently depending on some
+amount of context in which the pattern appears. In such a case the \verb"/"
+operator is useful. For instance, the expression \verb"a/b" matches \verb"a",
+but only if followed by \verb"b". Note that the \verb"b" does not belong to
+the match; rather, the lexical analyzer, when matching an \verb"a", will look
+ahead in the input to see whether it is followed by a \verb"b", before it
+declares that it has matched an \verb"a". Such lookahead may be arbitrarily
+complex (up to the size of the \verb"LexLib" input buffer). E.g., the pattern
+\verb"a/.*b" matches an \verb"a" which is followed by a \verb"b" somewhere on
+the same input line. TP Lex also has a means to specify left context which is
+described in the next section.
+
+\subsection{Start Conditions}
+
+TP Lex provides some features which make it possible to handle left context.
+The \verb"^" character at the beginning of a regular expression may be used
+to denote the beginning of the line. More distant left context can be described
+conveniently by using start conditions on rules.
+
+Any rule which is prefixed with the \verb"<>" construct is only valid if the
+lexical analyzer is in the denoted start state. For instance, the expression
+\verb"<x>a" can only be matched if the lexical analyzer is in start state
+\verb"x". You can have multiple start states in a rule; e.g., \verb"<x,y>a"
+can be matched in start states \verb"x" or \verb"y".
+
+Start states have to be declared in the definitions section by means of
+one or more start state definitions (see above). The lexical analyzer enters
+a start state through a call to the \verb"LexLib" routine \verb"start". E.g.,
+you may write:
+
+\begin{quote}\begin{verbatim}
+%start x y
+%%
+<x>a    start(y);
+<y>b    start(x);
+%%
+begin
+  start(x); if yylex=0 then ;
+end.
+\end{verbatim}\end{quote}
+
+Upon initialization, the lexical analyzer is put into state \verb"x". It then
+proceeds in state \verb"x" until it matches an \verb"a" which puts it into
+state \verb"y". In state \verb"y" it may match a \verb"b" which puts it into
+state \verb"x" again, etc.
+
+Start conditions are useful when certain constructs have to be analyzed
+differently depending on some left context (such as a special character
+at the beginning of the line), and if multiple lexical analyzers have to
+work in concert. If a rule is not prefixed with a start condition, it is
+valid in all user-defined start states, as well as in the lexical analyzer's
+default start state.
+
+\subsection{Lex Library}
+
+The TP Lex library (\verb"LexLib") unit provides various variables and
+routines which are used by Lex-generated lexical analyzers and application
+programs. It provides the input and output streams and other internal data
+structures used by the lexical analyzer routine, and supplies some variables
+and utility routines which may be used by actions and application programs.
+Refer to the file \verb"lexlib.pas" for a closer description.
+
+You can also modify the Lex library unit (and/or the code template in the
+\verb"yylex.cod" file) to customize TP Lex to your target applications. E.g.,
+you might wish to optimize the code of the lexical analyzer for some
+special application, make the analyzer read from/write to memory instead
+of files, etc.
+
+\subsection{Implementation Restrictions}
+
+Internal table sizes and the main memory available limit the complexity of
+source grammars that TP Lex can handle. There is currently no possibility to
+change internal table sizes (apart from modifying the sources of TP Lex
+itself), but the maximum table sizes provided by TP Lex seem to be large
+enough to handle most realistic applications. The actual table sizes depend on
+the particular implementation (they are much larger than the defaults if TP
+Lex has been compiled with one of the 32 bit compilers such as Delphi 2 or
+Free Pascal), and are shown in the statistics printed by TP Lex when a
+compilation is finished. The units given there are ``p'' (positions, i.e.
+items in the position table used to construct the DFA), ``s'' (DFA states) and
+``t'' (transitions of the generated DFA).
+
+As implemented, the generated DFA table is stored as a typed array constant
+which is inserted into the \verb"yylex.cod" code template. The transitions in
+each state are stored in order. Of course it would have been more efficient to
+generate a big \verb"CASE" statement instead, but I found that this may cause
+problems with the encoding of large DFA tables because Turbo Pascal has
+a quite rigid limit on the code size of individual procedures. I decided to
+use a scheme in which transitions on different symbols to the same state are
+merged into one single transition (specifying a character set and the
+corresponding next state). This keeps the number of transitions in each state
+quite small and still allows a fairly efficient access to the transition
+table.
+
+The TP Lex program has an option (\verb"-o") to optimize DFA tables. This
+causes a minimal DFA to be generated, using the algorithm described in Aho,
+Sethi, Ullman (1986). Although the absolute limit on the number of DFA states
+that TP Lex can handle is at least 300, TP Lex poses an additional restriction
+(100) on the number of states in the initial partition of the DFA optimization
+algorithm. Thus, you may get a fatal \verb"integer set overflow" message when
+using the \verb"-o" option even when TP Lex is able to generate an unoptimized
+DFA. In such cases you will just have to be content with the unoptimized DFA.
+(Hopefully, this will be fixed in a future version. Anyhow, using the merged
+transitions scheme described above, TP Lex usually constructs unoptimized
+DFA's which are not far from being optimal, and thus in most cases DFA
+optimization won't have a great impact on DFA table sizes.)
+
+\subsection{Differences from UNIX Lex}
+
+Major differences between TP Lex and UNIX Lex are listed below.
+
+\begin{itemize}
+   \item
+      TP Lex produces output code for Turbo Pascal, rather than for C.
+   \item
+      Character tables (\verb"%T") are not supported; neither are any
+      directives to determine internal table sizes (\verb"%p", \verb"%n",
+      etc.).
+   \item
+      Library routines are named differently from the UNIX version (e.g.,
+      the \verb"start" routine takes the place of the \verb"BEGIN" macro of
+      UNIX Lex), and, of course, all macros of UNIX Lex (\verb"ECHO",
+      \verb"REJECT", etc.) had to be implemented as procedures.
+    \item
+      The TP Lex library unit starts counting line numbers at 0, incrementing
+      the count {\em before\/} a line is read (in contrast, UNIX Lex
+      initializes \verb"yylineno" to 1 and increments it {\em after\/} the
+      line end has been read). This is motivated by the way in which TP Lex
+      maintains the current line, and will not affect your programs unless you
+      explicitly reset the \verb"yylineno" value (e.g., when opening a new
+      input file). In such a case you should set \verb"yylineno" to 0 rather
+      than 1.
+\end{itemize}
+
+\section{TP Yacc}
+
+This section describes the TP Yacc compiler compiler.
+
+\subsection{Usage}
+
+\begin{quote}\begin{verbatim}
+yacc [options] yacc-file[.y] [output-file[.pas]]
+\end{verbatim}\end{quote}
+
+\subsection{Options}
+
+\begin{description}
+   \item[\verb"-v"]
+      ``Verbose:'' TP Yacc generates a readable description of the generated
+      parser, written to \verb"yacc-file" with new extension \verb".lst".
+   \item[\verb"-d"]
+      ``Debug:'' TP Yacc generates parser with debugging output.
+\end{description}
+
+\subsection{Description}
+
+TP Yacc is a program that lets you prepare parsers from the description
+of input languages by BNF-like grammars. You simply specify the grammar
+for your target language, augmented with the Turbo Pascal code necessary
+to process the syntactic constructs, and TP Yacc translates your grammar
+into the Turbo Pascal code for a corresponding parser subroutine named
+\verb"yyparse".
+
+TP Yacc parses the source grammar contained in \verb"yacc-file" (with default
+suffix \verb".y") and writes the constructed parser subroutine to the
+specified \verb"output-file" (with default suffix \verb".pas"); if no output
+file is specified, output goes to \verb"yacc-file" with new suffix
+\verb".pas". If any errors are found during compilation, error messages are
+written to the list file (\verb"yacc-file" with new suffix \verb".lst").
+
+The generated parser routine, \verb"yyparse", is declared as:
+
+\begin{quote}\begin{verbatim}
+   function yyparse : Integer;
+\end{verbatim}\end{quote}
+
+This routine may be called by your main program to execute the parser.
+The return value of the \verb"yyparse" routine denotes success or failure of
+the parser (possible return values: 0 = success, 1 = unrecoverable syntax
+error or parse stack overflow).
+
+Similar to TP Lex, the code template for the \verb"yyparse" routine may be
+found in the \verb"yyparse.cod" file. The rules for locating this file are
+analogous to those of TP Lex (see Section {\em TP Lex\/}).
+
+The TP Yacc library (\verb"YaccLib") unit is required by programs using Yacc-
+generated parsers; you will therefore have to put an appropriate \verb"uses"
+clause into your program or unit that contains the parser routine. The
+\verb"YaccLib" unit also provides some routines which may be used to control
+the actions of the parser. See the file \verb"yacclib.pas" for further
+information.
+
+\subsection{Yacc Source}
+
+A TP Yacc program consists of three sections separated with the \verb"%%"
+delimiter:
+
+\begin{quote}\begin{verbatim}
+definitions
+%%
+rules
+%%
+auxiliary procedures
+\end{verbatim}\end{quote}
+
+The TP Yacc language is free-format: whitespace (blanks, tabs and newlines)
+is ignored, except if it serves as a delimiter. Comments have the C-like
+format \verb"/* ... */". They are treated as whitespace. Grammar symbols are
+denoted by identifiers which have the usual form (letter, including
+underscore, followed by a sequence of letters and digits; upper- and
+lowercase is distinct). The TP Yacc language also has some keywords which
+always start with the \verb"%" character. Literals are denoted by characters
+enclosed in single quotes. The usual C-like escapes are recognized:
+
+\begin{itemize}
+   \item \verb"\n"     denotes newline
+   \item \verb"\r"     denotes carriage return
+   \item \verb"\t"     denotes tab
+   \item \verb"\b"     denotes backspace
+   \item \verb"\f"     denotes form feed
+   \item \verb"\"$nnn$ denotes character no.\ $nnn$ in octal base
+\end{itemize}
+
+\subsection{Definitions}
+
+The first section of a TP Yacc grammar serves to define the symbols used in
+the grammar. It may contain the following types of definitions:
+
+\begin{itemize}
+   \item
+      start symbol definition: A definition of the form
+      \begin{quote}\begin{verbatim}
+   %start symbol
+      \end{verbatim}\end{quote}
+      declares the start nonterminal of the grammar (if this definition is
+      omitted, TP Yacc assumes the left-hand side nonterminal of the first
+      grammar rule as the start symbol of the grammar).
+   \item
+      terminal definitions: Definitions of the form
+      \begin{quote}\begin{verbatim}
+   %token symbol ...
+      \end{verbatim}\end{quote}
+      are used to declare the terminal symbols (``tokens'') of the target
+      language. Any identifier not introduced in a \verb"%token" definition
+      will be treated as a nonterminal symbol.
+    
+      As far as TP Yacc is concerned, tokens are atomic symbols which do not
+      have an innert structure. A lexical analyzer must be provided which
+      takes on the task of tokenizing the input stream and return the
+      individual tokens and literals to the parser (see Section {\em Lexical
+      Analysis\/}).
+   \item
+      precedence definitions: Operator symbols (terminals) may be associated
+      with a precedence by means of a precedence definition which may have
+      one of the following forms
+      \begin{quote}\begin{verbatim}
+   %left symbol ...
+   %right symbol ...
+   %nonassoc symbol ...
+      \end{verbatim}\end{quote}
+      which are used to declare left-, right- and nonassociative operators,
+      respectively. Each precedence definition introduces a new precedence
+      level, lowest precedence first. E.g., you may write:
+      \begin{quote}\begin{verbatim}
+   %nonassoc '<' '>' '=' GEQ LEQ NEQ
+      /* relational operators */
+   %left     '+' '-'  OR
+      /* addition operators */
+   %left     '*' '/' AND
+     /* multiplication operators */
+   %right    NOT UMINUS
+     /* unary operators */
+      \end{verbatim}\end{quote}
+
+      A terminal identifier introduced in a precedence definition may, but
+      need not, appear in a \verb"%token" definition as well.
+   \item
+      type definitions: Any (terminal or nonterminal) grammar symbol may be
+      associated with a type identifier which is used in the processing of
+      semantic values. Type tags of the form \verb"<name>" may be used in
+      token and precedence definitions to declare the type of a terminal
+      symbol, e.g.:
+      \begin{quote}\begin{verbatim}
+   %token <Real>  NUM
+   %left  <AddOp> '+' '-'
+      \end{verbatim}\end{quote}
+
+      To declare the type of a nonterminal symbol, use a type definition of
+      the form:
+      \begin{quote}\begin{verbatim}
+   %type <name> symbol ...
+      \end{verbatim}\end{quote}
+      e.g.:
+      \begin{quote}\begin{verbatim}
+   %type <Real> expr
+      \end{verbatim}\end{quote}
+
+      In a \verb"%type" definition, you may also omit the nonterminals, i.e.
+      you may write:
+      \begin{quote}\begin{verbatim}
+   %type <name>
+      \end{verbatim}\end{quote}
+
+      This is useful when a given type is only used with type casts (see
+      Section {\em Grammar Rules and Actions\/}), and is not associated with
+      a specific nonterminal.
+   \item
+      Turbo Pascal declarations: You may also include arbitrary Turbo Pascal
+      code in the definitions section, enclosed in \verb"%{ %}". This code
+      will be inserted as global declarations into the output file, unchanged.
+\end{itemize}
+
+\subsection{Grammar Rules and Actions}
+
+The second part of a TP Yacc grammar contains the grammar rules for the
+target language. Grammar rules have the format
+
+\begin{quote}\begin{verbatim}
+   name : symbol ... ;
+\end{verbatim}\end{quote}
+
+The left-hand side of a rule must be an identifier (which denotes a
+nonterminal symbol). The right-hand side may be an arbitrary (possibly
+empty) sequence of nonterminal and terminal symbols (including literals
+enclosed in single quotes). The terminating semicolon may also be omitted.
+Different rules for the same left-hand side symbols may be written using
+the \verb"|" character to separate the different alternatives:
+
+\begin{quote}\begin{verbatim}
+   name : symbol ...
+        | symbol ...
+        ...
+        ;
+\end{verbatim}\end{quote}
+
+For instance, to specify a simple grammar for arithmetic expressions, you
+may write:
+
+\begin{quote}\begin{verbatim}
+%left '+' '-'
+%left '*' '/'
+%token NUM
+%%
+expr : expr '+' expr
+     | expr '-' expr
+     | expr '*' expr
+     | expr '/' expr
+     | '(' expr ')'
+     | NUM
+     ;
+\end{verbatim}\end{quote}
+
+(The \verb"%left" definitions at the beginning of the grammar are needed to
+specify the precedence and associativity of the operator symbols. This will be
+discussed in more detail in Section {\em Ambigious Grammars\/}.)
+
+Grammar rules may contain actions -- Turbo Pascal statements enclosed in
+\verb"{ }" -- to be executed as the corresponding rules are recognized.
+Furthermore, rules may return values, and access values returned by other
+rules. These ``semantic'' values are written as \verb"$$" (value of the
+left-hand side nonterminal) and \verb"$i" (value of the $i$th right-hand
+side symbol). They are kept on a special value stack which is maintained
+automatically by the parser.
+
+Values associated with terminal symbols must be set by the lexical analyzer
+(more about this in Section {\em Lexical Analysis\/}). Actions of the form
+\verb"$$ := $1" can frequently be omitted, since it is the default action
+assumed by TP Yacc for any rule that does not have an explicit action.
+
+By default, the semantic value type provided by Yacc is \verb"Integer". You
+can also put a declaration like
+\begin{quote}\begin{verbatim}
+   %{
+   type YYSType = Real;
+   %}
+\end{verbatim}\end{quote}
+into the definitions section of your Yacc grammar to change the default value
+type. However, if you have different value types, the preferred method is to
+use type definitions as discussed in Section {\em Definitions\/}. When such
+type definitions are given, TP Yacc handles all the necessary details of the
+\verb"YYSType" definition and also provides a fair amount of type checking
+which makes it easier to find type errors in the grammar.
+
+For instance, we may declare the symbols \verb"NUM" and \verb"expr" in the
+example above to be of type \verb"Real", and then use these values to
+evaluate an expression as it is parsed.
+
+\begin{quote}\begin{verbatim}
+%left '+' '-'
+%left '*' '/'
+%token <Real> NUM
+%type  <Real> expr
+%%
+expr : expr '+' expr   { $$ := $1+$3; }
+     | expr '-' expr   { $$ := $1-$3; }
+     | expr '*' expr   { $$ := $1*$3; }
+     | expr '/' expr   { $$ := $1/$3; }
+     | '(' expr ')'    { $$ := $2;    }
+     | NUM
+     ;
+\end{verbatim}\end{quote}
+
+(Note that we omitted the action of the last rule. The ``copy action''
+\verb"$$ := $1" required by this rule is automatically added by TP Yacc.)
+
+Actions may not only appear at the end, but also in the middle of a rule
+which is useful to perform some processing before a rule is fully parsed.
+Such actions inside a rule are treated as special nonterminals which are
+associated with an empty right-hand side. Thus, a rule like
+\begin{quote}\begin{verbatim}
+   x : y { action; } z
+\end{verbatim}\end{quote}
+will be treated as:
+\begin{quote}\begin{verbatim}
+  x : y $act z
+  $act : { action; }
+\end{verbatim}\end{quote}
+
+Actions inside a rule may also access values to the left of the action,
+and may return values by assigning to the \verb"$$" value. The value returned
+by such an action can then be accessed by other actions using the usual
+\verb"$i" notation. E.g., we may write:
+\begin{quote}\begin{verbatim}
+   x : y { $$ := 2*$1; } z { $$ := $2+$3; }
+\end{verbatim}\end{quote}
+which has the effect of setting the value of \verb"x" to
+\begin{quote}\begin{verbatim}
+   2*(the value of y)+(the value of z).
+\end{verbatim}\end{quote}
+
+Sometimes it is desirable to access values in enclosing rules. This can be
+done using the notation \verb"$i" with $i\leq 0$. \verb"$0" refers to the
+first value ``to the left'' of the current rule, \verb"$-1" to the second,
+and so on. Note that in this case the referenced value depends on the actual
+contents of the parse stack, so you have to make sure that the requested
+values are always where you expect them.
+
+There are some situations in which TP Yacc cannot easily determine the
+type of values (when a typed parser is used). This is true, in particular,
+for values in enclosing rules and for the \verb"$$" value in an action inside
+a rule. In such cases you may use a type cast to explicitly specify the type
+of a value. The format for such type casts is \verb"$<name>$" (for left-hand
+side values) and \verb"$<name>i" (for right-hand side values) where
+\verb"name" is a type identifier (which must occur in a \verb"%token",
+precedence or \verb"%type" definition).
+
+\subsection{Auxiliary Procedures}
+
+The third section of a TP Yacc program is optional. If it is present, it
+may contain any Turbo Pascal code (such as supporting routines or a main
+program) which is tacked on to the end of the output file.
+
+\subsection{Lexical Analysis}
+
+For any TP Yacc-generated parser, the programmer must supply a lexical
+analyzer routine named \verb"yylex" which performs the lexical analysis for
+the parser. This routine must be declared as
+
+\begin{quote}\begin{verbatim}
+   function yylex : Integer;
+\end{verbatim}\end{quote}
+
+The \verb"yylex" routine may either be prepared by hand, or by using the
+lexical analyzer generator TP Lex (see Section {\em TP Lex\/}).
+
+The lexical analyzer must be included in your main program behind the
+parser subroutine (the \verb"yyparse" code template includes a forward
+definition of the \verb"yylex" routine such that the parser can access the
+lexical analyzer). For instance, you may put the lexical analyzer
+routine into the auxiliary procedures section of your TP Yacc grammar,
+either directly, or by using the the Turbo Pascal include directive
+(\verb"$I").
+
+The parser repeatedly calls the \verb"yylex" routine to tokenize the input
+stream and obtain the individual lexical items in the input. For any
+literal character, the \verb"yylex" routine has to return the corresponding
+character code. For the other, symbolic, terminals of the input language,
+the lexical analyzer must return corresponding integer codes. These are
+assigned automatically by TP Yacc in the order in which token definitions
+appear in the definitions section of the source grammar. The lexical
+analyzer can access these values through corresponding integer constants
+which are declared by TP Yacc in the output file.
+
+For instance, if
+\begin{quote}\begin{verbatim}
+   %token NUM
+\end{verbatim}\end{quote}
+is the first definition in the Yacc grammar, then TP Yacc will create
+a corresponding constant declaration
+\begin{quote}\begin{verbatim}
+   const NUM = 257;
+\end{verbatim}\end{quote}
+in the output file (TP Yacc automatically assigns symbolic token numbers
+starting at 257; 1 thru 255 are reserved for character literals, 0 denotes
+end-of-file, and 256 is reserved for the special error token which will be
+discussed in Section {\em Error Handling\/}). This definition may then be
+used, e.g., in a corresponding TP Lex program as follows:
+\begin{quote}\begin{verbatim}
+   [0-9]+   return(NUM);
+\end{verbatim}\end{quote}
+
+You can also explicitly assign token numbers in the grammar. For this
+purpose, the first occurrence of a token identifier in the definitions
+section may be followed by an unsigned integer. E.g. you may write:
+\begin{quote}\begin{verbatim}
+   %token NUM 299
+\end{verbatim}\end{quote}
+
+Besides the return value of \verb"yylex", the lexical analyzer routine may
+also return an additional semantic value for the recognized token. This value
+is assigned to a variable named \verb"yylval" and may then be accessed in
+actions through the \verb"$i" notation (see above, Section {\em Grammar
+Rules and Actions\/}). The \verb"yylval" variable is of type \verb"YYSType"
+(the semantic value type, \verb"Integer" by default); its declaration may be
+found in the \verb"yyparse.cod" file.
+
+For instance, to assign an \verb"Integer" value to a \verb"NUM" token in the
+above example, we may write:
+
+\begin{quote}\begin{verbatim}
+   [0-9]+   begin
+              val(yytext, yylval, code);
+              return(NUM);
+            end;
+\end{verbatim}\end{quote}
+
+This assigns \verb"yylval" the value of the \verb"NUM" token (using the Turbo
+Pascal standard procedure \verb"val").
+
+If a parser uses tokens of different types (via a \verb"%token <name>"
+definition), then the \verb"yylval" variable will not be of type
+\verb"Integer", but instead of a corresponding variant record type which is
+capable of holding all the different value types declared in the TP Yacc
+grammar. In this case, the lexical analyzer must assign a semantic value to
+the corresponding record component which is named \verb"yy"{\em name\/}
+(where {\em name\/} stands for the corresponding type identifier).
+
+E.g., if token \verb"NUM" is declared \verb"Real":
+\begin{quote}\begin{verbatim}
+   %token <Real> NUM
+\end{verbatim}\end{quote}
+then the value for token \verb"NUM" must be assigned to \verb"yylval.yyReal".
+
+\subsection{How The Parser Works}
+
+TP Yacc uses the LALR(1) technique developed by Donald E.\ Knuth and F.\
+DeRemer to construct a simple, efficient, non-backtracking bottom-up
+parser for the source grammar. The LALR parsing technique is described
+in detail in Aho/Sethi/Ullman (1986). It is quite instructive to take a
+look at the parser description TP Yacc generates from a small sample
+grammar, to get an idea of how the LALR parsing algorithm works. We
+consider the following simplified version of the arithmetic expression
+grammar:
+
+\begin{quote}\begin{verbatim}
+%token NUM
+%left '+'
+%left '*'
+%%
+expr : expr '+' expr
+     | expr '*' expr
+     | '(' expr ')'
+     | NUM
+     ;
+\end{verbatim}\end{quote}
+
+When run with the \verb"-v" option on the above grammar, TP Yacc generates
+the parser description listed below.
+
+\begin{quote}\begin{verbatim}
+state 0:
+
+        $accept : _ expr $end
+
+        '('     shift 2
+        NUM     shift 3
+        .       error
+
+        expr    goto 1
+
+state 1:
+
+        $accept : expr _ $end
+        expr : expr _ '+' expr
+        expr : expr _ '*' expr
+
+        $end    accept
+        '*'     shift 4
+        '+'     shift 5
+        .       error
+
+state 2:
+
+        expr : '(' _ expr ')'
+
+        '('     shift 2
+        NUM     shift 3
+        .       error
+
+        expr    goto 6
+
+state 3:
+
+        expr : NUM _    (4)
+
+        .       reduce 4
+
+state 4:
+
+        expr : expr '*' _ expr
+
+        '('     shift 2
+        NUM     shift 3
+        .       error
+
+        expr    goto 7
+
+state 5:
+
+        expr : expr '+' _ expr
+
+        '('     shift 2
+        NUM     shift 3
+        .       error
+
+        expr    goto 8
+
+state 6:
+
+        expr : '(' expr _ ')'
+        expr : expr _ '+' expr
+        expr : expr _ '*' expr
+
+        ')'     shift 9
+        '*'     shift 4
+        '+'     shift 5
+        .       error
+
+state 7:
+
+        expr : expr '*' expr _  (2)
+        expr : expr _ '+' expr
+        expr : expr _ '*' expr
+
+        .       reduce 2
+
+state 8:
+
+        expr : expr '+' expr _  (1)
+        expr : expr _ '+' expr
+        expr : expr _ '*' expr
+
+        '*'     shift 4
+        $end    reduce 1
+        ')'     reduce 1
+        '+'     reduce 1
+        .       error
+
+state 9:
+
+        expr : '(' expr ')' _   (3)
+
+        .       reduce 3
+\end{verbatim}\end{quote}
+
+Each state of the parser corresponds to a certain prefix of the input
+which has already been seen. The parser description lists the grammar
+rules wich are parsed in each state, and indicates the portion of each
+rule which has already been parsed by an underscore. In state 0, the
+start state of the parser, the parsed rule is
+\begin{quote}\begin{verbatim}
+        $accept : expr $end
+\end{verbatim}\end{quote}
+
+This is not an actual grammar rule, but a starting rule automatically
+added by TP Yacc. In general, it has the format
+\begin{quote}\begin{verbatim}
+        $accept : X $end
+\end{verbatim}\end{quote}
+where \verb"X" is the start nonterminal of the grammar, and \verb"$end" is
+a pseudo token denoting end-of-input (the \verb"$end" symbol is used by the
+parser to determine when it has successfully parsed the input).
+
+The description of the start rule in state 0,
+\begin{quote}\begin{verbatim}
+        $accept : _ expr $end
+\end{verbatim}\end{quote}
+with the underscore positioned before the \verb"expr" symbol, indicates that
+we are at the beginning of the parse and are ready to parse an expression
+(nonterminal \verb"expr").
+
+The parser maintains a stack to keep track of states visited during the
+parse. There are two basic kinds of actions in each state: {\em shift\/},
+which reads an input symbol and pushes the corresponding next state on top of
+the stack, and {\em reduce\/} which pops a number of states from the stack
+(corresponding to the number of right-hand side symbols of the rule used
+in the reduction) and consults the {\em goto\/} entries of the uncovered
+state to find the transition corresponding to the left-hand side symbol of the
+reduced rule.
+
+In each step of the parse, the parser is in a given state (the state on
+top of its stack) and may consult the current {\em lookahead symbol\/}, the
+next symbol in the input, to determine the parse action -- shift or reduce --
+to perform. The parser terminates as soon as it reaches state 1 and reads
+in the endmarker, indicated by the {\em accept\/} action on \verb"$end" in
+state 1.
+
+Sometimes the parser may also carry out an action without inspecting the
+current lookahead token. This is the case, e.g., in state 3 where the
+only action is reduction by rule 4:
+\begin{quote}\begin{verbatim}
+        .       reduce 4
+\end{verbatim}\end{quote}
+
+The default action in a state can also be {\em error\/} indicating that any
+other input represents a syntax error. (In case of such an error the
+parser will start syntactic error recovery, as described in Section
+{\em Error Handling\/}.)
+
+Now let us see how the parser responds to a given input. We consider the
+input string \verb"2+5*3" which is presented to the parser as the token
+sequence:
+\begin{quote}\begin{verbatim}
+   NUM + NUM * NUM
+\end{verbatim}\end{quote}
+
+Table \ref{tab2} traces the corresponding actions of the parser. We also
+show the current state in each move, and the remaining states on the stack.
+
+\begin{table*}\centering
+   \begin{tabular}{l|l|l|p{8cm}}
+      \hline\hline
+      {\sc State}& {\sc Stack}& {\sc Lookahead}& {\sc Action}\\
+      \hline
+0 &               &    \verb"NUM"    &    shift state 3\\
+3 &     0         &                  &    reduce rule 4 (pop 1 state, uncovering state
+                                          0, then goto state 1 on symbol \verb"expr")\\
+1 &     0         &    \verb"+"      &    shift state 5\\
+5 &     1 0       &    \verb"NUM"    &    shift state 3\\
+3 &     5 1 0     &                  &    reduce rule 4 (pop 1 state, uncovering state
+                                          5, then goto state 8 on symbol \verb"expr")\\
+8 &     5 1 0     &    \verb"*"      &    shift 4\\
+4 &     8 5 1 0   &    \verb"NUM"    &    shift 3\\
+3 &     4 8 5 1 0 &                  &    reduce rule 4 (pop 1 state, uncovering state
+                                          4, then goto state 7 on symbol \verb"expr")\\
+7 &     4 8 5 1 0 &                  &    reduce rule 2 (pop 3 states, uncovering state
+                                          5, then goto state 8 on symbol \verb"expr")\\
+8 &     5 1 0     &    \verb"$end"   &    reduce rule 1 (pop 3 states, uncovering state
+                                          0, then goto state 1 on symbol \verb"expr")\\
+1 &     0         &    \verb"$end"   &    accept\\
+      \hline
+   \end{tabular}
+   \caption{Parse of \protect\verb"NUM + NUM * NUM".}
+   \label{tab2}
+\end{table*}
+
+It is also instructive to see how the parser responds to illegal inputs.
+E.g., you may try to figure out what the parser does when confronted with:
+\begin{quote}\begin{verbatim}
+   NUM + )
+\end{verbatim}\end{quote}
+or:
+\begin{quote}\begin{verbatim}
+   ( NUM * NUM
+\end{verbatim}\end{quote}
+
+You will find that the parser, sooner or later, will always run into an
+error action when confronted with errorneous inputs. An LALR parser will
+never shift an invalid symbol and thus will always find syntax errors as
+soon as it is possible during a left-to-right scan of the input.
+
+TP Yacc provides a debugging option (\verb"-d") that may be used to trace
+the actions performed by the parser. When a grammar is compiled with the
+\verb"-d" option, the generated parser will print out the actions as it
+parses its input.
+
+\subsection{Ambigious Grammars}
+
+There are situations in which TP Yacc will not produce a valid parser for
+a given input language. LALR(1) parsers are restricted to one-symbol
+lookahead on which they have to base their parsing decisions. If a
+grammar is ambigious, or cannot be parsed unambigiously using one-symbol
+lookahead, TP Yacc will generate parsing conflicts when constructing the
+parse table. There are two types of such conflicts: {\em shift/reduce
+conflicts\/} (when there is both a shift and a reduce action for a given
+input symbol in a given state), and {\em reduce/reduce\/} conflicts (if
+there is more than one reduce action for a given input symbol in a given
+state). Note that there never will be a shift/shift conflict.
+
+When a grammar generates parsing conflicts, TP Yacc prints out the number
+of shift/reduce and reduce/reduce conflicts it encountered when constructing
+the parse table. However, TP Yacc will still generate the output code for the
+parser. To resolve parsing conflicts, TP Yacc uses the following built-in
+disambiguating rules:
+
+\begin{itemize}
+   \item
+      in a shift/reduce conflict, TP Yacc chooses the shift action.
+   \item
+      in a reduce/reduce conflict, TP Yacc chooses reduction of the first
+      grammar rule.
+\end{itemize}
+
+The shift/reduce disambiguating rule correctly resolves a type of
+ambiguity known as the ``dangling-else ambiguity'' which arises in the
+syntax of conditional statements of many programming languages (as in
+Pascal):
+
+\begin{quote}\begin{verbatim}
+%token IF THEN ELSE
+%%
+stmt : IF expr THEN stmt
+     | IF expr THEN stmt ELSE stmt
+     ;
+\end{verbatim}\end{quote}
+
+This grammar is ambigious, because a nested construct like
+\begin{quote}\begin{verbatim}
+   IF expr-1 THEN IF expr-2 THEN stmt-1
+     ELSE stmt-2
+\end{verbatim}\end{quote}
+can be parsed two ways, either as:
+\begin{quote}\begin{verbatim}
+   IF expr-1 THEN ( IF expr-2 THEN stmt-1
+     ELSE stmt-2 )
+\end{verbatim}\end{quote}
+or as:
+\begin{quote}\begin{verbatim}
+   IF expr-1 THEN ( IF expr-2 THEN stmt-1 )
+     ELSE stmt-2
+\end{verbatim}\end{quote}
+
+The first interpretation makes an \verb"ELSE" belong to the last unmatched
+\verb"IF" which also is the interpretation chosen in most programming
+languages. This is also the way that a TP Yacc-generated parser will parse
+the construct since the shift/reduce disambiguating rule has the effect of
+neglecting the reduction of \verb"IF expr-2 THEN stmt-1"; instead, the parser
+will shift the \verb"ELSE" symbol which eventually leads to the reduction of
+\verb"IF expr-2 THEN stmt-1 ELSE stmt-2".
+
+The reduce/reduce disambiguating rule is used to resolve conflicts that
+arise when there is more than one grammar rule matching a given construct.
+Such ambiguities are often caused by ``special case constructs'' which may be
+given priority by simply listing the more specific rules ahead of the more
+general ones.
+
+For instance, the following is an excerpt from the grammar describing the
+input language of the UNIX equation formatter EQN:
+
+\begin{quote}\begin{verbatim}
+%right SUB SUP
+%%
+expr : expr SUB expr SUP expr
+     | expr SUB expr
+     | expr SUP expr
+     ;
+\end{verbatim}\end{quote}
+
+Here, the \verb"SUB" and \verb"SUP" operator symbols denote sub- and
+superscript, respectively. The rationale behind this example is that
+an expression involving both sub- and superscript is often set differently
+from a superscripted subscripted expression (compare $x_i^n$ to ${x_i}^n$).
+This special case is therefore caught by the first rule in the above example
+which causes a reduce/reduce conflict with rule 3 in expressions like
+\verb"expr-1 SUB expr-2 SUP expr-3". The conflict is resolved in favour of
+the first rule.
+
+In both cases discussed above, the ambiguities could also be eliminated
+by rewriting the grammar accordingly (although this yields more complicated
+and less readable grammars). This may not always be the case. Often
+ambiguities are also caused by design errors in the grammar. Hence, if
+TP Yacc reports any parsing conflicts when constructing the parser, you
+should use the \verb"-v" option to generate the parser description
+(\verb".lst" file) and check whether TP Yacc resolved the conflicts correctly.
+
+There is one type of syntactic constructs for which one often deliberately
+uses an ambigious grammar as a more concise representation for a language
+that could also be specified unambigiously: the syntax of expressions.
+For instance, the following is an unambigious grammar for simple arithmetic
+expressions:
+
+\begin{quote}\begin{verbatim}
+%token NUM
+
+%%
+
+expr    : term
+        | expr '+' term
+        ;
+
+term    : factor
+        | term '*' factor
+        ;
+
+factor  : '(' expr ')'
+        | NUM
+        ;
+\end{verbatim}\end{quote}
+
+You may check yourself that this grammar gives \verb"*" a higher precedence
+than \verb"+" and makes both operators left-associative. The same effect can
+be achieved with the following ambigious grammar using precedence definitions:
+
+\begin{quote}\begin{verbatim}
+%token NUM
+%left '+'
+%left '*'
+%%
+expr : expr '+' expr
+     | expr '*' expr
+     | '(' expr ')'
+     | NUM
+     ;
+\end{verbatim}\end{quote}
+
+Without the precedence definitions, this is an ambigious grammar causing
+a number of shift/reduce conflicts. The precedence definitions are used
+to correctly resolve these conflicts (conflicts resolved using precedence
+will not be reported by TP Yacc).
+
+Each precedence definition introduces a new precedence level (lowest
+precedence first) and specifies whether the corresponding operators
+should be left-, right- or nonassociative (nonassociative operators
+cannot be combined at all; example: relational operators in Pascal).
+
+TP Yacc uses precedence information to resolve shift/reduce conflicts as
+follows. Precedences are associated with each terminal occuring in a
+precedence definition. Furthermore, each grammar rule is given the
+precedence of its rightmost terminal (this default choice can be
+overwritten using a \verb"%prec" tag; see below). To resolve a shift/reduce
+conflict using precedence, both the symbol and the rule involved must
+have been assigned precedences. TP Yacc then chooses the parse action
+as follows:
+
+\begin{itemize}
+   \item
+      If the symbol has higher precedence than the rule: shift.
+   \item
+      If the rule has higher precedence than the symbol: reduce.
+   \item
+      If symbol and rule have the same precedence, the associativity of the
+      symbol determines the parse action: if the symbol is left-associative:
+      reduce; if the symbol is right-associative: shift; if the symbol is
+      non-associative: error.
+\end{itemize}
+
+To give you an idea of how this works, let us consider our ambigious
+arithmetic expression grammar (without precedences):
+
+\begin{quote}\begin{verbatim}
+%token NUM
+%%
+expr : expr '+' expr
+     | expr '*' expr
+     | '(' expr ')'
+     | NUM
+     ;
+\end{verbatim}\end{quote}
+
+This grammar generates four shift/reduce conflicts. The description
+of state 8 reads as follows:
+
+\begin{quote}\begin{verbatim}
+state 8:
+
+        *** conflicts:
+
+        shift 4, reduce 1 on '*'
+        shift 5, reduce 1 on '+'
+
+        expr : expr '+' expr _  (1)
+        expr : expr _ '+' expr
+        expr : expr _ '*' expr
+
+        '*'     shift 4
+        '+'     shift 5
+        $end    reduce 1
+        ')'     reduce 1
+        .       error
+\end{verbatim}\end{quote}
+
+In this state, we have successfully parsed a \verb"+" expression (rule 1).
+When the next symbol is \verb"+" or \verb"*", we have the choice between the
+reduction and shifting the symbol. Using the default shift/reduce
+disambiguating rule, TP Yacc has resolved these conflicts in favour of shift.
+
+Now let us assume the above precedence definition:
+\begin{quote}\begin{verbatim}
+   %left '+'
+   %left '*'
+\end{verbatim}\end{quote}
+which gives \verb"*" higher precedence than \verb"+" and makes both operators
+left-associative. The rightmost terminal in rule 1 is \verb"+". Hence, given
+these precedence definitions, the first conflict will be resolved in favour
+of shift (\verb"*" has higher precedence than \verb"+"), while the second one
+is resolved in favour of reduce (\verb"+" is left-associative).
+
+Similar conflicts arise in state 7:
+
+\begin{quote}\begin{verbatim}
+state 7:
+
+        *** conflicts:
+
+        shift 4, reduce 2 on '*'
+        shift 5, reduce 2 on '+'
+
+        expr : expr '*' expr _  (2)
+        expr : expr _ '+' expr
+        expr : expr _ '*' expr
+
+        '*'     shift 4
+        '+'     shift 5
+        $end    reduce 2
+        ')'     reduce 2
+        .       error
+\end{verbatim}\end{quote}
+
+Here, we have successfully parsed a \verb"*" expression which may be followed
+by another \verb"+" or \verb"*" operator. Since \verb"*" is left-associative
+and has higher precedence than \verb"+", both conflicts will be resolved in
+favour of reduce.
+
+Of course, you can also have different operators on the same precedence
+level. For instance, consider the following extended version of the
+arithmetic expression grammar:
+
+\begin{quote}\begin{verbatim}
+%token NUM
+%left '+' '-'
+%left '*' '/'
+%%
+expr    : expr '+' expr
+        | expr '-' expr
+        | expr '*' expr
+        | expr '/' expr
+        | '(' expr ')'
+        | NUM
+        ;
+\end{verbatim}\end{quote}
+
+This puts all ``addition'' operators on the first and all ``multiplication''
+operators on the second precedence level. All operators are left-associative;
+for instance, \verb"5+3-2" will be parsed as \verb"(5+3)-2".
+
+By default, TP Yacc assigns each rule the precedence of its rightmost
+terminal. This is a sensible decision in most cases. Occasionally, it
+may be necessary to overwrite this default choice and explicitly assign
+a precedence to a rule. This can be done by putting a precedence tag
+of the form
+\begin{quote}\begin{verbatim}
+   %prec symbol
+\end{verbatim}\end{quote}
+at the end of the corresponding rule which gives the rule the precedence
+of the specified symbol. For instance, to extend the expression grammar
+with a unary minus operator, giving it highest precedence, you may write:
+
+\begin{quote}\begin{verbatim}
+%token NUM
+%left '+' '-'
+%left '*' '/'
+%right UMINUS
+%%
+expr    : expr '+' expr
+        | expr '-' expr
+        | expr '*' expr
+        | expr '/' expr
+        | '-' expr      %prec UMINUS
+        | '(' expr ')'
+        | NUM
+        ;
+\end{verbatim}\end{quote}
+
+Note the use of the \verb"UMINUS" token which is not an actual input symbol
+but whose sole purpose it is to give unary minus its proper precedence. If
+we omitted the precedence tag, both unary and binary minus would have the
+same precedence because they are represented by the same input symbol.
+
+\subsection{Error Handling}
+
+Syntactic error handling is a difficult area in the design of user-friendly
+parsers. Usually, you will not like to have the parser give up upon the
+first occurrence of an errorneous input symbol. Instead, the parser should
+recover from a syntax error, that is, it should try to find a place in the
+input where it can resume the parse.
+
+TP Yacc provides a general mechanism to implement parsers with error
+recovery. A special predefined \verb"error" token may be used in grammar rules
+to indicate positions where syntax errors might occur. When the parser runs
+into an error action (i.e., reads an errorneous input symbol) it prints out
+an error message and starts error recovery by popping its stack until it
+uncovers a state in which there is a shift action on the \verb"error" token.
+If there is no such state, the parser terminates with return value 1,
+indicating an unrecoverable syntax error. If there is such a state, the
+parser takes the shift on the \verb"error" token (pretending it has seen
+an imaginary \verb"error" token in the input), and resumes parsing in a
+special ``error mode.''
+
+While in error mode, the parser quietly skips symbols until it can again
+perform a legal shift action. To prevent a cascade of error messages, the
+parser returns to its normal mode of operation only after it has seen
+and shifted three legal input symbols. Any additional error found after
+the first shifted symbol restarts error recovery, but no error message
+is printed. The TP Yacc library routine \verb"yyerrok" may be used to reset
+the parser to its normal mode of operation explicitly.
+
+For a simple example, consider the rule
+\begin{quote}\begin{verbatim}
+   stmt : error ';' { yyerrok; }
+\end{verbatim}\end{quote}
+and assume a syntax error occurs while a statement (nonterminal \verb"stmt")
+is parsed. The parser prints an error message, then pops its stack until it
+can shift the token \verb"error" of the error rule. Proceeding in error mode,
+it will skip symbols until it finds a semicolon, then reduces by the error
+rule. The call to \verb"yyerrok" tells the parser that we have recovered from
+the error and that it should proceed with the normal parse. This kind of
+``panic mode'' error recovery scheme works well when statements are always
+terminated with a semicolon. The parser simply skips the ``bad'' statement
+and then resumes the parse.
+
+Implementing a good error recovery scheme can be a difficult task; see
+Aho/Sethi/Ullman (1986) for a more comprehensive treatment of this topic.
+Schreiner and Friedman have developed a systematic technique to implement
+error recovery with Yacc which I found quite useful (I used it myself
+to implement error recovery in the TP Yacc parser); see Schreiner/Friedman
+(1985).
+
+\subsection{Yacc Library}
+
+The TP Yacc library (\verb"YaccLib") unit provides some global declarations
+used by the parser routine \verb"yyparse", and some variables and utility
+routines which may be used to control the actions of the parser and to
+implement error recovery. See the file \verb"yacclib.pas" for a description
+of these variables and routines.
+
+You can also modify the Yacc library unit (and/or the code template in the
+\verb"yyparse.cod" file) to customize TP Yacc to your target applications.
+
+\subsection{Other Features}
+
+TP Yacc supports all additional language elements entitled as ``Old Features
+Supported But not Encouraged'' in the UNIX manual, which are provided for
+backward compatibility with older versions of (UNIX) Yacc:
+
+\begin{itemize}
+   \item
+      literals delimited by double quotes.
+   \item
+      multiple-character literals. Note that these are not treated as
+      character sequences but represent single tokens which are given a
+      symbolic integer code just like any other token identifier. However,
+      they will not be declared in the output file, so you have to make sure
+      yourself that the lexical analyzer returns the correct codes for these
+      symbols. E.g., you might explicitly assign token numbers by using a
+      definition like
+      \begin{quote}\begin{verbatim}
+   %token ':=' 257
+      \end{verbatim}\end{quote}
+      at the beginning of the Yacc grammar.
+   \item
+      \verb"\" may be used instead of \verb"%", i.e. \verb"\\" means
+      \verb"%%", \verb"\left" is the same as \verb"%left", etc.
+   \item
+      other synonyms:
+      \begin{itemize}
+         \item \verb"%<"                    for \verb"%left"
+         \item \verb"%>"                    for \verb"%right"
+         \item \verb"%binary" or \verb"%2"  for \verb"%nonassoc"
+         \item \verb"%term" or \verb"%0"    for \verb"%token"
+         \item \verb"%="                    for \verb"%prec"
+      \end{itemize}
+   \item
+      actions may also be written as \verb"= { ... }" or
+      \verb"= single-statement;"
+   \item
+      Turbo Pascal declarations (\verb"%{ ... %}") may be put at the
+      beginning of the rules section. They will be treated as local
+      declarations of the actions routine.
+\end{itemize}
+
+\subsection{Implementation Restrictions}
+
+As with TP Lex, internal table sizes and the main memory available limit the
+complexity of source grammars that TP Yacc can handle. However, the maximum
+table sizes provided by TP Yacc are large enough to handle quite complex
+grammars (such as the Pascal grammar in the TP Yacc distribution). The actual
+table sizes are shown in the statistics printed by TP Yacc when a compilation
+is finished. The given figures are "s" (states), "i" (LR0 kernel items), "t"
+(shift and goto transitions) and "r" (reductions).
+
+The default stack size of the generated parsers is \verb"yymaxdepth = 1024",
+as declared in the TP Yacc library unit. This should be sufficient for any
+average application, but you can change the stack size by including a
+corresponding declaration in the definitions part of the Yacc grammar
+(or change the value in the \verb"YaccLib" unit). Note that right-recursive
+grammar rules may increase stack space requirements, so it is a good
+idea to use left-recursive rules wherever possible.
+
+\subsection{Differences from UNIX Yacc}
+
+Major differences between TP Yacc and UNIX Yacc are listed below.
+
+\begin{itemize}
+   \item
+      TP Yacc produces output code for Turbo Pascal, rather than for C.
+   \item
+      TP Yacc does not support \verb"%union" definitions. Instead, a value
+      type is declared by specifying the type identifier itself as the tag of
+      a \verb"%token" or \verb"%type" definition. TP Yacc will automatically
+      generate an appropriate variant record type (\verb"YYSType") which is
+      capable of holding values of any of the types used in \verb"%token" and
+      \verb"%type".
+    
+      Type checking is very strict. If you use type definitions, then
+      any symbol referred to in an action must have a type introduced
+      in a type definition. Either the symbol must have been assigned a
+      type in the definitions section, or the \verb"$<type-identifier>"
+      notation must be used. The syntax of the \verb"%type" definition has
+      been changed slightly to allow definitions of the form
+      \begin{quote}\begin{verbatim}
+   %type <type-identifier>
+      \end{verbatim}\end{quote}
+      (omitting the nonterminals) which may be used to declare types which
+      are not assigned to any grammar symbol, but are used with the
+      \verb"$<...>" construct.
+   \item
+      The parse tables constructed by this Yacc version are slightly greater
+      than those constructed by UNIX Yacc, since a reduce action will only be
+      chosen as the default action if it is the only action in the state.
+      In difference, UNIX Yacc chooses a reduce action as the default action
+      whenever it is the only reduce action of the state (even if there are
+      other shift actions).
+    
+      This solves a bug in UNIX Yacc that makes the generated parser start
+      error recovery too late with certain types of error productions (see
+      also Schreiner/Friedman, {\em Introduction to compiler construction with
+      UNIX,\/} 1985). Also, errors will be caught sooner in most cases where
+      UNIX Yacc would carry out an additional (default) reduction before
+      detecting the error.
+   \item
+      Library routines are named differently from the UNIX version (e.g.,
+      the \verb"yyerrlab" routine takes the place of the \verb"YYERROR"
+      macro of UNIX Yacc), and, of course, all macros of UNIX Yacc
+      (\verb"YYERROR", \verb"YYACCEPT", etc.) had to be implemented as
+      procedures.
+\end{itemize}
+
+\end{document}

utils/tply/yaccbase.pas

@@ -0,0 +1,738 @@
+{
+  This module collects the basic data types and operations used in the TP
+  Yacc program, and other basic stuff that does not belong anywhere else:
+  - Yacc input and output files and corresponding bookkeeping information
+    used by the parser
+  - symbolic character constants
+  - dynamically allocated strings
+  - integer sets
+  - generic quicksort and hash table routines
+  - utilities for list-generating
+  - other tiny utilities
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-07-31 15:18 $
+
+$History: YACCBASE.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+}
+
+
+unit YaccBase;
+
+
+
+interface
+
+const
+
+(* symbolic character constants: *)
+
+bs   = #8;      (* backspace character *)
+tab  = #9;      (* tab character *)
+nl   = #10;     (* newline character *)
+cr   = #13;     (* carriage return *)
+ff   = #12;     (* form feed character *)
+
+var
+
+(* Filenames: *)
+
+yfilename     : String;
+pasfilename   : String;
+lstfilename   : String;
+codfilename   : String;
+codfilepath   : String; { Under Linux,
+                          binary and conf file are never in 1 directory.}
+
+(* Yacc input, output, list and code template file: *)
+
+yyin, yyout, yylst, yycod : Text;
+
+(* the following values are initialized and updated by the parser: *)
+
+line      : String;  (* current input line *)
+lno, cno  : Integer; (* current input position (line/column) *)
+tokleng   : Integer; (* length of current token *)
+
+const
+
+{$IFDEF MsDos}
+max_elems  = 50;  (* maximum size of integer sets *)
+{$ELSE}
+max_elems  = 75; (* maximum size of integer sets *)
+{$ENDIF}
+
+type
+
+(* String pointers: *)
+
+StrPtr    = ^String;
+
+(* Sorted integer sets: *)
+
+IntSet    = array [0..max_elems] of Integer;
+              (* word 0 is size *)
+IntSetPtr = ^IntSet;
+
+(* Operations: *)
+
+(* Strings pointers: *)
+
+function newStr(str : String) : StrPtr;
+  (* creates a string pointer (only the space actually needed for the given
+     string is allocated) *)
+
+(* Integer sets (set arguments are passed by reference even if they are not
+   modified, for greater efficiency): *)
+
+procedure empty(var M : IntSet);
+  (* initializes M as empty *)
+procedure singleton(var M : IntSet; i : Integer);
+  (* initializes M as a singleton set containing the element i *)
+procedure include(var M : IntSet; i : Integer);
+  (* include i in M *)
+procedure exclude(var M : IntSet; i : Integer);
+  (* exclude i from M *)
+procedure setunion(var M, N : IntSet);
+  (* adds N to M *)
+procedure setminus(var M, N : IntSet);
+  (* removes N from M *)
+procedure intersect(var M, N : IntSet);
+  (* removes from M all elements NOT in N *)
+function size(var M : IntSet) : Integer;
+  (* cardinality of set M *)
+function member(i : Integer; var M : IntSet) : Boolean;
+  (* tests for membership of i in M *)
+function isempty(var M : IntSet) : Boolean;
+  (* checks whether M is an empty set *)
+function equal(var M, N : IntSet) : Boolean;
+  (* checks whether M and N are equal *)
+function subseteq(var M, N : IntSet) : Boolean;
+  (* checks whether M is a subset of N *)
+function newEmptyIntSet : IntSetPtr;
+  (* creates a pointer to an empty integer set *)
+function newIntSet ( var M : IntSet ) : IntSetPtr;
+  (* creates a dynamic copy of M (only the space actually needed
+     is allocated) *)
+
+(* Quicksort: *)
+
+type
+
+OrderPredicate = function (i, j : Integer) : Boolean;
+SwapProc = procedure (i, j : Integer);
+
+procedure quicksort(lo, hi: Integer;
+                    less : OrderPredicate;
+                    swap : SwapProc);
+  (* General inplace sorting procedure based on the quicksort algorithm.
+     This procedure can be applied to any sequential data structure;
+     only the corresponding routines less which compares, and swap which
+     swaps two elements i,j of the target data structure, must be
+     supplied as appropriate for the target data structure.
+     - lo, hi: the lower and higher indices, indicating the elements to
+       be sorted
+     - less(i, j): should return true if element no. i `is less than'
+       element no. j, and false otherwise; any total quasi-ordering may
+       be supplied here (if neither less(i, j) nor less(j, i) then elements
+       i and j are assumed to be `equal').
+     - swap(i, j): should swap the elements with index i and j *)
+
+(* Generic hash table routines (based on quadratic rehashing; hence the
+   table size must be a prime number): *)
+
+type
+
+TableLookupProc = function(k : Integer) : String;
+TableEntryProc  = procedure(k : Integer; symbol : String);
+
+function key(symbol : String;
+             table_size : Integer;
+             lookup : TableLookupProc;
+             entry  : TableEntryProc) : Integer;
+  (* returns a hash table key for symbol; inserts the symbol into the
+     table if necessary
+     - table_size is the symbol table size and must be a fixed prime number
+     - lookup is the table lookup procedure which should return the string
+       at key k in the table ('' if entry is empty)
+     - entry is the table entry procedure which is assumed to store the
+       given symbol at the given location *)
+
+function definedKey(symbol : String;
+                    table_size : Integer;
+                    lookup : TableLookupProc) : Boolean;
+  (* checks the table to see if symbol is in the table *)
+
+(* Utility routines: *)
+
+function min(i, j : Integer) : Integer;
+function max(i, j : Integer) : Integer;
+  (* minimum and maximum of two integers *)
+function upper(str : String) : String;
+  (* returns str converted to uppercase *)
+function strip(str : String) : String;
+  (* returns str with leading and trailing blanks stripped off *)
+function blankStr(str : String) : String;
+  (* returns string of same length as str, with all non-whitespace characters
+     replaced by blanks *)
+function intStr(i : Integer) : String;
+  (* returns the string representation of i *)
+function isInt(str : String; var i : Integer) : Boolean;
+  (* checks whether str represents an integer; if so, returns the
+     value of it in i *)
+function path(filename : String) : String;
+  (* returns the path in filename *)
+function root(filename : String) : String;
+  (* returns root (i.e. extension stripped from filename) of
+     filename *)
+function addExt(filename, ext : String) : String;
+  (* if filename has no extension and last filename character is not '.',
+     add extension ext to filename *)
+function file_size(filename : String) : LongInt;
+  (* determines file size in bytes *)
+
+(* Utility functions for list generating routines: *)
+
+type CharSet = set of Char;
+
+function charStr(c : char; reserved : CharSet) : String;
+  (* returns a print name for character c, using the standard escape
+     conventions; reserved is the class of `reserved' special characters
+     which should be quoted with \ (\ itself is always quoted) *)
+function singleQuoteStr(str : String) : String;
+  (* returns print name of str enclosed in single quotes, using the
+     standard escape conventions *)
+function doubleQuoteStr(str : String) : String;
+  (* returns print name of str enclosed in double quotes, using the
+     standard escape conventions *)
+
+implementation
+
+uses YaccMsgs;
+
+(* String pointers: *)
+
+function newStr(str : String) : StrPtr;
+  var strp : StrPtr;
+  begin
+    getmem(strp, succ(length(str)));
+    move(str, strp^, succ(length(str)));
+    newStr := strp;
+  end(*newStr*);
+
+(* Integer sets: *)
+
+procedure empty(var M : IntSet);
+  begin
+    M[0] := 0;
+  end(*empty*);
+
+procedure singleton(var M : IntSet; i : Integer);
+  begin
+    M[0] := 1; M[1] := i;
+  end(*singleton*);
+
+procedure include(var M : IntSet; i : Integer);
+  var l, r, k : Integer;
+  begin
+    (* binary search: *)
+    l := 1; r := M[0];
+    k := l + (r-l) div 2;
+    while (l<r) and (M[k]<>i) do
+      begin
+        if M[k]<i then
+          l := succ(k)
+        else
+          r := pred(k);
+        k := l + (r-l) div 2;
+      end;
+    if (k>M[0]) or (M[k]<>i) then
+      begin
+        if M[0]>=max_elems then fatal(intset_overflow);
+        if (k<=M[0]) and (M[k]<i) then
+          begin
+            move(M[k+1], M[k+2], (M[0]-k)*sizeOf(Integer));
+            M[k+1] := i;
+          end
+        else
+          begin
+            move(M[k], M[k+1], (M[0]-k+1)*sizeOf(Integer));
+            M[k] := i;
+          end;
+        inc(M[0]);
+      end;
+  end(*include*);
+
+procedure exclude(var M : IntSet; i : Integer);
+  var l, r, k : Integer;
+  begin
+    (* binary search: *)
+    l := 1; r := M[0];
+    k := l + (r-l) div 2;
+    while (l<r) and (M[k]<>i) do
+      begin
+        if M[k]<i then
+          l := succ(k)
+        else
+          r := pred(k);
+        k := l + (r-l) div 2;
+      end;
+    if (k<=M[0]) and (M[k]=i) then
+      begin
+        move(M[k+1], M[k], (M[0]-k)*sizeOf(Integer));
+        dec(M[0]);
+      end;
+  end(*exclude*);
+
+procedure setunion(var M, N : IntSet);
+  var
+    K : IntSet;
+    i, j, i_M, i_N : Integer;
+  begin
+    (* merge sort: *)
+    i := 0; i_M := 1; i_N := 1;
+    while (i_M<=M[0]) and (i_N<=N[0]) do
+      begin
+        inc(i);
+        if i>max_elems then fatal(intset_overflow);
+        if M[i_M]<N[i_N] then
+          begin
+            K[i] := M[i_M]; inc(i_M);
+          end
+        else if N[i_N]<M[i_M] then
+          begin
+            K[i] := N[i_N]; inc(i_N);
+          end
+        else
+          begin
+            K[i] := M[i_M]; inc(i_M); inc(i_N);
+          end
+      end;
+    for j := i_M to M[0] do
+      begin
+        inc(i);
+        if i>max_elems then fatal(intset_overflow);
+        K[i] := M[j];
+      end;
+    for j := i_N to N[0] do
+      begin
+        inc(i);
+        if i>max_elems then fatal(intset_overflow);
+        K[i] := N[j];
+      end;
+    K[0] := i;
+    move(K, M, succ(i)*sizeOf(Integer));
+  end(*setunion*);
+
+procedure setminus(var M, N : IntSet);
+  var
+    K : IntSet;
+    i, i_M, i_N : Integer;
+  begin
+    i := 0; i_N := 1;
+    for i_M := 1 to M[0] do
+      begin
+        while (i_N<=N[0]) and (N[i_N]<M[i_M]) do inc(i_N);
+        if (i_N>N[0]) or (N[i_N]>M[i_M]) then
+          begin
+            inc(i);
+            K[i] := M[i_M];
+          end
+        else
+          inc(i_N);
+      end;
+    K[0] := i;
+    move(K, M, succ(i)*sizeOf(Integer));
+  end(*setminus*);
+
+procedure intersect(var M, N : IntSet);
+  var
+    K : IntSet;
+    i, i_M, i_N : Integer;
+  begin
+    i := 0; i_N := 1;
+    for i_M := 1 to M[0] do
+      begin
+        while (i_N<=N[0]) and (N[i_N]<M[i_M]) do inc(i_N);
+        if (i_N<=N[0]) and (N[i_N]=M[i_M]) then
+          begin
+            inc(i);
+            K[i] := M[i_M];
+            inc(i_N);
+          end
+      end;
+    K[0] := i;
+    move(K, M, succ(i)*sizeOf(Integer));
+  end(*intersect*);
+
+function size(var M : IntSet) : Integer;
+  begin
+    size := M[0]
+  end(*size*);
+
+function member(i : Integer; var M : IntSet) : Boolean;
+  var l, r, k : Integer;
+  begin
+    (* binary search: *)
+    l := 1; r := M[0];
+    k := l + (r-l) div 2;
+    while (l<r) and (M[k]<>i) do
+      begin
+        if M[k]<i then
+          l := succ(k)
+        else
+          r := pred(k);
+        k := l + (r-l) div 2;
+      end;
+    member := (k<=M[0]) and (M[k]=i);
+  end(*member*);
+
+function isempty(var M : IntSet) : Boolean;
+  begin
+    isempty := M[0]=0
+  end(*isempty*);
+
+function equal(var M, N : IntSet) : Boolean;
+  var i : Integer;
+  begin
+    if M[0]<>N[0] then
+      equal := false
+    else
+      begin
+        for i := 1 to M[0] do
+          if M[i]<>N[i] then
+            begin
+              equal := false;
+              exit
+            end;
+        equal := true
+      end
+  end(*equal*);
+
+function subseteq(var M, N : IntSet) : Boolean;
+  var
+    i_M, i_N : Integer;
+  begin
+    if M[0]>N[0] then
+      subseteq := false
+    else
+      begin
+        i_N := 1;
+        for i_M := 1 to M[0] do
+          begin
+            while (i_N<=N[0]) and (N[i_N]<M[i_M]) do inc(i_N);
+            if (i_N>N[0]) or (N[i_N]>M[i_M]) then
+              begin
+                subseteq := false;
+                exit
+              end
+            else
+              inc(i_N);
+          end;
+        subseteq := true
+      end;
+  end(*subseteq*);
+
+function newIntSet ( var M : IntSet ) : IntSetPtr;
+  var
+    MP : IntSetPtr;
+  begin
+    getmem(MP, (size(M)+1)*sizeOf(Integer));
+    move(M, MP^, (size(M)+1)*sizeOf(Integer));
+    newIntSet := MP;
+  end(*newIntSet*);
+
+function newEmptyIntSet : IntSetPtr;
+  var
+    MP : IntSetPtr;
+  begin
+    getmem(MP, (max_elems+1)*sizeOf(Integer));
+    MP^[0] := 0;
+    newEmptyIntSet := MP
+  end(*newEmptyIntSet*);
+
+(* Quicksort: *)
+
+procedure quicksort(lo, hi: Integer;
+                    less : OrderPredicate;
+                    swap : SwapProc);
+  (* derived from the quicksort routine in QSORT.PAS in the Turbo Pascal
+     distribution *)
+  procedure sort(l, r: Integer);
+    var i, j, k : Integer;
+    begin
+      i := l; j := r; k := (l+r) DIV 2;
+      repeat
+        while less(i, k) do inc(i);
+        while less(k, j) do dec(j);
+        if i<=j then
+          begin
+            swap(i, j);
+            if k=i then k := j (* pivot element swapped! *)
+            else if k=j then k := i;
+            inc(i); dec(j);
+          end;
+      until i>j;
+      if l<j then sort(l,j);
+      if i<r then sort(i,r);
+    end(*sort*);
+  begin
+    if lo<hi then sort(lo,hi);
+  end(*quicksort*);
+
+(* Generic hash table routines: *)
+
+function hash(str : String; table_size : Integer) : Integer;
+  (* computes a hash key for str *)
+  var i, key : Integer;
+  begin
+    key := 0;
+    for i := 1 to length(str) do
+      inc(key, ord(str[i]));
+    hash := key mod table_size + 1;
+  end(*hash*);
+
+procedure newPos(var pos, incr, count : Integer; table_size : Integer);
+  (* computes a new position in the table (quadratic collision strategy)
+     - pos: current position (+inc)
+     - incr: current increment (+2)
+     - count: current number of collisions (+1)
+     quadratic collision formula for position of str after n collisions:
+       pos(str, n) = (hash(str)+n^2) mod table_size +1
+     note that n^2-(n-1)^2 = 2n-1 <=> n^2 = (n-1)^2 + (2n-1) for n>0,
+     i.e. the increment inc=2n-1 increments by two in each collision *)
+  begin
+    inc(count);
+    inc(pos, incr);
+    if pos>table_size then pos := pos mod table_size + 1;
+    inc(incr, 2)
+  end(*newPos*);
+
+function key(symbol : String;
+             table_size : Integer;
+             lookup : TableLookupProc;
+             entry  : TableEntryProc) : Integer;
+  var pos, incr, count : Integer;
+  begin
+    pos := hash(symbol, table_size);
+    incr := 1;
+    count := 0;
+    while count<=table_size do
+      if lookup(pos)='' then
+        begin
+          entry(pos, symbol);
+          key := pos;
+          exit
+        end
+      else if lookup(pos)=symbol then
+        begin
+          key := pos;
+          exit
+        end
+      else
+        newPos(pos, incr, count, table_size);
+    fatal(sym_table_overflow)
+  end(*key*);
+
+function definedKey(symbol : String;
+                    table_size : Integer;
+                    lookup : TableLookupProc) : Boolean;
+  var pos, incr, count : Integer;
+  begin
+    pos := hash(symbol, table_size);
+    incr := 1;
+    count := 0;
+    while count<=table_size do
+      if lookup(pos)='' then
+        begin
+          definedKey := false;
+          exit
+        end
+      else if lookup(pos)=symbol then
+        begin
+          definedKey := true;
+          exit
+        end
+      else
+        newPos(pos, incr, count, table_size);
+    definedKey := false
+  end(*definedKey*);
+
+(* Utility routines: *)
+
+function min(i, j : Integer) : Integer;
+  begin
+    if i<j then
+      min := i
+    else
+      min := j
+  end(*min*);
+function max(i, j : Integer) : Integer;
+  begin
+    if i>j then
+      max := i
+    else
+      max := j
+  end(*max*);
+function upper(str : String) : String;
+  var i : Integer;
+  begin
+    for i := 1 to length(str) do
+      str[i] := upCase(str[i]);
+    upper := str
+  end(*upper*);
+function strip(str : String) : String;
+  begin
+    while (length(str)>0) and ((str[1]=' ') or (str[1]=tab)) do
+      delete(str, 1, 1);
+    while (length(str)>0) and
+          ((str[length(str)]= ' ') or
+           (str[length(str)]=tab)) do
+      delete(str, length(str), 1);
+    strip := str;
+  end(*strip*);
+function blankStr(str : String) : String;
+  var i : Integer;
+  begin
+    for i := 1 to length(str) do
+      if str[i]<>tab then str[i] := ' ';
+    blankStr := str;
+  end(*blankStr*);
+function intStr(i : Integer) : String;
+  var s : String;
+  begin
+    str(i, s);
+    intStr := s
+  end(*intStr*);
+function isInt(str : String; var i : Integer) : Boolean;
+  var res : Integer;
+  begin
+    val(str, i, res);
+    isInt := res = 0;
+  end(*isInt*);
+function path(filename : String) : String;
+  var i : Integer;
+  begin
+    i := length(filename);
+    while (i>0) and (filename[i]<>'\') and (filename[i]<>':') do
+      dec(i);
+    path := copy(filename, 1, i);
+  end(*path*);
+function root(filename : String) : String;
+  var
+    i : Integer;
+  begin
+    root := filename;
+    for i := length(filename) downto 1 do
+      case filename[i] of
+        '.' :
+          begin
+            root := copy(filename, 1, i-1);
+            exit
+          end;
+        '\': exit;
+        else
+      end;
+  end(*addExt*);
+function addExt(filename, ext : String) : String;
+  (* implemented with goto for maximum efficiency *)
+  label x;
+  var
+    i : Integer;
+  begin
+    addExt := filename;
+    for i := length(filename) downto 1 do
+      case filename[i] of
+        '.' : exit;
+        '\': goto x;
+        else
+      end;
+    x : addExt := filename+'.'+ext
+  end(*addExt*);
+function file_size(filename : String) : LongInt;
+  var f : File;
+  begin
+    assign(f, filename);
+    reset(f, 1);
+    if ioresult=0 then
+      file_size := fileSize(f)
+    else
+      file_size := 0;
+    close(f);
+  end(*file_size*);
+
+(* Utility functions for list generating routines: *)
+
+function charStr(c : char; reserved : CharSet) : String;
+  function octStr(c : char) : String;
+    (* return octal string representation of character c *)
+    begin
+      octStr := intStr(ord(c) div 64)+intStr((ord(c) mod 64) div 8)+
+                intStr(ord(c) mod 8);
+    end(*octStr*);
+  begin
+    case c of
+      bs         : charStr := '\b';
+      tab        : charStr := '\t';
+      nl         : charStr := '\n';
+      cr         : charStr := '\c';
+      ff         : charStr := '\f';
+      '\'        : charStr := '\\';
+      #0..#7,      (* nonprintable characters *)
+      #11,#14..#31,
+      #127..#255 : charStr := '\'+octStr(c);
+      else if c in reserved then
+        charStr := '\'+c
+      else
+        charStr := c
+    end
+  end(*charStr*);
+
+function singleQuoteStr(str : String) : String;
+  var
+    i : Integer;
+    str1 : String;
+  begin
+    str1 := '';
+    for i := 1 to length(str) do
+      str1 := str1+charStr(str[i], ['''']);
+    singleQuoteStr := ''''+str1+''''
+  end(*singleQuoteStr*);
+
+function doubleQuoteStr(str : String) : String;
+  var
+    i : Integer;
+    str1 : String;
+  begin
+    str1 := '';
+    for i := 1 to length(str) do
+      str1 := str1+charStr(str[i], ['"']);
+    doubleQuoteStr := '"'+str1+'"'
+  end(*doubleQuoteStr*);
+
+end(*YaccBase*).

utils/tply/yaccclos.pas

@@ -0,0 +1,166 @@
+{
+  Yacc closure and first set construction algorithms. See Aho/Sethi/Ullman,
+  1986, Sections 4.4 and 4.7, for further explanation.
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-07-31 14:09 $
+
+$History: YACCCLOS.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+}
+
+
+unit YaccClos;
+
+interface
+
+
+procedure closures;
+  (* compute the closure sets *)
+
+procedure first_sets;
+  (* compute first sets and nullable flags *)
+
+implementation
+
+uses YaccBase, YaccTabl;
+
+procedure closures;
+
+  (* The closure set of a nonterminal X is the set of all nonterminals Y
+     s.t. Y appears as the first symbol in a rightmost derivation from the
+     nonterminal X (i.e. X =>+ Y ... in a rightmost derivation). We can
+     easily compute closure sets as follows:
+     - Initialize the closure set for any nonterminal X to contain all
+       nonterminals Y for which there is a rule X : Y ...
+     - Now repeatedly pass over the already constructed sets, and for
+       any nonterminal Y which has already been added to the closure set
+       of some nonterminal X, also include the closure elements of Y in
+       the closure set of X.
+     The algorithm terminates as soon as no additional symbols have been
+     added during the previous pass. *)
+
+  var sym, i, count, prev_count : Integer;
+      act_syms : IntSet;
+
+  begin
+    (* initialize closure sets: *)
+    prev_count := 0;
+    count := 0;
+    for sym := 1 to n_nts do
+      begin
+        closure_table^[sym] := newEmptyIntSet;
+        with rule_offs^[sym] do
+          for i := rule_lo to rule_hi do
+            with rule_table^[rule_no^[i]]^ do
+              if (rhs_len>0) and (rhs_sym[1]<0) then
+                include(closure_table^[sym]^, rhs_sym[1]);
+        inc(count, size(closure_table^[sym]^));
+      end;
+    (* repeated passes until no more symbols have been added during the last
+       pass: *)
+    while prev_count<count do
+      begin
+        prev_count := count;
+        count := 0;
+        for sym := 1 to n_nts do
+          begin
+            act_syms := closure_table^[sym]^;
+            for i := 1 to size(act_syms) do
+              setunion(closure_table^[sym]^, closure_table^[-act_syms[i]]^);
+            inc(count, size(closure_table^[sym]^));
+          end;
+      end;
+  end(*closures*);
+
+procedure first_sets;
+
+  (* The first set of a nonterminal X is the set of all literal symbols
+     y s.t. X =>+ y ... in some derivation of the nonterminal X. In
+     addition, X is nullable if the empty string can be derived from X.
+     Using the first set construction algorithm of Aho/Sethi/Ullman,
+     Section 4.4, the first sets and nullable flags are computed as
+     follows:
+
+     For any production X -> y1 ... yn, where the yi are grammar symbols,
+     add the symbols in the first set of y1 (y1 itself if it is a literal)
+     to the first set of X; if y1 is a nullable nonterminal, then proceed
+     with y2, etc., until either all yi have been considered or yi is non-
+     nullable (or a literal symbol). If all of the yi are nullable (in
+     particular, if n=0), then also set nullable[X] to true.
+
+     This procedure is repeated until no more symbols have been added to any
+     first set and none of the nullable flags have been changed during the
+     previous pass. *)
+
+  var i, j, l, sym : Integer;
+      n, null, done : Boolean;
+
+  begin
+    (* initialize tables: *)
+    for sym := 1 to n_nts do
+      begin
+        nullable^[sym] := false;
+        first_set_table^[sym] := newEmptyIntSet;
+      end;
+    (* repeated passes until no more symbols added and no nullable flags
+       modified: *)
+    repeat
+      done := true;
+      for i := 1 to n_rules do
+        with rule_table^[i]^ do
+          begin
+            l := size(first_set_table^[-lhs_sym]^);
+            n := nullable^[-lhs_sym];
+            null := true;
+            j := 1;
+            while (j<=rhs_len) and null do
+              begin
+                if rhs_sym[j]<0 then
+                  begin
+                    setunion( first_set_table^[-lhs_sym]^,
+                              first_set_table^[-rhs_sym[j]]^ );
+                    null := nullable^[-rhs_sym[j]];
+                  end
+                else
+                  begin
+                    include( first_set_table^[-lhs_sym]^,
+                             rhs_sym[j] );
+                    null := false;
+                  end;
+                inc(j);
+              end;
+            if null then nullable^[-lhs_sym] := true;
+            if (l<size(first_set_table^[-lhs_sym]^)) or
+               (n<>nullable^[-lhs_sym]) then
+              done := false;
+          end;
+    until done;
+  end(*first_sets*);
+
+end(*YaccClosure*).
+

utils/tply/yacclib.pas

@@ -0,0 +1,84 @@
+
+{$I-}
+
+unit YaccLib;
+
+(* Yacc Library Unit for TP Yacc Version 3.0, 6-17-91 AG *)
+
+interface
+
+const yymaxdepth = 1024;
+  (* default stack size of parser *)
+
+type YYSType = Integer;
+  (* default value type, may be redefined in Yacc output file *)
+
+var
+
+yychar   : Integer; (* current lookahead character *)
+yynerrs  : Integer; (* current number of syntax errors reported by the
+                       parser *)
+yydebug  : Boolean; (* set to true to enable debugging output of parser *)
+
+procedure yyerror ( msg : String );
+  (* error message printing routine used by the parser *)
+
+procedure yyclearin;
+  (* delete the current lookahead token *)
+
+procedure yyaccept;
+  (* trigger accept action of the parser; yyparse accepts returning 0, as if
+     it reached end of input *)
+
+procedure yyabort;
+  (* like yyaccept, but causes parser to return with value 1, as if an
+     unrecoverable syntax error had been encountered *)
+
+procedure yyerrlab;
+  (* causes error recovery to be started, as if a syntax error had been
+     encountered *)
+
+procedure yyerrok;
+  (* when in error mode, resets the parser to its normal mode of
+     operation *)
+
+(* Flags used internally by the parser routine: *)
+
+var
+
+yyflag    : ( yyfnone, yyfaccept, yyfabort, yyferror );
+yyerrflag : Integer;
+
+implementation
+
+procedure yyerror ( msg : String );
+  begin
+    writeln(msg);
+  end(*yyerrmsg*);
+
+procedure yyclearin;
+  begin
+    yychar := -1;
+  end(*yyclearin*);
+
+procedure yyaccept;
+  begin
+    yyflag := yyfaccept;
+  end(*yyaccept*);
+
+procedure yyabort;
+  begin
+    yyflag := yyfabort;
+  end(*yyabort*);
+
+procedure yyerrlab;
+  begin
+    yyflag := yyferror;
+  end(*yyerrlab*);
+
+procedure yyerrok;
+  begin
+    yyerrflag := 0;
+  end(*yyerrork*);
+
+end(*YaccLib*).

utils/tply/yacclook.pas

@@ -0,0 +1,403 @@
+{
+  Yacc lookahead computation. This implementation is based on the
+  lookahead set algorithm described in Aho/Sethi/Ullman, 1986,
+  Section 4.7.
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-07-31 14:09 $
+
+$History: YACCLOOK.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+}
+
+
+unit YaccLook;
+
+interface
+
+
+procedure lookaheads;
+  (* computes the LALR lookahead sets and enters corresponding reductions
+     into the redn table (sorted w.r.t. rule numbers) *)
+
+implementation
+
+uses YaccBase, YaccTabl;
+
+(* This implementation is based on algorithms 4.12 and 4.13 in Aho/Sethi/
+   Ullman 1986 (with some optimizations added), which avoid the need to
+   construct the full LR(1) set, and are able to compute lookaheads from
+   LR(0) kernel items only.
+
+   We start off with the LR(0) state set together with corresponding (shift
+   and goto) transitions already computed. We compute the LALR(1) lookahead
+   sets for kernel items and also record all corresponding reduce actions
+   in the reduction table (where we also have to consider nonkernel items
+   with empty right-hand side; these items also call for a reduction, but
+   never appear in the kernel item table).
+
+   This implementation uses some simple optimizations to speed up the
+   algorithm. The lookahead sets are represented by (IntSet) pointers.
+   Lookahead sets are associated with each kernel item in the item table,
+   and with each reduction in the reduction table. A kernel item
+   calling for a reduction shares its lookahead set pointer with the
+   corresponding entry in the reduction table. The lookahead set for
+   a nonkernel reduction item (item with empty right-hand side) only
+   appears in the reduction table.
+
+   The algorithm consists of two phases:
+
+   1. Initialization:
+
+      The initialization phase consists of a single traversal of the LR(0)
+      set, where we compute lookahead sets generated spontaneously (lookaheads
+      which are passed on from nonkernel items to the corresponding items in
+      successor states), initialize lookahead sets and enter them into the
+      lookahead and reduction table. Furthermore, during the initialization
+      phase we also initialize the links for the propagation of lookaheads
+      in the second phase.
+
+      To determine lookaheads and propagation links, we compute the look-
+      aheads for the closures of single LR(0) sets "in the small", according
+      to the method in Aho/Sethi/Ullman 1986 (with some modifications),
+      where we associate with each kernel item i a corresponding endmarker
+      symbol #i as its lookahead symbol.
+
+      The initialization phase proceeds as follows:
+
+      1) Initialize all nonkernel item lookahead sets to empty.
+
+      Now we pass over each state s in the LR0 set, repeating steps 2) thru
+      5) specified below:
+
+      2) Compute the closure closure(K(s)) of the states's kernel set K(s).
+
+      3) Compute the lookahead sets for closure(K(s)) (described in detail
+         below) where each kernel item i is associated with a special
+         endmarker symbol #i as lookahead.
+
+      Now the lookahead symbols, reductions and propagation links are entered
+      into the corresponding tables as follows:
+
+      4) Process kernel items: Add a propagation link from the kernel item
+         to the lookahead set of the linked item in the corresponding
+         successor state (as specified by the next field). If there is no
+         successor item (kernel item calling for a reduction), add a
+         corresponding entry into the reduction table instead.
+
+      5) Process nonkernel items: find the corresponding kernel item in the
+         successor state which is generated spontaneously from the nonkernel
+         item. Add the spontaneous lookahead symbols (except endmarker
+         symbols) of the nonkernel item determined in step 3) to the kernel
+         item. If the nonkernel item has an empty right-hand side (nonkernel
+         item calling for a reduction), add a corresponding entry into the
+         reduction table instead. Furthermore, for each endmarker symbol
+         #i in the spontaneous lookahead set of the nonkernel item, add
+         a corresponding propagation link from the ith kernel item to the
+         lookahead set of the spontaneous kernel item.
+
+      To compute the spontaneous lookaheads (step 3)), we proceed as follows:
+
+      3a) First compute the first sets of tail strings of all items in
+          closure(K(s)). The "tail string" of an item [ X -> v.Yw ], where
+          Y is a nonterminal, is the symbol sequence w, whose first set
+          induces corresponding spontaneous lookaheads in the nonkernel
+          items of the state with left-hand side Y; note that the first
+          sets of "tail strings" in items [ X -> v.yw ], where y is a
+          *terminal* symbol, are not required and hence it is not
+          necessary to compute them. We also record for each item whether
+          its tail string is "nullable", i.e., may be derived to the empty
+          string. In this case, the item also passes on its own lookaheads,
+          in addition to the first symbols of its tail string. First sets
+          and nullable flags are computed using the information in YaccTable's
+          first and nullable tables.
+
+      3b) Now follows an initialization part in which each item [ X -> v.Yw ]
+          passes on the first symbols of its tail string to the lookahead
+          sets of each corresponding nonkernel item [ Y -> .u ].
+
+      3c) Finally, we repeatedly pass over the item set, passing on
+          lookaheads from items with nullable tail strings. Each item
+          [ X -> v.Yw ] with nullable w propagates its own lookaheads to
+          all corresponding nonkernel items [ Y -> .u]. Step 3c) terminates
+          as soon as no lookahead sets have been modified during the previous
+          pass.
+
+   2. Propagation:
+
+      The second phase of the lookahead computation algorithm now is quite
+      simple. We repeatedly pass over all kernel items, propagating lookaheads
+      according to the propagation links determined in the initialization
+      phase. The algorithm terminates as soon as no lookahead sets have been
+      modified during the previous pass. *)
+
+(* Data structures used in lookahead computation: *)
+
+type
+
+SymSetArray = array [1..max_set_items] of IntSet;
+BoolArray   = array [1..max_set_items] of Boolean;
+
+var
+
+item_set       : ItemSet;
+lookahead_set  : SymSetArray;
+n_kernel_items : Integer;
+
+procedure spontaneous_lookaheads;
+
+  (* compute spontaneous lookaheads for item_set; negative symbols are
+     used for endmarkers (-i denotes endmarker #i) *)
+
+  var count, last_count, i : Integer;
+      first_syms : SymSetArray;
+      nullable : BoolArray;
+
+  function sym_count ( n : Integer ) : Integer;
+    (* count lookahead symbols *)
+    var count, i : Integer;
+    begin
+      count := 0;
+      for i := 1 to n do
+        inc(count, size(lookahead_set[i]));
+      sym_count := count;
+    end(*sym_count*);
+
+  procedure compute_first_syms ( i : Integer );
+    (* compute first set and nullable flag for tail string of item
+       number i *)
+    var j : Integer;
+    begin
+      empty(first_syms[i]); nullable[i] := true;
+      with item_set, item[i], rule_table^[rule_no]^ do
+        if (pos_no<=rhs_len) and (rhs_sym[pos_no]<0) then
+          begin
+            j := pos_no+1;
+            while (j<=rhs_len) and nullable[i] do
+              begin
+                if rhs_sym[j]<0 then
+                  begin
+                    setunion(first_syms[i], first_set_table^[-rhs_sym[j]]^);
+                    nullable[i] := YaccTabl.nullable^[-rhs_sym[j]];
+                  end
+                else
+                  begin
+                    include(first_syms[i], rhs_sym[j]);
+                    nullable[i] := false;
+                  end;
+                inc(j);
+              end;
+          end;
+    end(*compute_first_syms*);
+
+  procedure init_lookaheads ( i : Integer );
+    (* compute initial lookaheads induced by first sets of tail string
+       of item i *)
+    var sym, j : Integer;
+    begin
+      with item_set, item[i], rule_table^[rule_no]^ do
+        if (pos_no<=rhs_len) and (rhs_sym[pos_no]<0) then
+          begin
+            sym := rhs_sym[pos_no];
+            for j := n_kernel_items+1 to n_items do
+              with item[j], rule_table^[rule_no]^ do
+                if lhs_sym=sym then
+                  setunion(lookahead_set[j], first_syms[i]);
+          end
+    end(*initial_lookaheads*);
+
+  procedure propagate ( i : Integer );
+    (* propagate lookahead symbols of item i *)
+    var sym, j : Integer;
+    begin
+      with item_set, item[i], rule_table^[rule_no]^ do
+        if (pos_no<=rhs_len) and (rhs_sym[pos_no]<0) and nullable[i] then
+          begin
+            sym := rhs_sym[pos_no];
+            for j := n_kernel_items+1 to n_items do
+              with item[j], rule_table^[rule_no]^ do
+                if lhs_sym=sym then
+                  setunion(lookahead_set[j], lookahead_set[i]);
+          end
+    end(*propagate*);
+
+  begin(*spontaneous_lookaheads*)
+    with item_set do
+      begin
+        (* initialize kernel lookahead sets: *)
+        for i := 1 to n_kernel_items do singleton(lookahead_set[i], -i);
+        (* compute first sets and nullable flags: *)
+        for i := 1 to n_items do compute_first_syms(i);
+        (* initialize nonkernel lookahead sets: *)
+        for i := n_kernel_items+1 to n_items do empty(lookahead_set[i]);
+        for i := 1 to n_items do init_lookaheads(i);
+        (* repeated passes until no more lookaheads have been added
+           during the previous pass: *)
+        count := sym_count(n_items);
+        repeat
+          last_count := count;
+          for i := 1 to n_items do
+            propagate(i);
+          count := sym_count(n_items);
+        until last_count=count;
+      end;
+  end(*spontaneous_lookaheads*);
+
+function redns_less ( i, j : Integer ) : Boolean;{$ifndef fpc}far;{$endif}
+begin
+    redns_less := redn_table^[i].rule_no<redn_table^[j].rule_no
+end(*redns_less*);
+
+procedure redns_swap ( i, j : Integer );{$ifndef fpc}far;{$endif}
+  var x : RednRec;
+  begin
+    x := redn_table^[i];
+    redn_table^[i] := redn_table^[j];
+    redn_table^[j] := x;
+  end(*redns_swap*);
+
+procedure sort_redns;
+  (* sort reduction entries in act_state w.r.t. rule numbers *)
+  begin
+    with state_table^[act_state] do
+      quicksort(redns_lo, redns_hi, {$ifdef fpc}@{$endif}redns_less, {$ifdef fpc}@{$endif}redns_swap);
+  end(*sort_redns*);
+
+procedure initialize;
+
+  (* initialization phase of lookahead computation algorithm *)
+
+  procedure add_prop ( i : Integer; symset : IntSetPtr );
+    (* add a propagation link to kernel item i *)
+    var prop : PropList;
+    begin
+      new(prop);
+      prop^.symset := symset;
+      prop^.next := prop_table^[i];
+      prop_table^[i] := prop;
+    end(*add_prop*);
+
+  var i, j, k : Integer;
+      lookaheads : IntSetPtr;
+
+  begin
+    (* initialize lookahead sets and propagation links: *)
+    for i := 1 to n_items do lookahead_table^[i] := newEmptyIntSet;
+    for i := 1 to n_items do prop_table^[i] := nil;
+    act_state := 0;
+    repeat
+      with state_table^[act_state], item_set do
+        begin
+          start_redns;
+          get_item_set(act_state, item_set);
+          n_kernel_items := n_items;
+          (* compute LR(0) closure: *)
+          closure(item_set);
+          (* compute spontaneous lookaheads: *)
+          spontaneous_lookaheads;
+          (* process kernel items: *)
+          for i := 1 to n_kernel_items do with item[i] do
+            if next>0 then
+              (* add propagation link: *)
+              add_prop(item_lo+i-1, lookahead_table^[next])
+            else
+              (* enter reduce action: *)
+              add_redn(lookahead_table^[item_lo+i-1], rule_no);
+          (* process nonkernel items: *)
+          (* find successor items: *)
+          for k := trans_lo to trans_hi do
+            with trans_table^[k] do
+              for i := n_kernel_items+1 to n_items do
+                with item[i], rule_table^[rule_no]^ do
+                  if pos_no>rhs_len then
+                    next := 0
+                  else if rhs_sym[pos_no]=sym then
+                    next := find_item(next_state, rule_no, pos_no+1);
+          (* add spontaneous lookaheads and propagation links: *)
+          for i := n_kernel_items+1 to n_items do with item[i] do
+            if next>0 then
+              (* lookaheads are generated spontaneously for successor
+                 item: *)
+              for j := 1 to size(lookahead_set[i]) do
+                if lookahead_set[i][j]>=0 then
+                  include(lookahead_table^[next]^, lookahead_set[i][j])
+                else
+                  add_prop(item_lo+(-lookahead_set[i][j])-1,
+                           lookahead_table^[next])
+            else
+              (* nonkernel reduction item: *)
+              begin
+                lookaheads := newEmptyIntSet;
+                for j := 1 to size(lookahead_set[i]) do
+                  if lookahead_set[i][j]>=0 then
+                    include(lookaheads^, lookahead_set[i][j])
+                  else
+                    add_prop(item_lo+(-lookahead_set[i][j])-1,
+                             lookaheads);
+                add_redn(lookaheads, rule_no);
+              end;
+          end_redns;
+          sort_redns;
+        end;
+      inc(act_state);
+    until act_state=n_states;
+  end(*initialize*);
+
+procedure propagate;
+
+  (* propagation phase of lookahead computation algorithm *)
+
+  var i, l : Integer;
+      done : Boolean;
+      prop : PropList;
+
+  begin
+    (* repeated passes over the kernel items table until no more lookaheads
+       could be added in the previous pass: *)
+    repeat
+      done := true;
+      for i := 1 to n_items do
+        begin
+          prop := prop_table^[i];
+          while prop<>nil do with prop^ do
+            begin
+              l := size(symset^);
+              setunion(symset^, lookahead_table^[i]^);
+              if size(symset^)>l then done := false;
+              prop := next;
+            end;
+        end;
+    until done;
+  end(*propagate*);
+
+procedure lookaheads;
+  begin
+    initialize;
+    propagate;
+  end(*lookaheads*);
+
+end(*YaccLookaheads*).

utils/tply/yacclr0.pas

@@ -0,0 +1,133 @@
+{
+  LR(0) set construction. For an explanation of this algorithm, see
+  Aho/Sethi/Ullman, "Compilers : Principles, Techniques and Tools,"
+  1986, Section 4.7.
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-07-31 14:09 $
+
+$History: YACCLR0.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+}
+
+
+unit YaccLR0;
+
+interface
+
+
+procedure LR0Set;
+  (* constructs the LR(0) state set, shift and goto transitions and
+     corresponding kernel items *)
+
+implementation
+
+uses YaccBase, YaccTabl;
+
+(* This implementation is based on the algorithm given in Aho/Sethi/Ullman,
+   1986, Section 4.7. *)
+
+procedure get_syms ( var item_set : ItemSet; var sym_set : IntSet );
+  (* get the symbols for which there are transitions in item_set *)
+  var i : Integer;
+  begin
+    with item_set do
+      begin
+        empty(sym_set);
+        for i := 1 to n_items do
+          with item[i], rule_table^[rule_no]^ do
+            if pos_no<=rhs_len then
+              include(sym_set, rhs_sym[pos_no]);
+      end;
+  end(*get_syms*);
+
+function make_state ( var item_set : ItemSet; sym : Integer ) : Integer;
+  (* construct a new state for the transitions in item_set on symbol sym;
+     returns: the new state number *)
+  var i : Integer;
+  begin
+    with item_set do
+      begin
+        (* add the new state: *)
+        new_state;
+        for i := 1 to n_items do
+          with item[i], rule_table^[rule_no]^ do
+            if (pos_no<=rhs_len) and (rhs_sym[pos_no]=sym) then
+              add_item(rule_no, pos_no+1);
+        make_state := add_state;
+      end;
+  end(*make_state*);
+
+procedure add_next_links;
+  (* add links to successor items for kernel items in the active state *)
+  var k, i : Integer;
+  begin
+    with state_table^[act_state] do
+      for k := trans_lo to trans_hi do
+        with trans_table^[k] do
+          for i := item_lo to item_hi do
+            with item_table^[i], rule_table^[rule_no]^ do
+              if (pos_no<=rhs_len) and (rhs_sym[pos_no]=sym) then
+                next := find_item(next_state, rule_no, pos_no+1 );
+  end(*add_next_links*);
+
+procedure LR0Set;
+  var act_items : ItemSet;
+      act_syms  : IntSet;
+      i         : Integer;
+  begin
+    (* initialize state 0: *)
+    new_state;
+    add_item(1, 1);  (* augmented start production *)
+    act_state := add_state;
+    (* build the state table: *)
+    repeat
+      (* compute the closure of the current state: *)
+      get_item_set(act_state, act_items);
+      closure(act_items);
+      (* sort items: *)
+      sort_item_set(act_items);
+      (* determine symbols used in shift and goto transitions: *)
+      get_syms(act_items, act_syms);
+      (* add transitions: *)
+      start_trans;
+      for i := 1 to size(act_syms) do
+        if act_syms[i]=0 then
+          (* accept action *)
+          add_trans(0, 0)
+        else
+          (* shift/goto action *)
+          add_trans(act_syms[i], make_state(act_items, act_syms[i]));
+      end_trans;
+      (* add next links to kernel items: *)
+      add_next_links;
+      (* switch to next state: *)
+      inc(act_state);
+    until act_state=n_states;
+  end(*LR0Set*);
+
+end(*YaccLR0*).

utils/tply/yaccmsgs.pas

@@ -0,0 +1,188 @@
+{
+  TP Yacc message and error handling module 2-5-91 AG
+  Note: this module should be USEd by any module using the heap during
+        initialization, since it installs a heap error handler (which
+        terminates the program with fatal error `memory overflow').
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-07-31 14:50 $
+
+$History: YACCMSGS.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+}
+
+
+unit YaccMsgs;
+
+interface
+
+
+var errors, warnings : Integer;
+  (* - current error and warning count *)
+procedure error(msg : String);
+  (* - print current input line and error message (pos denotes position to
+       mark in source file line) *)
+procedure warning(msg : String);
+  (* - print warning message *)
+procedure fatal(msg : String);
+(* - writes a fatal error message, erases Yacc output file and terminates
+     the program with errorlevel 1 *)
+
+const
+
+(* sign-on and usage message: *)
+
+sign_on = 'TP Yacc Version 4.1 [May 1998], Copyright (c) 1990-98 Albert Graef';
+{$ifdef linux}
+usage   = 'Usage: pyacc [options] yacc-file[.y] [output-file[.pas]]';
+{$else}
+usage   = 'Usage: yacc [options] yacc-file[.y] [output-file[.pas]]';
+{$endif}
+options = 'Options: -v verbose, -d debug';
+
+(* command line error messages: *)
+
+invalid_option                  = 'invalid option ';
+illegal_no_args                 = 'illegal number of parameters';
+
+(* syntax errors: *)
+
+open_comment_at_eof             = '101: open comment at end of file';
+missing_string_terminator       = '102: missing string terminator';
+rcurl_expected                  = '103: %} expected';
+rbrace_expected                 = '104: } expected';
+rangle_expected                 = '105: > expected';
+ident_expected                  = '106: identifier expected';
+error_in_def                    = '110: error in definition';
+error_in_rule                   = '111: error in rule';
+syntax_error                    = '112: syntax error';
+unexpected_eof                  = '113: unexpected end of file';
+
+(* semantic errors: *)
+
+nonterm_expected                = '201: nonterminal expected';
+literal_expected                = '202: literal expected';
+double_tokennum_def             = '203: literal already defined';
+unknown_identifier              = '204: unknown identifier';
+type_error                      = '205: type error';
+range_error                     = '206: range error';
+empty_grammar                   = '207: empty grammar?';
+
+(* fatal errors: *)
+
+cannot_open_file                = 'FATAL: cannot open file ';
+write_error                     = 'FATAL: write error';
+mem_overflow                    = 'FATAL: memory overflow';
+intset_overflow                 = 'FATAL: integer set overflow';
+sym_table_overflow              = 'FATAL: symbol table overflow';
+nt_table_overflow               = 'FATAL: nonterminal table overflow';
+lit_table_overflow              = 'FATAL: literal table overflow';
+type_table_overflow             = 'FATAL: type table overflow';
+prec_table_overflow             = 'FATAL: precedence table overflow';
+rule_table_overflow             = 'FATAL: rule table overflow';
+state_table_overflow            = 'FATAL: state table overflow';
+item_table_overflow             = 'FATAL: item table overflow';
+trans_table_overflow            = 'FATAL: transition table overflow';
+redn_table_overflow             = 'FATAL: reduction table overflow';
+
+implementation
+
+uses YaccBase;
+
+procedure position(var f : Text;
+            lineNo : integer;
+            line : String;
+            pos : integer);
+  (* writes a position mark of the form
+     lineno: line
+               ^
+     on f with the caret ^ positioned at pos in line
+     a subsequent write starts at the next line, indented with tab *)
+  var
+    line1, line2 : String;
+  begin
+    (* this hack handles tab characters in line: *)
+    line1 := intStr(lineNo)+': '+line;
+    line2 := blankStr(intStr(lineNo)+': '+copy(line, 1, pos-1));
+    writeln(f, line1);
+    writeln(f, line2, '^');
+    write(f, tab)
+  end(*position*);
+
+procedure error(msg : String);
+  begin
+    inc(errors);
+    writeln;
+    position(output, lno, line, cno-tokleng);
+    writeln(msg);
+    writeln(yylst);
+    position(yylst, lno, line, cno-tokleng);
+    writeln(yylst, msg);
+    if ioresult<>0 then ;
+  end(*error*);
+
+procedure warning(msg : String);
+  begin
+    inc(warnings);
+    writeln;
+    position(output, lno, line, cno-tokleng);
+    writeln(msg);
+    writeln(yylst);
+    position(yylst, lno, line, cno-tokleng);
+    writeln(yylst, msg);
+    if ioresult<>0 then ;
+  end(*warning*);
+
+procedure fatal(msg : String);
+  begin
+    writeln;
+    writeln(msg);
+    close(yyin); close(yyout); close(yylst); erase(yyout);
+    halt(1)
+  end(*fatal*);
+
+{$ifndef fpc}
+{$ifndef win32}
+function heapErrorHandler ( size : Word ) : Integer; {$ifndef fpc}far;{$endif}
+  begin
+    if size>0 then
+      fatal(mem_overflow) (* never returns *)
+    else
+      heapErrorHandler := 1
+  end(*heapErrorHandler*);
+{$endif}
+{$endif}
+
+begin
+  errors := 0; warnings := 0;
+{$ifndef fpc}
+{$IFNDEF Win32}
+  (* install heap error handler: *)
+  heapError := @heapErrorHandler;
+{$ENDIF}
+{$endif}
+end(*YaccMsgs*).

utils/tply/yaccpars.pas

@@ -0,0 +1,581 @@
+{
+  Yacc parse table construction.
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-07-31 14:09 $
+
+$History: YACCPARS.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+}
+
+
+unit YaccPars;
+
+interface
+
+
+procedure parse_table;
+
+  (* Constructs the parse table from the information in the state,
+     transition and reduction table, and writes parse and rule table
+     information to the output file.
+
+     Rules never reduced are detected, and parsing conflicts resolved
+     according to the usual disambiguting rules:
+
+     - by default, shift/reduce conflicts are resolved in favour of
+       shift, and reduce/reduce conflicts are resolved in favour of
+       the rule appearing first in the grammar
+
+     - in the presence of precedence information, shift/reduce conflicts
+       are resolved as follows:
+       - if the rule has higher precedence than the input symbol,
+         reduce
+       - if the input symbol has higher precedence than the rule,
+         shift
+       - if rule and input symbol have the same precedence, use
+         associativity to resolve the conflict: if the symbol is
+         left-associative, reduce; if right-associative, shift;
+         if nonassociative, error.
+
+     The default action for any state is error, unless the state
+     only has a single reduce action, and no shift (or nonassoc-induced
+     error) actions, in which case the default action is the reduction.
+     An accept action is generated for the shift-endmarker action.
+
+     If the verbose option is enabled, the parse_table routine also writes
+     a readable listing of the generated parser to the .LST file, including
+     descriptions of parse conflicts and rules never reduced.
+
+     Parse table actions are encoded as follows:
+     - positive: next state (shift or goto action)
+     - negative: rule to reduce (reduce action)
+     - 0: error (in default action table) or accept (in shift/reduce
+          action table)
+
+     The tables are written out as a collection of typed array constants:
+
+     type YYARec = record { action record }
+                     sym, act : Integer; { symbol and action }
+                   end;
+          YYRRec = record { rule record }
+                     len, sym : Integer; { length and lhs symbol }
+                   end;
+
+     const
+
+     yynacts   = ...; { number of parse table (shift and reduce) actions }
+     yyngotos  = ...; { number of goto actions }
+     yynstates = ...; { number of states }
+     yynrules  = ...; { number of rules }
+
+     yya : array [1..yynacts] of YYARec = ...;
+       { shift and reduce actions }
+     yyg : array [1..yyngotos] of YYARec = ...;
+       { goto actions }
+     yyd : array [0..yynstates-1] of Integer = ...;
+       { default actions }
+     yyal, yyah,
+     yygl, yygh : array [0..yynstates-1] of Integer = ...;
+       { offsets into action and goto table }
+
+     yyr : array [1..yynrules] of YYRRec = ...;
+
+  *)
+
+var shift_reduce, reduce_reduce, never_reduced : Integer;
+  (* number of parsing conflicts and unreduced rules detected during
+     parse table generation *)
+
+implementation
+
+uses YaccBase, YaccTabl;
+
+var reduced : array [1..max_rules] of Boolean;
+
+var yynacts, yyngotos, yynstates : Integer;
+    yyd : array [0..max_states-1] of Integer;
+    yyal, yyah, yygl, yygh : array [0..max_states-1] of Integer;
+
+function ruleStr ( i : Integer ) : String;
+  (* returns print representation of rule number i *)
+  var str : String; j : Integer;
+  begin
+    with rule_table^[i]^ do
+      begin
+        str := pname(lhs_sym)+' :';
+        for j := 1 to rhs_len do
+          str := str+' '+pname(rhs_sym[j]);
+      end;
+    ruleStr := str;
+  end(*ruleStr*);
+
+function itemStr ( var item_set : ItemSet; i : Integer ) : String;
+  (* returns print representation of item number i in item_set *)
+  var str : String; j : Integer;
+  begin
+    with item_set, item[i], rule_table^[rule_no]^ do
+      begin
+        str := pname(lhs_sym)+' :';
+        for j := 1 to pos_no-1 do
+          str := str+' '+pname(rhs_sym[j]);
+        str := str+' _';
+        for j := pos_no to rhs_len do
+          str := str+' '+pname(rhs_sym[j]);
+      end;
+    itemStr := str;
+  end(*itemStr*);
+
+procedure build;
+
+  (* build the parse table, resolve conflicts *)
+
+  var
+
+    i, j, k, s,
+    n_errors,
+    n_shifts,
+    n_gotos,
+    n_reductions,
+    n_conflicts : Integer;
+
+  item_set : ItemSet;
+
+  begin
+
+    (* initialize: *)
+
+    shift_reduce := 0; reduce_reduce := 0; never_reduced := 0;
+    for i := 1 to n_rules do reduced[i] := false;
+
+    (* traverse the state table: *)
+
+    for s := 0 to n_states-1 do with state_table^[s] do
+
+      begin
+
+        if verbose then
+          begin
+            writeln(yylst);
+            writeln(yylst, 'state ', s, ':');
+          end;
+
+        (* Check shift and reduce actions, resolve conflicts.
+           The number of error actions generated by nonassoc's is counted
+           in n_errors, the number of conflicts reported in n_conflicts.
+           Shift actions ruled out by disambiguating rules are flagged by
+           setting the corresponding next_state to -1. *)
+
+        n_errors := 0; n_conflicts := 0;
+
+        for i := trans_lo to trans_hi do with trans_table^[i] do
+          if sym>=0 then
+            for j := redns_lo to redns_hi do with redn_table^[j] do
+              if member(sym, symset^) then
+                if (sym_prec^[sym]>0) and (rule_prec^[rule_no]>0) then
+                  (* resolve conflict using precedence: *)
+                  if rule_prec^[rule_no]=sym_prec^[sym] then
+                    case prec_table^[sym_prec^[sym]] of
+                      left     : (* reduce *)
+                                 next_state := -1;
+                      right    : (* shift *)
+                                 exclude(symset^, sym);
+                      nonassoc : (* error *)
+                                 begin
+                                   inc(n_errors);
+                                   next_state := -1;
+                                   exclude(symset^, sym);
+                                 end;
+                    end
+                  else if rule_prec^[rule_no]>sym_prec^[sym] then
+                    (* reduce *)
+                    next_state := -1
+                  else
+                    (* shift *)
+                    exclude(symset^, sym)
+                else
+                  (* shift/reduce conflict: *)
+                  begin
+                    if verbose then
+                      begin
+                        if n_conflicts=0 then
+                          begin
+                            writeln(yylst);
+                            writeln(yylst, tab, '*** conflicts:');
+                            writeln(yylst);
+                          end;
+                        writeln(yylst, tab,
+                                       'shift ', next_state, ', ',
+                                       'reduce ', rule_no-1, ' on ',
+                                       pname(sym));
+                      end;
+                    inc(n_conflicts); inc(shift_reduce);
+                    exclude(symset^, sym);
+                  end;
+
+        for i := redns_lo to redns_hi do
+          for j := i+1 to redns_hi do with redn_table^[j] do
+            begin
+              for k := 1 to size(symset^) do
+                if member(symset^[k], redn_table^[i].symset^) then
+                  (* reduce/reduce conflict: *)
+                  begin
+                    if verbose then
+                      begin
+                        if n_conflicts=0 then
+                          begin
+                            writeln(yylst);
+                            writeln(yylst, tab, '*** conflicts:');
+                            writeln(yylst);
+                          end;
+                        writeln(yylst, tab,
+                                       'reduce ',
+                                       redn_table^[i].rule_no-1, ', ',
+                                       'reduce ', rule_no-1, ' on ',
+                                       pname(symset^[k]));
+                      end;
+                    inc(n_conflicts); inc(reduce_reduce);
+                  end;
+              setminus(symset^, redn_table^[i].symset^);
+            end;
+
+        (* Count goto, shift and reduce actions to generate. *)
+
+        n_gotos := 0; n_shifts := 0; n_reductions := 0;
+
+        for i := trans_lo to trans_hi do with trans_table^[i] do
+          if next_state<>-1 then
+            if sym<0 then
+              inc(n_gotos)
+            else
+              inc(n_shifts);
+
+        for i := redns_lo to redns_hi do with redn_table^[i] do
+          if size(symset^)>0 then
+            inc(n_reductions);
+
+        (* Determine default action. *)
+
+        if (n_shifts+n_errors=0) and (n_reductions=1) then
+          (* default action is the reduction *)
+          with redn_table^[redns_lo] do
+            yyd[s] := -(rule_no-1)
+        else
+          (* default action is error *)
+          yyd[s] := 0;
+
+        (* Flag reduced rules. *)
+
+        for i := redns_lo to redns_hi do
+          with redn_table^[i] do
+            reduced[rule_no] := true;
+
+        if verbose then
+
+          begin
+
+            (* List kernel items. *)
+
+            writeln(yylst);
+            get_item_set(s, item_set);
+            closure(item_set);
+            sort_item_set(item_set);
+            with item_set do
+              begin
+                for i := 1 to n_items do
+                  with item[i], rule_table^[rule_no]^ do
+                    if (rule_no=1) or (pos_no>1) or (rhs_len=0) then
+                      if pos_no>rhs_len then
+                        writeln(yylst, tab,
+                                       itemStr(item_set, i), tab,
+                                       '(', rule_no-1, ')')
+                      else
+                        writeln(yylst, tab, itemStr(item_set, i));
+              end;
+
+            (* List parse actions. *)
+
+            (* shift, reduce and default actions: *)
+
+            if (n_shifts+n_errors=0) and (n_reductions=1) then
+              (* default action is the reduction *)
+              with redn_table^[redns_lo] do
+                begin
+                  writeln(yylst);
+                  writeln(yylst, tab, '.', tab, 'reduce ', rule_no-1 );
+                end
+            else
+              (* default action is error *)
+              begin
+                writeln(yylst);
+                for i := trans_lo to trans_hi do with trans_table^[i] do
+                  if next_state<>-1 then
+                    if sym=0 then
+                      (* accept action *)
+                      writeln(yylst, tab, pname(sym), tab, 'accept')
+                    else if sym>0 then
+                      (* shift action *)
+                      writeln(yylst, tab,
+                                     pname(sym), tab, 'shift ', next_state);
+                for i := redns_lo to redns_hi do
+                  with redn_table^[i] do
+                    for j := 1 to size(symset^) do
+                      (* reduce action *)
+                      writeln(yylst, tab,
+                                     pname(symset^[j]), tab, 'reduce ',
+                                     rule_no-1);
+                (* error action *)
+                writeln(yylst, tab, '.', tab, 'error');
+              end;
+
+            (* goto actions: *)
+
+            if n_gotos>0 then
+              begin
+                writeln(yylst);
+                for i := trans_lo to trans_hi do with trans_table^[i] do
+                  if sym<0 then
+                    writeln(yylst, tab,
+                                   pname(sym), tab, 'goto ', next_state);
+              end;
+
+          end;
+
+      end;
+
+    for i := 2 to n_rules do
+      if not reduced[i] then inc(never_reduced);
+
+    if verbose then
+      begin
+        writeln(yylst);
+        if shift_reduce>0 then
+          writeln(yylst, shift_reduce, ' shift/reduce conflicts.');
+        if reduce_reduce>0 then
+          writeln(yylst, reduce_reduce, ' reduce/reduce conflicts.');
+        if never_reduced>0 then
+          writeln(yylst, never_reduced, ' rules never reduced.');
+      end;
+
+    (* report rules never reduced: *)
+
+    if (never_reduced>0) and verbose then
+      begin
+        writeln(yylst);
+        writeln(yylst, '*** rules never reduced:');
+        for i := 2 to n_rules do if not reduced[i] then
+          begin
+            writeln(yylst);
+            writeln(yylst, ruleStr(i), tab, '(', i-1, ')');
+          end;
+      end;
+
+  end(*build*);
+
+procedure counters;
+
+  (* initialize counters and offsets *)
+
+  var s, i : Integer;
+
+  begin
+
+    yynstates := n_states; yynacts := 0; yyngotos := 0;
+
+    for s := 0 to n_states-1 do with state_table^[s] do
+      begin
+        yyal[s] := yynacts+1; yygl[s] := yyngotos+1;
+        if yyd[s]=0 then
+          begin
+            for i := trans_lo to trans_hi do with trans_table^[i] do
+              if (sym>=0) and (next_state<>-1) then
+                inc(yynacts);
+            for i := redns_lo to redns_hi do with redn_table^[i] do
+              inc(yynacts, size(symset^));
+          end;
+        for i := trans_lo to trans_hi do with trans_table^[i] do
+          if sym<0 then
+            inc(yyngotos);
+        yyah[s] := yynacts; yygh[s] := yyngotos;
+      end;
+
+  end(*counters*);
+
+procedure tables;
+
+  (* write tables to output file *)
+
+  var s, i, j, count : Integer;
+
+  begin
+
+    writeln(yyout);
+    writeln(yyout, 'type YYARec = record');
+    writeln(yyout, '                sym, act : Integer;');
+    writeln(yyout, '              end;');
+    writeln(yyout, '     YYRRec = record');
+    writeln(yyout, '                len, sym : Integer;');
+    writeln(yyout, '              end;');
+    writeln(yyout);
+    writeln(yyout, 'const');
+
+    (* counters: *)
+
+    writeln(yyout);
+    writeln(yyout, 'yynacts   = ', yynacts, ';');
+    writeln(yyout, 'yyngotos  = ', yyngotos, ';');
+    writeln(yyout, 'yynstates = ', yynstates, ';');
+    writeln(yyout, 'yynrules  = ', n_rules-1, ';');
+
+    (* shift/reduce table: *)
+
+    writeln(yyout);
+    writeln(yyout, 'yya : array [1..yynacts] of YYARec = (');
+    count := 0;
+    for s := 0 to n_states-1 do with state_table^[s] do
+      begin
+        writeln(yyout, '{ ', s, ': }');
+        if yyd[s]=0 then
+          begin
+            for i := trans_lo to trans_hi do with trans_table^[i] do
+              if (next_state<>-1) and (sym>=0) then
+                begin
+                  inc(count);
+                  if sym=0 then
+                    write(yyout, '  ( sym: 0; act: 0 )')
+                  else
+                    write(yyout, '  ( sym: ', sym, '; act: ',
+                                 next_state, ' )');
+                  if count<yynacts then write(yyout, ',');
+                  writeln(yyout);
+                end;
+            for i := redns_lo to redns_hi do with redn_table^[i] do
+              for j := 1 to size(symset^) do
+                begin
+                  inc(count);
+                  write(yyout, '  ( sym: ', symset^[j], '; act: ',
+                               -(rule_no-1), ' )');
+                  if count<yynacts then write(yyout, ',');
+                  writeln(yyout);
+                end;
+        end;
+      end;
+    writeln(yyout, ');');
+
+    (* goto table: *)
+
+    writeln(yyout);
+    writeln(yyout, 'yyg : array [1..yyngotos] of YYARec = (');
+    count := 0;
+    for s := 0 to n_states-1 do with state_table^[s] do
+      begin
+        writeln(yyout, '{ ', s, ': }');
+        for i := trans_lo to trans_hi do with trans_table^[i] do
+          if sym<0 then
+            begin
+              inc(count);
+              write(yyout, '  ( sym: ', sym, '; act: ', next_state, ' )');
+              if count<yyngotos then write(yyout, ',');
+              writeln(yyout);
+            end;
+      end;
+    writeln(yyout, ');');
+
+    (* default action table: *)
+
+    writeln(yyout);
+    writeln(yyout, 'yyd : array [0..yynstates-1] of Integer = (');
+    for s := 0 to n_states-1 do
+      begin
+        write(yyout, '{ ', s, ': } ', yyd[s]);
+        if s<n_states-1 then write(yyout, ',');
+        writeln(yyout);
+      end;
+    writeln(yyout, ');');
+
+    (* offset tables: *)
+
+    writeln(yyout);
+    writeln(yyout, 'yyal : array [0..yynstates-1] of Integer = (');
+    for s := 0 to n_states-1 do
+      begin
+        write(yyout, '{ ', s, ': } ', yyal[s]);
+        if s<n_states-1 then write(yyout, ',');
+        writeln(yyout);
+      end;
+    writeln(yyout, ');');
+    writeln(yyout);
+    writeln(yyout, 'yyah : array [0..yynstates-1] of Integer = (');
+    for s := 0 to n_states-1 do
+      begin
+        write(yyout, '{ ', s, ': } ', yyah[s]);
+        if s<n_states-1 then write(yyout, ',');
+        writeln(yyout);
+      end;
+    writeln(yyout, ');');
+    writeln(yyout);
+    writeln(yyout, 'yygl : array [0..yynstates-1] of Integer = (');
+    for s := 0 to n_states-1 do
+      begin
+        write(yyout, '{ ', s, ': } ', yygl[s]);
+        if s<n_states-1 then write(yyout, ',');
+        writeln(yyout);
+      end;
+    writeln(yyout, ');');
+    writeln(yyout);
+    writeln(yyout, 'yygh : array [0..yynstates-1] of Integer = (');
+    for s := 0 to n_states-1 do
+      begin
+        write(yyout, '{ ', s, ': } ', yygh[s]);
+        if s<n_states-1 then write(yyout, ',');
+        writeln(yyout);
+      end;
+    writeln(yyout, ');');
+
+    (* rule table: *)
+
+    writeln(yyout);
+    writeln(yyout, 'yyr : array [1..yynrules] of YYRRec = (');
+    for i := 2 to n_rules do with rule_table^[i]^ do
+      begin
+        write(yyout, '{ ', i-1, ': } ', '( len: ', rhs_len,
+                                        '; sym: ', lhs_sym, ' )');
+        if i<n_rules then write(yyout, ',');
+        writeln(yyout);
+      end;
+    writeln(yyout, ');');
+
+    writeln(yyout);
+
+  end(*tables*);
+
+procedure parse_table;
+  begin
+    build; counters; tables;
+  end(*parse_table*);
+
+end(*YaccParseTable*).

utils/tply/yaccsem.pas

@@ -0,0 +1,595 @@
+{
+  Semantic routines for the Yacc parser.
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-08-01 6:03 $
+
+$History: YACCSEM.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+}
+
+
+unit YaccSem;
+
+interface
+
+
+var
+
+act_prec : Integer;
+  (* active precedence level in token and precedence declarations (0 in
+     %token declaration) *)
+act_type : Integer;
+  (* active type tag in token, precedence and type declarations *)
+
+procedure yyerror ( msg : String );
+  (* YaccLib.yyerror redefined to ignore 'syntax error' message; the parser
+     does its own error handling *)
+
+function sym ( k : Integer ) : Integer;
+  (* returns internal symbol number for the symbol k; if k is yet undefined,
+     a new nonterminal or literal symbol is created, according to the
+     appearance of symbol k (nonterminal if an ordinary identifier, literal
+     otherwise) *)
+
+function ntsym ( k : Integer ) : Integer;
+  (* like sym, but requires symbol k to be a nonterminal symbol; if it
+     is already defined a literal, an error message is issued, and a dummy
+     nonterminal symbol returned *)
+
+function litsym ( k : Integer; n : Integer ) : Integer;
+  (* same for literal symbols; if n>0 it denotes the literal number to be
+     assigned to the symbol; when a new literal identifier is defined, a
+     corresponding constant definition is also written to the definition
+     file *)
+
+procedure next_section;
+  (* find next section mark (%%) in code template *)
+
+procedure definitions;
+  (* if necessary, write out definition of the semantic value type YYSType *)
+
+procedure copy_code;
+  (* copy Turbo Pascal code section ( %{ ... %} ) to output file *)
+
+procedure copy_action;
+  (* copy an action to the output file *)
+
+procedure copy_single_action;
+  (* like copy_action, but action must be single statement terminated
+     with `;' *)
+
+procedure copy_rest_of_file;
+  (* copies the rest of the source file to the output file *)
+
+procedure start_rule ( sym : Integer );
+  (* start a new rule with lhs nonterminal symbol sym *)
+
+procedure start_body;
+  (* start a new rule body (rhs) *)
+
+procedure end_body;
+  (* end a rule body *)
+
+procedure add_symbol ( sym : Integer );
+  (* add the denoted symbol to the current rule body *)
+
+procedure add_action;
+  (* add an action to the current rule body *)
+
+procedure add_rule_prec ( sym : Integer );
+  (* add the precedence of terminal symbol sym to the current rule *)
+
+procedure generate_parser;
+  (* generate the parse table *)
+
+implementation
+
+uses YaccBase, YaccTabl, YaccClos, YaccLR0, YaccLook,
+  YaccPars, YaccMsgs;
+
+procedure yyerror ( msg : String );
+  begin
+    if msg='syntax error' then
+      (* ignore *)
+    else
+      fatal(msg)
+  end(*yyerror*);
+
+function act_char : char;
+  begin
+    if cno>length(line) then
+      if eof(yyin) then
+        act_char := #0
+      else
+        act_char := nl
+    else
+      act_char := line[cno]
+  end(*act_char*);
+
+function lookahead_char : char;
+  begin
+    if succ(cno)>length(line) then
+      if eof(yyin) then
+        lookahead_char := #0
+      else
+        lookahead_char := nl
+    else
+      lookahead_char := line[succ(cno)]
+  end(*lookahead_char*);
+
+procedure next_char;
+  begin
+    if cno>length(line) then
+      if eof(yyin) then
+        { nop }
+      else
+        begin
+          readln(yyin, line);
+          inc(lno); cno := 1
+        end
+    else
+      inc(cno)
+  end(*next_char*);
+
+var
+
+(* Current rule: *)
+
+act_rule      : RuleRec;
+
+(* Actions: *)
+
+n_act : Integer;
+p_act : Boolean;
+
+function sym ( k : Integer ) : Integer;
+  var s : Integer;
+  begin
+    if is_def_key(k, s) then
+      sym := s
+    else if sym_table^[k].pname^[1]='''' then
+      begin
+        s := new_lit;
+        def_key(k, s);
+        sym := s;
+      end
+    else
+      begin
+        s := new_nt;
+        def_key(k, s);
+        sym := s;
+      end
+  end(*sym*);
+
+function ntsym ( k : Integer ) : Integer;
+  var s : Integer;
+  begin
+    if is_def_key(k, s) then
+      if s<0 then
+        ntsym := s
+      else
+        begin
+          error(nonterm_expected);
+          ntsym := -1;
+        end
+    else if sym_table^[k].pname^[1]='''' then
+      begin
+        error(nonterm_expected);
+        ntsym := -1;
+      end
+    else
+      begin
+        s := new_nt;
+        def_key(k, s);
+        ntsym := s;
+      end
+  end(*ntsym*);
+
+function litsym ( k : Integer; n : Integer ) : Integer;
+  var s : Integer;
+  begin
+    if is_def_key(k, s) then
+      if s>=0 then
+        begin
+          if n>0 then error(double_tokennum_def);
+          litsym := s;
+        end
+      else
+        begin
+          error(literal_expected);
+          litsym := 1;
+        end
+    else if sym_table^[k].pname^[1]='''' then
+      begin
+        if n>0 then
+          begin
+            add_lit(n);
+            s := n;
+          end
+        else
+          s := new_lit;
+        def_key(k, s);
+        litsym := s;
+      end
+    else
+      begin
+        if n>0 then
+          begin
+            add_lit(n);
+            s := n;
+          end
+        else
+          s := new_lit;
+        def_key(k, s);
+        writeln(yyout, 'const ', pname(s), ' = ', s, ';');
+        litsym := s;
+      end;
+  end(*litsym*);
+
+procedure next_section;
+  var line : String;
+  begin
+    while not eof(yycod) do
+      begin
+        readln(yycod, line);
+        if line='%%' then exit;
+        writeln(yyout, line);
+      end;
+  end(*next_section*);
+
+procedure definitions;
+  var i : Integer;
+  begin
+    if n_types>0 then
+      begin
+        writeln(yyout);
+        writeln(yyout, 'type YYSType = record case Integer of');
+        for i := 1 to n_types do
+          writeln(yyout, ' ':15, i:3, ' : ( ',
+                         'yy', sym_table^[type_table^[i]].pname^, ' : ',
+                         sym_table^[type_table^[i]].pname^, ' );');
+        writeln(yyout, ' ':15, 'end(*YYSType*);');
+      end;
+  end(*definitions*);
+
+procedure copy_code;
+  var str_state : Boolean;
+  begin
+    str_state := false;
+    while act_char<>#0 do
+      if act_char=nl then
+        begin
+          writeln(yyout);
+          next_char;
+        end
+      else if act_char='''' then
+        begin
+          write(yyout, '''');
+          str_state := not str_state;
+          next_char;
+        end
+      else if not str_state and (act_char='%') and (lookahead_char='}') then
+        exit
+      else
+        begin
+          write(yyout, act_char);
+          next_char;
+        end;
+  end(*copy_code*);
+
+procedure scan_val;
+  (* process a $ value in an action
+     (not very pretty, but it does its job) *)
+  var tag, numstr : String; i, code : Integer;
+  begin
+    tokleng := 0;
+    next_char;
+    if act_char='<' then
+      begin
+        (* process type tag: *)
+        next_char;
+        tag := '';
+        while (act_char<>nl) and (act_char<>#0) and (act_char<>'>') do
+          begin
+            tag := tag+act_char;
+            next_char;
+          end;
+        if act_char='>' then
+          begin
+            if not search_type(tag) then
+              begin
+                tokleng := length(tag);
+                error(unknown_identifier);
+              end;
+            next_char;
+          end
+        else
+          error(syntax_error);
+      end
+    else
+      tag := '';
+    tokleng := 0;
+    if act_char='$' then
+      begin
+        (* left-hand side value: *)
+        write(yyout, 'yyval');
+        (* check for value type: *)
+        if (tag='') and (n_types>0) then with act_rule do
+          if sym_type^[lhs_sym]>0 then
+            tag := sym_table^[sym_type^[lhs_sym]].pname^
+          else
+            begin
+              tokleng := 1;
+              error(type_error);
+            end;
+        if tag<>'' then write(yyout, '.yy', tag);
+        next_char;
+      end
+    else
+      begin
+        (* right-hand side value: *)
+        if act_char='-' then
+          begin
+            numstr := '-';
+            next_char;
+          end
+        else
+          numstr := '';
+        while ('0'<=act_char) and (act_char<='9') do
+          begin
+            numstr := numstr+act_char;
+            next_char;
+          end;
+        if numstr<>'' then
+          begin
+            val(numstr, i, code);
+            if code=0 then
+              if i<=act_rule.rhs_len then
+                begin
+                  write(yyout, 'yyv[yysp-', act_rule.rhs_len-i, ']');
+                  (* check for value type: *)
+                  if (tag='') and (n_types>0) then with act_rule do
+                    if i<=0 then
+                      begin
+                        tokleng := length(numstr)+1;
+                        error(type_error);
+                      end
+                    else if sym_type^[rhs_sym[i]]>0 then
+                      tag := sym_table^[sym_type^[rhs_sym[i]]].pname^
+                    else
+                      begin
+                        tokleng := length(numstr)+1;
+                        error(type_error);
+                      end;
+                  if tag<>'' then write(yyout, '.yy', tag);
+                end
+              else
+                begin
+                  tokleng := length(numstr);
+                  error(range_error);
+                end
+            else
+              error(syntax_error)
+          end
+        else
+          error(syntax_error)
+      end
+  end(*scan_val*);
+
+procedure copy_action;
+  var str_state : Boolean;
+  begin
+    str_state := false;
+    while act_char=' ' do next_char;
+    write(yyout, ' ':9);
+    while act_char<>#0 do
+      if act_char=nl then
+        begin
+          writeln(yyout);
+          next_char;
+          while act_char=' ' do next_char;
+          write(yyout, ' ':9);
+        end
+      else if act_char='''' then
+        begin
+          write(yyout, '''');
+          str_state := not str_state;
+          next_char;
+        end
+      else if not str_state and (act_char='}') then
+        begin
+          writeln(yyout);
+          exit;
+        end
+      else if not str_state and (act_char='$') then
+        scan_val
+      else
+        begin
+          write(yyout, act_char);
+          next_char;
+        end;
+  end(*copy_action*);
+
+procedure copy_single_action;
+  var str_state : Boolean;
+  begin
+    str_state := false;
+    while act_char=' ' do next_char;
+    write(yyout, ' ':9);
+    while act_char<>#0 do
+      if act_char=nl then
+        begin
+          writeln(yyout);
+          next_char;
+          while act_char=' ' do next_char;
+          write(yyout, ' ':9);
+        end
+      else if act_char='''' then
+        begin
+          write(yyout, '''');
+          str_state := not str_state;
+          next_char;
+        end
+      else if not str_state and (act_char=';') then
+        begin
+          writeln(yyout, ';');
+          exit;
+        end
+      else if not str_state and (act_char='$') then
+        scan_val
+      else
+        begin
+          write(yyout, act_char);
+          next_char;
+        end;
+  end(*copy_single_action*);
+
+procedure copy_rest_of_file;
+  begin
+    while act_char<>#0 do
+      if act_char=nl then
+        begin
+          writeln(yyout);
+          next_char;
+        end
+      else
+        begin
+          write(yyout, act_char);
+          next_char;
+        end;
+  end(*copy_rest_of_file*);
+
+procedure start_rule ( sym : Integer );
+  begin
+    if n_rules=0 then
+      begin
+        (* fix start nonterminal of the grammar: *)
+        if startnt=0 then startnt := sym;
+        (* add augmented start production: *)
+        with act_rule do
+          begin
+            lhs_sym := -1;
+            rhs_len := 2;
+            rhs_sym[1] := startnt;
+            rhs_sym[2] := 0; (* end marker *)
+          end;
+        add_rule(newRuleRec(act_rule));
+      end;
+    act_rule.lhs_sym := sym;
+  end(*start_rule*);
+
+procedure start_body;
+  begin
+    act_rule.rhs_len := 0;
+    p_act := false;
+    writeln(yyout, n_rules:4, ' : begin');
+  end(*start_body*);
+
+procedure end_body;
+  begin
+    if not p_act and (act_rule.rhs_len>0) then
+      (* add default action: *)
+      writeln(yyout, ' ':9, 'yyval := yyv[yysp-',
+                            act_rule.rhs_len-1, '];');
+    add_rule(newRuleRec(act_rule));
+    writeln(yyout, ' ':7, 'end;');
+  end(*end_body*);
+
+procedure add_rule_action;
+  (* process an action inside a rule *)
+  var k : Integer; r : RuleRec;
+  begin
+    writeln(yyout, ' ':7, 'end;');
+    inc(n_act);
+    k := get_key('$$'+intStr(n_act));
+    with r do
+      begin
+        lhs_sym := new_nt;
+        def_key(k, lhs_sym);
+        rhs_len := 0;
+      end;
+    with act_rule do
+      begin
+        inc(rhs_len);
+        if rhs_len>max_rule_len then fatal(rule_table_overflow);
+        rhs_sym[rhs_len] := r.lhs_sym;
+      end;
+    add_rule(newRuleRec(r));
+    rule_prec^[n_rules+1] := rule_prec^[n_rules];
+    rule_prec^[n_rules] := 0;
+    writeln(yyout, n_rules:4, ' : begin');
+  end(*add_rule_action*);
+
+procedure add_symbol ( sym : Integer );
+  begin
+    if p_act then add_rule_action;
+    p_act := false;
+    with act_rule do
+      begin
+        inc(rhs_len);
+        if rhs_len>max_rule_len then fatal(rule_table_overflow);
+        rhs_sym[rhs_len] := sym;
+        if sym>=0 then rule_prec^[n_rules+1] := sym_prec^[sym]
+      end
+  end(*add_symbol*);
+
+procedure add_action;
+  begin
+    if p_act then add_rule_action;
+    p_act := true;
+  end(*add_action*);
+
+procedure add_rule_prec ( sym : Integer );
+  begin
+    rule_prec^[n_rules+1] := sym_prec^[sym];
+  end(*add_rule_prec*);
+
+procedure generate_parser;
+  begin
+    if startnt=0 then error(empty_grammar);
+    if errors=0 then
+      begin
+        write('sort ... ');
+        sort_rules; rule_offsets;
+        write('closures ... ');
+        closures;
+        write('first sets ... ');
+        first_sets;
+        write('LR0 set ... ');
+        LR0Set;
+        write('lookaheads ... ');
+        lookaheads;
+        writeln;
+        write('code generation ... ');
+        parse_table;
+      end;
+  end(*generate_parser*);
+
+begin
+  n_act := 0;
+end(*YaccSem*).

utils/tply/yacctabl.pas

@@ -0,0 +1,967 @@
+{
+  This module collects the various tables used by the Yacc program:
+  - the symbol table
+  - the rule table
+  - the precedence table
+  - the closure table
+  - the LALR state, item, transition and reduction table
+  Note: All tables are allocated dynamically (at initialization time)
+  because of the 64KB static data limit. *)
+
+
+  Copyright (c) 1990-92  Albert Graef <[email protected]>
+  Copyright (C) 1996     Berend de Boer <[email protected]>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program; if not, write to the Free Software
+  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+$Revision$
+$Modtime: 96-07-31 21:15 $
+
+$History: YACCTABL.PAS $
+ *
+ * *****************  Version 2  *****************
+ * User: Berend       Date: 96-10-10   Time: 21:16
+ * Updated in $/Lex and Yacc/tply
+ * Updated for protected mode, windows and Delphi 1.X and 2.X.
+
+}
+
+
+unit YaccTabl;
+
+interface
+
+uses
+  YaccBase;
+
+
+{$IFNDEF Win32}
+var max_bytes : LongInt;
+  (* available memory *)
+
+function n_bytes : LongInt;
+  (* memory actually used *)
+{$ENDIF}
+
+const
+
+(* Maximum table sizes: *)
+
+max_keys           =  997;  (* size of hash symbol table (prime number!)   *)
+{$IFDEF MsDos}
+max_nts            =  300;  (* maximum number of nonterminals              *)
+max_lits           =  556;  (* number of literals (300+256)                *)
+max_rules          =  301;  (* number of rules (300+1)                     *)
+max_types          =  100;  (* number of type tags                         *)
+max_prec           =   50;  (* maximum precedence level                    *)
+max_states         =  600;  (* number of LR(0) states                      *)
+max_items          = 2400;  (* number of items                             *)
+max_trans          = 2400;  (* number of transitions                       *)
+max_redns          = 1200;  (* number of reductions                        *)
+{$ELSE}
+max_nts            =  900;  (* maximum number of nonterminals              *)
+max_lits           =  max_nts+256;  (* number of literals (300+256)                *)
+max_rules          =  max_nts+1;  (* number of rules (300+1)                     *)
+max_types          =  100;  (* number of type tags                         *)
+max_prec           =   50;  (* maximum precedence level                    *)
+{$IFDEF Windows}
+max_states         =  800;  (* number of LR(0) states                      *)
+{$ELSE}
+max_states         = 1200;  (* number of LR(0) states                      *)
+{$ENDIF}
+max_items          = 9600;  (* number of items                             *)
+max_trans          = 9600;  (* number of transitions                       *)
+max_redns          = 1200;  (* number of reductions                        *)
+{$ENDIF}
+
+{$IFDEF MsDos}
+max_rule_len       =   64;  (* maximum length of rules                     *)
+max_set_items      =   64;  (* maximum number of items in an item set      *)
+{$ELSE}
+max_rule_len       =   64;  (* maximum length of rules                     *)
+max_set_items      =   96;  (* maximum number of items in an item set      *)
+{$ENDIF}
+
+var
+
+(* Actual table sizes: *)
+
+n_nts            : Integer;
+n_lits           : Integer;
+n_rules          : Integer;
+n_types          : Integer;
+n_prec           : Integer;
+n_states         : Integer;
+n_items          : Integer;
+n_trans          : Integer;
+n_redns          : Integer;
+
+type
+
+(* Table data structures: *)
+
+(* Symbol table: The symbol table consists of a hash table which stores
+   print names and internal symbol numbers, and a key table which stores,
+   for each internal symbol number, the corresponding hash key. *)
+
+SymRec = record
+           pname  : StrPtr;
+             (* print name; empty entries are denoted by pname=nil *)
+           deff   : Boolean;
+             (* flag denoting whether symbol is already defined *)
+           sym    : Integer;
+             (* internal symbol number (0 or positive: literal symbols
+                (literal characters have symbol numbers 1 thru 255);
+                negative: nonterminal symbols; 0 denotes endmarker,
+                -1 augmented start nonterminal, 256 is reserved for
+                error token; note that the predefined symbols except
+                the error literal are not actually stored in the symbol
+                table; the error symbol is entered at initialization
+                s.t. it always has number 256) *)
+         end;
+
+SymTable = array [1..max_keys] of SymRec;
+
+SymKeyTable = array [-max_nts..max_lits-1] of Integer;
+  (* hash keys for nonterminal and literal symbols *)
+
+(* Rule table: the rule table consists of an array storing the rules
+   sequentially in the order in which they appear in the source grammar;
+   a rule no.s table which is used to sort rules w.r.t. left-hand side
+   nonterminals (after the rule table has been constructed and sorted, all
+   references to rules are done indirectly via the rule_no array s.t. the
+   rules for each nonterminal can be accessed easily); and an offset table
+   which stores, for each nonterminal, the corresponding first and last
+   index in the rule no.s table. *)
+
+RuleRec = record
+            lhs_sym : Integer; (* lhs nonterminal *)
+            rhs_len : Integer; (* length of rhs *)
+            rhs_sym : array [1..max_rule_len] of Integer;
+              (* rhs symbols *)
+          end;
+
+RuleRecPtr = ^RuleRec;
+
+RuleTable = array [1..max_rules] of RuleRecPtr;
+
+RuleNoTable = array [1..max_rules] of Integer;
+
+RuleOffsRec = record
+                rule_lo, rule_hi : Integer;
+              end;
+
+RuleOffsTable = array [1..max_nts] of RuleOffsRec;
+
+(* Symbol type table: The symbol type table stores the types associated
+   with the nonterminal and terminal grammar symbols (0 if none). *)
+
+TypeTable    = array [1..max_types] of Integer;
+  (* types declared in the definitions section *)
+
+SymTypeTable = array [-max_nts..max_lits-1] of Integer;
+  (* symbol types *)
+
+(* Precedence table: The precedence table stores the type of each
+   precedence level (left, right, nonassoc) and, for each literal
+   symbol and grammar rule, the assigned precedence level (precedence
+   level 0 if none). *)
+
+PrecType = ( left, right, nonassoc );
+
+PrecTable = array [1..max_prec] of PrecType;
+
+SymPrecTable = array [0..max_lits-1] of Integer;
+
+RulePrecTable = array [1..max_rules] of Integer;
+
+(* Closure and first symbols table: The closure table stores, for each
+   nonterminal X, the set of those nonterminals Y for which there is a
+   rightmost derivation X =>+ Y ... . Similarly, the first set table
+   stores, for each nonterminal X, the set of literals a for which there
+   is a derivation X =>+ a ... . Both tables are of type SymSetTable.
+
+   The nullable table stores, for each nonterminal, a flag denoting whether
+   the nonterminal is nullable (i.e. may be derived to the empty string).
+
+   These tables are constructed by the routines in the YaccClosure unit,
+   and are used by the LALR parser construction algorithms in YaccLR0 and
+   YaccLookaheads. *)
+
+SymSetTable = array [1..max_nts] of IntSetPtr;
+
+NullableTable = array [1..max_nts] of Boolean;
+
+(* State table:
+
+   Each state stores the first and last index of the kernel items,
+   transitions and reductions belonging to it, and a hash key determined
+   from the kernel items which is used to speed up searches for existing
+   states.
+
+   The items table stores the individual kernel items in the LR(0) set.
+   Each entry consists of a rule number together with the item position,
+   and a "next" field indicating the associated item in the successor state
+   (0 if there is none). The ItemSet type is used to retrieve and manipulate
+   individual item sets from the item table.
+
+   The transition table stores the shift and goto transitions in each state
+   (each transition is denoted by a (symbol, next_state) pair). Similarly,
+   the reductions table stores the reductions in each state, where each
+   action is denoted by a (symbolset, ruleno) pair. *)
+
+StateRec = record
+             item_lo, item_hi : Integer;
+             trans_lo, trans_hi : Integer;
+             redns_lo, redns_hi : Integer;
+             key : Integer;
+           end;
+
+StateTable = array [0..max_states-1] of StateRec;
+
+ItemRec = record
+            rule_no, pos_no : Integer;
+            next : Integer;
+          end;
+
+ItemSet = record
+            n_items : Integer;
+            item    : array [1..max_set_items] of ItemRec;
+          end;
+
+ItemTable = array [1..max_items] of ItemRec;
+
+TransRec = record
+             sym, next_state : Integer;
+           end;
+
+TransTable = array [1..max_trans] of TransRec;
+
+RednRec = record
+            symset : IntSetPtr;
+            rule_no : Integer;
+          end;
+
+RednTable = array [1..max_redns] of RednRec;
+
+(* Lookaheads table: This table stores, for each kernel item, the
+   corresponding LALR(1) lookahead symbol sets. *)
+
+LookaheadTable = array [1..max_items] of IntSetPtr;
+
+(* The propagation table is used to keep track of how lookaheads are
+   propagated from kernel items to other lookahead sets. *)
+
+PropList = ^PropEntry;
+
+PropEntry = record
+              symset : IntSetPtr;
+              next : PropList;
+            end;
+
+PropTable = array [1..max_items] of PropList;
+
+
+var
+
+verbose           : Boolean;          (* status of the verbose option *)
+debug             : Boolean;          (* status of the debug option *)
+startnt           : Integer;          (* start nonterminal of grammar
+                                         (0 if undefined) *)
+sym_table         : ^SymTable;        (* symbol table *)
+sym_key           : ^SymKeyTable;     (* symbol keys *)
+rule_table        : ^RuleTable;       (* rule table *)
+type_table        : ^TypeTable;       (* type table *)
+sym_type          : ^SymTypeTable;    (* symbol types *)
+prec_table        : ^PrecTable;       (* precedence table *)
+sym_prec          : ^SymPrecTable;    (* literal symbols precedence *)
+rule_prec         : ^RulePrecTable;   (* rules precedence *)
+rule_no           : ^RuleNoTable;     (* rule no table *)
+rule_offs         : ^RuleOffsTable;   (* rule offset table *)
+closure_table     : ^SymSetTable;     (* closure table *)
+first_set_table   : ^SymSetTable;     (* first set table *)
+nullable          : ^NullableTable;   (* nullable flags table *)
+state_table       : ^StateTable;      (* LR(0) state table *)
+item_table        : ^ItemTable;       (* LR(0) kernel item table *)
+trans_table       : ^TransTable;      (* transition table *)
+redn_table        : ^RednTable;       (* reduction table *)
+lookahead_table   : ^LookaheadTable;  (* LALR lookaheads table *)
+prop_table        : ^PropTable;       (* lookahead propagation table *)
+
+
+(* Operations: *)
+
+(* Symbol table routines: *)
+
+function new_nt : Integer;
+  (* returns a new nonterminal number (<-1) *)
+
+function new_lit : Integer;
+  (* returns a new literal number above 256 *)
+
+procedure add_lit ( sym : Integer );
+  (* this routine allows to add a user-defined literal symbol;
+     the current literal symbols count is adjusted accordingly *)
+
+function get_key ( symbol : String ) : Integer;
+  (* returns a hash key for symbol *)
+
+procedure def_key ( k : Integer; sym : Integer );
+  (* defines k to be a new symbol with internal symbol number sym *)
+
+function is_def_key ( k : Integer; var sym : Integer ) : Boolean;
+  (* checks whether symbol denoted by symbol table key k is already
+     defined; if so, returns the corresponding symbol number *)
+
+function pname ( sym : Integer ) : String;
+  (* returns the print name of an internal symbol (`$end' for
+     symbol 0, `$accept' for nonterminal -1, and a single quoted
+     character for literals 1..255) *)
+
+(* Rule table routines: *)
+
+function newRuleRec ( r : RuleRec ) : RuleRecPtr;
+  (* obtains a dynamic copy of r (only the number of bytes actually
+     needed is allocated) *)
+
+procedure add_rule ( r : RuleRecPtr );
+  (* add a rule to the rule table *)
+
+procedure sort_rules;
+  (* sorts rules w.r.t. left-hand sides into the rule no table *)
+
+procedure rule_offsets;
+  (* computes rule offsets after rules have been sorted *)
+
+function n_nt_rules ( sym : Integer ) : Integer;
+  (* returns number of rules for nonterminal sym *)
+
+(* Type Table routines: *)
+
+procedure add_type ( k : Integer );
+  (* add a type identifier to the table *)
+
+procedure sort_types;
+  (* sort the type table alphabetically, eliminate dups *)
+
+function search_type ( symbol : String ) : Boolean;
+  (* search the sorted types table for the given type symbol *)
+
+(* Precedence table routines: *)
+
+function new_prec_level ( prec_type : PrecType ) : Integer;
+  (* adds a new precedence level of the denoted type; returns: the new
+     level *)
+
+(* State table routines: *)
+
+var act_state : Integer; (* state currently considered *)
+
+procedure new_state;
+  (* build a new state *)
+
+procedure add_item ( rule_no, pos_no : Integer );
+  (* add an item to the new state (initialize its next field to 0) *)
+
+function add_state : Integer;
+  (* add the new state to the state table; if an equivalent state is already
+     in the table, dispose the new state, and return the existing state
+     number, otherwise return the new state number *)
+
+procedure start_trans;
+  (* starts building transitions of the active state *)
+
+procedure add_trans ( sym, next_state : Integer );
+  (* adds a transition to the active state *)
+
+procedure end_trans;
+  (* ends transitions of the active state *)
+
+procedure start_redns;
+  (* starts building reduction actions of the active state *)
+
+procedure add_redn ( symset : IntSetPtr; rule_no : Integer );
+  (* adds a reduction to the active state *)
+
+procedure end_redns;
+  (* ends reduction actions of the active state *)
+
+function n_state_items ( s : Integer ) : Integer;
+function n_state_trans ( s : Integer ) : Integer;
+function n_state_redns ( s : Integer ) : Integer;
+  (* return the number of kernel items, transitions and reductions in state
+     s, respectively *)
+
+function find_item( s : Integer; rule_no, pos_no : Integer ) : Integer;
+  (* find item (rule_no, pos_no) in state s; returns: the item number *)
+
+(* Item set routines: *)
+
+procedure empty_item_set ( var item_set : ItemSet );
+  (* initializes an empty item set *)
+
+procedure include_item_set ( var item_set : ItemSet;
+                             rule_no, pos_no : Integer);
+  (* add the denoted item to the given item set *)
+
+procedure get_item_set ( s : Integer; var item_set : ItemSet);
+  (* obtain the item set of state s from the item table *)
+
+procedure closure ( var item_set : ItemSet );
+  (* compute the closure of item_set (using the closure table) *)
+
+procedure sort_item_set ( var item_set : ItemSet );
+  (* sorts an item set w.r.t. position and rule numbers (higher positions,
+     lower rules first) *)
+
+implementation
+
+uses YaccMsgs;
+
+{$IFNDEF Win32}
+function n_bytes : LongInt;
+  begin
+    n_bytes := max_bytes-memAvail
+  end(*n_bytes*);
+{$ENDIF}
+
+(* Symbol table routines: *)
+
+function new_nt : Integer;
+  begin
+    inc(n_nts);
+    if n_nts>max_nts then fatal(nt_table_overflow);
+    sym_type^[-n_nts] := 0;
+    new_nt := -n_nts;
+  end(*new_nt*);
+
+function new_lit : Integer;
+  begin
+    inc(n_lits);
+    if n_lits>max_lits then fatal(lit_table_overflow);
+    sym_type^[n_lits-1] := 0;
+    sym_prec^[n_lits-1] := 0;
+    new_lit := n_lits-1;
+  end(*new_lit*);
+
+procedure add_lit ( sym : Integer );
+  begin
+    if sym>n_lits then n_lits := sym;
+    if n_lits>max_lits then fatal(lit_table_overflow);
+    sym_type^[sym] := 0;
+    sym_prec^[sym] := 0;
+  end(*add_lit*);
+
+function lookup(k : Integer) : String;{$ifndef fpc}far;{$endif}
+  (* print name of symbol no. k *)
+  begin
+    with sym_table^[k] do
+      if pname=nil then
+        lookup := ''
+      else
+        lookup := pname^
+  end(*lookup*);
+
+procedure entry(k : Integer; symbol : String);{$ifndef fpc}far;{$endif}
+  (* enter symbol into table *)
+  begin
+    sym_table^[k].pname := newStr(symbol);
+  end(*entry*);
+
+function get_key ( symbol : String ) : Integer;
+  begin
+    get_key := key(symbol, max_keys,{$ifdef fpc}@{$endif}lookup, {$ifdef fpc}@{$endif}entry);
+  end(*get_key*);
+
+procedure def_key ( k : Integer; sym : Integer );
+  begin
+    sym_key^[sym] := k;
+    sym_table^[k].deff := true;
+    sym_table^[k].sym  := sym;
+  end(*def_key*);
+
+function is_def_key ( k : Integer; var sym : Integer ) : Boolean;
+  begin
+    if sym_table^[k].deff then
+      begin
+        sym := sym_table^[k].sym;
+        is_def_key := true;
+      end
+    else
+      is_def_key := false
+  end(*is_def_key*);
+
+function pname ( sym : Integer ) : String;
+begin
+  case sym of
+    1..255 : pname := singleQuoteStr(chr(sym));
+    0      : pname := '$end';
+    -1     : pname := '$accept';
+  else  begin
+    if sym_table^[sym_key^[sym]].pname^[1]=''''
+      then  begin
+        pname := singleQuoteStr(
+                   copy( sym_table^[sym_key^[sym]].pname^,
+                         2,
+                         length(sym_table^[sym_key^[sym]].pname^)-2)
+                 )
+      end
+      else  begin
+        pname := sym_table^[sym_key^[sym]].pname^;
+      end;
+  end;
+  end;
+end(*pname*);
+
+(* Rule table: *)
+
+function newRuleRec ( r : RuleRec ) : RuleRecPtr;
+  var rp : RuleRecPtr;
+  begin
+    getmem(rp, 2*sizeOf(Integer)+r.rhs_len*sizeOf(Integer));
+    move(r, rp^, 2*sizeOf(Integer)+r.rhs_len*sizeOf(Integer));
+    newRuleRec := rp;
+  end(*newRuleRec*);
+
+procedure add_rule ( r : RuleRecPtr );
+  begin
+    inc(n_rules);
+    if n_rules>max_rules then fatal(rule_table_overflow);
+    rule_table^[n_rules] := r;
+  end(*add_rule*);
+
+function rule_less ( i, j : Integer ) : Boolean;{$ifndef fpc}far;{$endif}
+  begin
+    if rule_table^[rule_no^[i]]^.lhs_sym =
+       rule_table^[rule_no^[j]]^.lhs_sym then
+      rule_less := rule_no^[i] < rule_no^[j]
+    else
+      rule_less := rule_table^[rule_no^[i]]^.lhs_sym >
+                   rule_table^[rule_no^[j]]^.lhs_sym
+  end(*rule_less*);
+
+procedure rule_swap ( i, j : Integer );{$ifndef fpc}far;{$endif}
+  var x : Integer;
+  begin
+    x := rule_no^[i]; rule_no^[i] := rule_no^[j]; rule_no^[j] := x;
+  end(*rule_swap*);
+
+procedure sort_rules;
+  var i : Integer;
+  begin
+    for i := 1 to n_rules do rule_no^[i] := i;
+    quicksort ( 1, n_rules, {$ifdef fpc}@{$endif}rule_less, {$ifdef fpc}@{$endif}rule_swap );
+  end(*sort_rules*);
+
+procedure rule_offsets;
+  var i, sym : Integer;
+  begin
+    for sym := 1 to n_nts do with rule_offs^[sym] do
+      begin
+        rule_lo := 1; rule_hi := 0;
+      end;
+    i := 1;
+    while (i<=n_rules) do
+      begin
+        sym := rule_table^[rule_no^[i]]^.lhs_sym;
+        rule_offs^[-sym].rule_lo := i;
+        inc(i);
+        while (i<=n_rules) and
+              (rule_table^[rule_no^[i]]^.lhs_sym=sym) do
+          inc(i);
+        rule_offs^[-sym].rule_hi := i-1;
+      end;
+  end(*rule_offsets*);
+
+function n_nt_rules ( sym : Integer ) : Integer;
+  begin
+    with rule_offs^[-sym] do
+      n_nt_rules := rule_hi-rule_lo+1
+  end(*n_nt_rules*);
+
+(* Type Table routines: *)
+
+procedure add_type ( k : Integer );
+  begin
+    inc(n_types);
+    if n_types>max_types then fatal(type_table_overflow);
+    type_table^[n_types] := k;
+  end(*add_type*);
+
+(* Routines to sort type identifiers alphabetically: *)
+
+function type_less ( i, j : Integer ) : Boolean;{$ifndef fpc}far;{$endif}
+  begin
+    type_less := sym_table^[type_table^[i]].pname^<
+                 sym_table^[type_table^[j]].pname^
+  end(*type_less*);
+
+procedure type_swap ( i, j : Integer );{$ifndef fpc}far;{$endif}
+  var x : Integer;
+  begin
+    x := type_table^[i];
+    type_table^[i] := type_table^[j];
+    type_table^[j] := x;
+  end(*type_swap*);
+
+procedure sort_types;
+  var i, j, count : Integer;
+  begin
+    (* sort: *)
+    quicksort(1, n_types, {$ifdef fpc}@{$endif}type_less, {$ifdef fpc}@{$endif}type_swap);
+    (* eliminate dups: *)
+    i := 1; j := 1; count := 0;
+    while i<=n_types do
+      begin
+        if i<>j then type_table^[j] := type_table^[i];
+        while (i<n_types) and (type_table^[i+1]=type_table^[i]) do
+          begin
+            inc(i); inc(count);
+          end;
+        inc(i); inc(j);
+      end;
+    dec(n_types, count);
+  end(*sort_types*);
+
+function search_type ( symbol : String ) : Boolean;
+  var l, r, k : Integer;
+  begin
+    (* binary search: *)
+    l := 1; r := n_types;
+    k := l + (r-l) div 2;
+    while (l<r) and (sym_table^[type_table^[k]].pname^<>symbol) do
+      begin
+        if sym_table^[type_table^[k]].pname^<symbol then
+          l := succ(k)
+        else
+          r := pred(k);
+        k := l + (r-l) div 2;
+      end;
+    search_type := (k<=n_types) and (sym_table^[type_table^[k]].pname^=symbol);
+  end(*search_type*);
+
+(* Precedence table routines: *)
+
+function new_prec_level ( prec_type : PrecType ) : Integer;
+  begin
+    inc(n_prec);
+    if n_prec>max_prec then fatal(prec_table_overflow);
+    prec_table^[n_prec] := prec_type;
+    new_prec_level := n_prec;
+  end(*new_prec_level*);
+
+(* State table: *)
+
+procedure new_state;
+  begin
+    inc(n_states);
+    if n_states>max_states then fatal(state_table_overflow);
+    state_table^[n_states-1].item_lo := n_items+1;
+  end(*new_state*);
+
+procedure add_item ( rule_no, pos_no : Integer );
+  begin
+    inc(n_items);
+    if n_items>max_items then fatal(item_table_overflow);
+    item_table^[n_items].rule_no := rule_no;
+    item_table^[n_items].pos_no  := pos_no;
+    item_table^[n_items].next    := 0;
+  end(*add_item*);
+
+function add_state : Integer;
+  function state_key ( s : Integer ) : Integer;
+    (* determines a hash key for state s *)
+    const max_key = 4001;
+      (* should be prime number s.t. hash keys are distributed
+         evenly *)
+    var i, k : Integer;
+    begin
+      with state_table^[s] do
+        begin
+          k := 0;
+          for i := item_lo to item_hi do
+            with item_table^[i] do
+              inc(k, rule_no+pos_no);
+          state_key := k mod max_key;
+        end;
+    end(*state_key*);
+  function search_state ( s, lo, hi : Integer; var t : Integer ) : Boolean;
+    (* searches the range lo..hi in the state table for a state with the
+       same kernel items as s; returns true if found, and then the
+       corresponding state number in t *)
+    function eq_items(s, t : Integer) : Boolean;
+      (* compares kernel item sets of states s and t *)
+      var i, i_s, i_t : Integer;
+      begin
+        if n_state_items(s)<>n_state_items(t) then
+          eq_items := false
+        else
+          begin
+            i_s := state_table^[s].item_lo;
+            i_t := state_table^[t].item_lo;
+            for i := 0 to n_state_items(s)-1 do
+              if (item_table^[i_s+i].rule_no<>item_table^[i_t+i].rule_no) or
+                 (item_table^[i_s+i].pos_no<>item_table^[i_t+i].pos_no) then
+                begin
+                  eq_items := false;
+                  exit;
+                end;
+            eq_items := true;
+          end
+      end(*eq_items*);
+    var t1 : Integer;
+    begin
+      with state_table^[s] do
+        for t1 := lo to hi do
+          if (key=state_table^[t1].key) and
+             eq_items(s, t1) then
+            begin
+              search_state := true;
+              t := t1;
+              exit;
+            end;
+      search_state := false;
+    end(*search_state*);
+  var s : Integer;
+  begin
+    with state_table^[n_states-1] do
+      begin
+        item_hi := n_items;
+        key := state_key(n_states-1);
+        if search_state(n_states-1, 0, n_states-2, s) then
+          begin
+            n_items := item_lo;
+            dec(n_states);
+            add_state := s;
+          end
+        else
+          add_state := n_states-1;
+      end;
+  end(*add_state*);
+
+procedure start_trans;
+  begin
+    state_table^[act_state].trans_lo := n_trans+1;
+  end(*start_trans*);
+
+procedure add_trans ( sym, next_state : Integer );
+  begin
+    inc(n_trans);
+    if n_trans>max_trans then fatal(trans_table_overflow);
+    trans_table^[n_trans].sym        := sym;
+    trans_table^[n_trans].next_state := next_state;
+  end(*add_trans*);
+
+procedure end_trans;
+  begin
+    state_table^[act_state].trans_hi := n_trans;
+  end(*end_trans*);
+
+procedure start_redns;
+  begin
+    state_table^[act_state].redns_lo := n_redns+1;
+  end(*start_redns*);
+
+procedure add_redn ( symset : IntSetPtr; rule_no : Integer );
+  begin
+    inc(n_redns);
+    if n_redns>max_redns then fatal(redn_table_overflow);
+    redn_table^[n_redns].symset  := symset;
+    redn_table^[n_redns].rule_no := rule_no;
+  end(*add_redn*);
+
+procedure end_redns;
+  begin
+    state_table^[act_state].redns_hi := n_redns;
+  end(*end_redns*);
+
+function n_state_items ( s : Integer ) : Integer;
+  begin
+    with state_table^[s] do
+      n_state_items := item_hi-item_lo+1
+  end(*n_state_items*);
+
+function n_state_trans ( s : Integer ) : Integer;
+  begin
+    with state_table^[s] do
+      n_state_trans := trans_hi-trans_lo+1
+  end(*n_state_trans*);
+
+function n_state_redns ( s : Integer ) : Integer;
+  begin
+    with state_table^[s] do
+      n_state_redns := redns_hi-redns_lo+1
+  end(*n_state_redns*);
+
+function find_item( s : Integer; rule_no, pos_no : Integer ) : Integer;
+  var i : Integer;
+  begin
+    with state_table^[s] do
+      for i := item_lo to item_hi do
+        if (item_table^[i].rule_no=rule_no) and
+           (item_table^[i].pos_no=pos_no) then
+          begin
+            find_item := i;
+            exit;
+          end;
+    find_item := 0;
+  end(*find_item*);
+
+(* Item set routines: *)
+
+procedure empty_item_set ( var item_set : ItemSet );
+  begin
+    item_set.n_items := 0;
+  end(*empty_item_set*);
+
+procedure include_item_set ( var item_set : ItemSet;
+                             rule_no, pos_no : Integer);
+  begin
+    with item_set do
+      begin
+        inc(n_items);
+        if n_items>max_set_items then fatal(item_table_overflow);
+        item[n_items].rule_no := rule_no;
+        item[n_items].pos_no  := pos_no;
+      end;
+  end(*include_item_set*);
+
+procedure get_item_set ( s : Integer; var item_set : ItemSet);
+  begin
+    with state_table^[s], item_set do
+      begin
+        n_items := n_state_items(s);
+        move(item_table^[item_lo], item, n_items*sizeOf(ItemRec));
+      end
+  end(*get_item_set*);
+
+procedure closure ( var item_set : ItemSet );
+  var i, j : Integer;
+      nt_syms0, nt_syms : IntSet;
+  begin
+    with item_set do
+      begin
+        (* get the nonterminals at current positions in items: *)
+        empty(nt_syms0);
+        for i := 1 to n_items do
+          with item[i], rule_table^[rule_no]^ do
+            if (pos_no<=rhs_len) and (rhs_sym[pos_no]<0) then
+              include(nt_syms0, rhs_sym[pos_no]);
+        nt_syms := nt_syms0;
+        (* add closure symbols: *)
+        for i := 1 to size(nt_syms0) do
+          setunion(nt_syms, closure_table^[-nt_syms0[i]]^);
+        (* add the nonkernel items for the nonterminal symbols: *)
+        for i := 1 to size(nt_syms) do
+          with rule_offs^[-nt_syms[i]] do
+            for j := rule_lo to rule_hi do
+              include_item_set(item_set, rule_no^[j], 1);
+      end;
+  end(*closure*);
+
+var sort_items : ItemSet;
+
+(* comparison and swap routines for sort_item_set: *)
+
+function items_less ( i, j : Integer ) : Boolean;{$ifndef fpc}far;{$endif}
+  begin
+    with sort_items do
+      if item[i].pos_no=item[j].pos_no then
+        items_less := item[i].rule_no<item[j].rule_no
+      else
+        items_less := item[i].pos_no>item[j].pos_no
+  end(*items_less*);
+
+procedure items_swap ( i, j : Integer );{$ifndef fpc}far;{$endif}
+  var x : ItemRec;
+  begin
+    with sort_items do
+      begin
+        x := item[i]; item[i] := item[j]; item[j] := x;
+      end
+  end(*items_swap*);
+
+procedure sort_item_set ( var item_set : ItemSet );
+  begin
+    sort_items := item_set;
+    quicksort(1, sort_items.n_items, {$ifdef fpc}@{$endif}items_less, {$ifdef fpc}@{$endif}items_swap);
+    item_set := sort_items;
+  end(*sort_item_set*);
+
+var i : Integer;
+
+begin
+
+  verbose          := false;
+  debug            := false;
+  startnt          := 0;
+
+{$IFNDEF Win32}
+  max_bytes := memAvail;
+{$ENDIF}
+
+  n_nts            := 1;
+  n_lits           := 257;
+  n_rules          := 0;
+  n_types          := 0;
+  n_prec           := 0;
+  n_states         := 0;
+  n_items          := 0;
+  n_trans          := 0;
+  n_redns          := 0;
+
+  (* allocate tables: *)
+
+  new(sym_table);
+  new(sym_key);
+  new(rule_table);
+  new(rule_no);
+  new(rule_offs);
+  new(type_table);
+  new(sym_type);
+  new(prec_table);
+  new(sym_prec);
+  new(rule_prec);
+  new(closure_table);
+  new(first_set_table);
+  new(nullable);
+  new(state_table);
+  new(item_table);
+  new(trans_table);
+  new(redn_table);
+  new(lookahead_table);
+  new(prop_table);
+
+  (* initialize symbol table: *)
+
+  for i := 1 to max_keys do
+    with sym_table^[i] do
+      begin
+        pname := nil;
+        deff  := false;
+      end;
+
+  (* enter predefined error symbol into symbol table: *)
+
+  def_key(get_key('error'), 256);
+
+  (* initialize type and precedence tables: *)
+
+  for i := -max_nts to max_lits-1 do sym_type^[i] := 0;
+  for i := 0 to max_lits-1 do sym_prec^[i] := 0;
+  for i := 1 to max_rules do rule_prec^[i] := 0;
+
+end(*YaccTables*).

utils/tply/yylex.cod

@@ -0,0 +1,80 @@
+
+(* lexical analyzer template (TP Lex V3.0), V1.0 3-2-91 AG *)
+
+(* global definitions: *)
+%%
+
+function yylex : Integer;
+
+procedure yyaction ( yyruleno : Integer );
+  (* local definitions: *)
+%%
+begin
+  (* actions: *)
+  case yyruleno of
+%%
+  end;
+end(*yyaction*);
+
+(* DFA table: *)
+%%
+
+var yyn : Integer;
+
+label start, scan, action;
+
+begin
+
+start:
+
+  (* initialize: *)
+
+  yynew;
+
+scan:
+
+  (* mark positions and matches: *)
+
+  for yyn := yykl[yystate] to     yykh[yystate] do yymark(yyk[yyn]);
+  for yyn := yymh[yystate] downto yyml[yystate] do yymatch(yym[yyn]);
+
+  if yytl[yystate]>yyth[yystate] then goto action; (* dead state *)
+
+  (* get next character: *)
+
+  yyscan;
+
+  (* determine action: *)
+
+  yyn := yytl[yystate];
+  while (yyn<=yyth[yystate]) and not (yyactchar in yyt[yyn].cc) do inc(yyn);
+  if yyn>yyth[yystate] then goto action;
+    (* no transition on yyactchar in this state *)
+
+  (* switch to new state: *)
+
+  yystate := yyt[yyn].s;
+
+  goto scan;
+
+action:
+
+  (* execute action: *)
+
+  if yyfind(yyrule) then
+    begin
+      yyaction(yyrule);
+      if yyreject then goto action;
+    end
+  else if not yydefault and yywrap then
+    begin
+      yyclear;
+      return(0);
+    end;
+
+  if not yydone then goto start;
+
+  yylex := yyretval;
+
+end(*yylex*);
+

utils/tply/yyparse.cod

@@ -0,0 +1,184 @@
+
+(* Yacc parser template (TP Yacc V3.0), V1.2 6-17-91 AG *)
+
+(* global definitions: *)
+%%
+
+var yylval : YYSType;
+
+function yylex : Integer; forward;
+
+function yyparse : Integer;
+
+var yystate, yysp, yyn : Integer;
+    yys : array [1..yymaxdepth] of Integer;
+    yyv : array [1..yymaxdepth] of YYSType;
+    yyval : YYSType;
+
+procedure yyaction ( yyruleno : Integer );
+  (* local definitions: *)
+%%
+begin
+  (* actions: *)
+  case yyruleno of
+%%
+  end;
+end(*yyaction*);
+
+(* parse table: *)
+%%
+
+const _error = 256; (* error token *)
+
+function yyact(state, sym : Integer; var act : Integer) : Boolean;
+  (* search action table *)
+  var k : Integer;
+  begin
+    k := yyal[state];
+    while (k<=yyah[state]) and (yya[k].sym<>sym) do inc(k);
+    if k>yyah[state] then
+      yyact := false
+    else
+      begin
+        act := yya[k].act;
+        yyact := true;
+      end;
+  end(*yyact*);
+
+function yygoto(state, sym : Integer; var nstate : Integer) : Boolean;
+  (* search goto table *)
+  var k : Integer;
+  begin
+    k := yygl[state];
+    while (k<=yygh[state]) and (yyg[k].sym<>sym) do inc(k);
+    if k>yygh[state] then
+      yygoto := false
+    else
+      begin
+        nstate := yyg[k].act;
+        yygoto := true;
+      end;
+  end(*yygoto*);
+
+label parse, next, error, errlab, shift, reduce, accept, abort;
+
+begin(*yyparse*)
+
+  (* initialize: *)
+
+  yystate := 0; yychar := -1; yynerrs := 0; yyerrflag := 0; yysp := 0;
+
+{$ifdef yydebug}
+  yydebug := true;
+{$else}
+  yydebug := false;
+{$endif}
+
+parse:
+
+  (* push state and value: *)
+
+  inc(yysp);
+  if yysp>yymaxdepth then
+    begin
+      yyerror('yyparse stack overflow');
+      goto abort;
+    end;
+  yys[yysp] := yystate; yyv[yysp] := yyval;
+
+next:
+
+  if (yyd[yystate]=0) and (yychar=-1) then
+    (* get next symbol *)
+    begin
+      yychar := yylex; if yychar<0 then yychar := 0;
+    end;
+
+  if yydebug then writeln('state ', yystate, ', char ', yychar);
+
+  (* determine parse action: *)
+
+  yyn := yyd[yystate];
+  if yyn<>0 then goto reduce; (* simple state *)
+
+  (* no default action; search parse table *)
+
+  if not yyact(yystate, yychar, yyn) then goto error
+  else if yyn>0 then                      goto shift
+  else if yyn<0 then                      goto reduce
+  else                                    goto accept;
+
+error:
+
+  (* error; start error recovery: *)
+
+  if yyerrflag=0 then yyerror('syntax error');
+
+errlab:
+
+  if yyerrflag=0 then inc(yynerrs);     (* new error *)
+
+  if yyerrflag<=2 then                  (* incomplete recovery; try again *)
+    begin
+      yyerrflag := 3;
+      (* uncover a state with shift action on error token *)
+      while (yysp>0) and not ( yyact(yys[yysp], _error, yyn) and
+                               (yyn>0) ) do
+        begin
+          if yydebug then
+            if yysp>1 then
+              writeln('error recovery pops state ', yys[yysp], ', uncovers ',
+                      yys[yysp-1])
+            else
+              writeln('error recovery fails ... abort');
+          dec(yysp);
+        end;
+      if yysp=0 then goto abort; (* parser has fallen from stack; abort *)
+      yystate := yyn;            (* simulate shift on error *)
+      goto parse;
+    end
+  else                                  (* no shift yet; discard symbol *)
+    begin
+      if yydebug then writeln('error recovery discards char ', yychar);
+      if yychar=0 then goto abort; (* end of input; abort *)
+      yychar := -1; goto next;     (* clear lookahead char and try again *)
+    end;
+
+shift:
+
+  (* go to new state, clear lookahead character: *)
+
+  yystate := yyn; yychar := -1; yyval := yylval;
+  if yyerrflag>0 then dec(yyerrflag);
+
+  goto parse;
+
+reduce:
+
+  (* execute action, pop rule from stack, and go to next state: *)
+
+  if yydebug then writeln('reduce ', -yyn);
+
+  yyflag := yyfnone; yyaction(-yyn);
+  dec(yysp, yyr[-yyn].len);
+  if yygoto(yys[yysp], yyr[-yyn].sym, yyn) then yystate := yyn;
+
+  (* handle action calls to yyaccept, yyabort and yyerror: *)
+
+  case yyflag of
+    yyfaccept : goto accept;
+    yyfabort  : goto abort;
+    yyferror  : goto errlab;
+  end;
+
+  goto parse;
+
+accept:
+
+  yyparse := 0; exit;
+
+abort:
+
+  yyparse := 1; exit;
+
+end(*yyparse*);